Ben / Nujel

[do [def test-context "Nujel Bootstrap"] [def help [λ* help [i] "Describe 10 functions at offset 1" [do [if [int? i] #nil [set! i [int i]]] [def off [* i 10]] [for-each [map [symbol-table off 10] string] [λ* #nil [l] "" [do [def desc [describe l]] [println [cat l " " desc]]]]] [def sc [/ [symbol-count] 10]] [println [cat "Help page " i " of " sc]]]]] [def file/compile [λ* file/compile [path no-write environment] "Compile a Nujel source file into optimized object code" [do [def source [cons 'do [read [file/read path]]]] [def object-code [compile/forms source environment]] [if no-write #nil [file/write [cat [path/without-extension path] ".no"] [if object-code [str/write object-code] ""]]] object-code]]] [def file/eval [λ* file/eval [path environment] "Evaluate a Nujel source file in the current context" [do [if environmnet #nil [set! environment root-closure]] [def source [cons 'do [read [file/read path]]]] [compile/forms [cons 'do source] environment]]]] [def eval/forked [λ* eval/forked [nujel-binary raw-expr] "Evaluate @EXPR in a separate process running NUJEL-BINARY" [do [def expr [cat "[print [str/write " [str/write raw-expr]]] [def tmp-path [file/temp expr]] [def command [cat nujel-binary " " tmp-path]] [def res [popen command]] [file/remove tmp-path] [cons [car res] [cdr res]]]]] [def file/file? [λ* file/file? [filename] "" [tree/get [file/stat filename] :regular-file?]]] [def file/dir? [λ* file/dir? [filename] "" [tree/get [file/stat filename] :directory?]]]][do [def repl/exception-handler [λ* repl/exception-handler [error] "" [display/error error]]] [def repl/history #nil] [def repl/prompt [λ* repl/prompt [] "> " "> "]] [def repl/wasm [λ* repl/wasm [line] "Evaluate LINE in the wasm context" [try repl/exception-handler [do [def raw [read line]] [def cexpr [list [compile [cons 'do raw]]]] [apply root-closure cexpr]]]]] [def repl/readline [λ* repl/readline [ctx] "" [do [def line [readline [repl/prompt]]] [if [nil? line] [do [display "Bye!\r\n"] [exit 0]] #nil] [readline/history/add line] [def raw [read line]] [def expr [cons 'do raw]] [def cexpr [cons [compile expr]]] [def result [apply ctx cexpr]] [set! repl/history [cons line repl/history]] [println [cat [if [nil? result] "" [str/write result]]]]]]] [def repl [λ* repl [] "" [do [readline/history/load [readline/history/path]] [while #t [do [try repl/exception-handler [repl/readline root-closure]] [readline/history/save [readline/history/path]]]]]]] [def repl/print-help [λ* repl/print-help [] "" [do [println [cat [ansi-rainbow "Nujel"] " - A Lisp dialect for games.\n"]] [println [cat [ansi-green "Usage:"] " nujel [options] [command_string | file]\n"]] [println [cat [ansi-blue "n"] " - do not load any stdlib"]] [println [cat [ansi-blue "v"] " - be verbose"]] [println [cat [ansi-blue "r"] " - eval following file without compilation/expansion"]] [println [cat [ansi-blue "x"] " - Run the expression following this argument directly"]]]]] [def repl/run-forked* [λ* repl/run-forked* [expr] "" [do [def command [cat repl/executable-name " -x \"" [str/write expr] "\""]] [popen command]]]] [def repl/run-forked [μ* repl/run-forked [expr] "" [cons 'repl/run-forked* [cons [list 'quote expr] #nil]]]] [def repl/option-map [tree/new #nil]] [tree/set! repl/option-map 'h [λ* #nil [option] "" [do [repl/print-help] [set! repl/parse-args/run-repl #f]]]] [tree/set! repl/option-map 'x [λ* #nil [option] "" [do [set! repl/parse-args/eval-next #t] [set! repl/parse-args/run-repl #f]]]] [tree/set! repl/option-map :default [λ* #nil [option] "" [tree/set! repl/options option #t]]] [def repl/executable-name "nujel"] [def repl/parse-args/eval-next #f] [def repl/parse-args/run-repl #t] [def repl/options [tree/new #nil]] [def repl/parse-option [λ* repl/parse-option [option] "" [[or [tree/get repl/option-map option] [tree/get repl/option-map :default]] option]]] [def repl/parse-options [λ* repl/parse-options [options] "" [if [== [char-at options 0] 45] [repl/parse-option [str->sym [cut options 1]]] [for-each [map [split options ""] str->sym] repl/parse-option]]]] [def repl/parse-arg [λ* repl/parse-arg [arg] "" [if repl/parse-args/eval-next [do [apply root-closure [cons [compile [cons 'do [read arg]]]]] [set! repl/eval-next #f]] [if [== [char-at arg 0] 45] [repl/parse-options [string/cut arg 1]] [if #t [do [try display/error [file/eval arg]] [set! repl/parse-args/run-repl #f]] #nil]]]]] [def repl/parse-args [λ* repl/parse-args [args] "" [if args [do [repl/parse-arg [car args]] [repl/parse-args [cdr args]]] repl/parse-args/run-repl]]] [def repl/init/wasm [λ* repl/init/wasm [args] "" [println [cat [ansi-rainbow "Nujel"] " wasm/REPL ready for input"]]]] [def repl/init/bin [λ* repl/init/bin [args] "" [do [set! repl/executable-name [car args]] [if [repl/parse-args [cdr args]] [repl] #nil]]]] [def repl/init [λ* repl/init args "" [if [== ARCH "wasm"] [repl/init/wasm args] [repl/init/bin args]]]]][do [if [and [!= ARCH "wasm"] popen] [do [test/add* '[0 . ""] '[do [repl/run-forked 1]]] [test/add* '[123 . ""] '[do [repl/run-forked [exit 123]]]] [test/add* '[0 . "123"] '[do [repl/run-forked [display 123]]]] [test/add* #t '[do [file/dir? "stdlib"]]] [test/add* #f '[do [file/file? "stdlib"]]] [test/add* #t '[do [file/file? "GNUmakefile"]]] [test/add* #f '[do [file/dir? "GNUmakefile"]]] [test/add* #f '[do [tree/get [file/stat "GNUmakefile"] :error?]]] [test/add* #t '[do [tree/get [file/stat "This-file-should-never-exist.jpeg"] :error?]]] [test/add* #t '[do [> [tree/get [file/stat "GNUmakefile"] :size] 1024]]] [test/add* #t '[do [int? [tree/get [file/stat "GNUmakefile"] :modification-time]]]] [test/add* #t '[do [int? [tree/get [file/stat "GNUmakefile"] :access-time]]]] [test/add* #t '[do [int? [tree/get [file/stat "GNUmakefile"] :mode]]]] [test/add* #t '[do [bool? [tree/get [file/stat "GNUmakefile"] :regular-file?]]]] [test/add* #t '[do [bool? [tree/get [file/stat "GNUmakefile"] :directory?]]]] [test/add* #t '[do [bool? [tree/get [file/stat "GNUmakefile"] :character-device?]]]] [test/add* #t '[do [bool? [tree/get [file/stat "GNUmakefile"] :block-device?]]]] [test/add* #t '[do [bool? [tree/get [file/stat "GNUmakefile"] :named-pipe?]]]]] #nil] [test/add* #t '[do [tree? environment/variables]]] [test/add* #t '[do [string? [tree/get environment/variables 'PATH]]]]]