From 25812731cc2b3aa707b4c50d7e094f03490ded1c Mon Sep 17 00:00:00 2001 From: JeffBezanson Date: Tue, 21 Apr 2009 00:56:05 +0000 Subject: [PATCH] eliminating interpreter. the bytecode VM is now fully bootstrapped. making the empty vector a singleton removing syntax environment stuff from core reimplementing eval using the compiler fixing a couple bugs in long argument lists --- femtolisp/builtins.c | 40 +- femtolisp/compiler.lsp | 20 +- femtolisp/cvalues.c | 2 +- femtolisp/flisp.boot | 478 ++++++++++++++++++++ femtolisp/flisp.c | 965 ++++------------------------------------- femtolisp/flisp.h | 10 +- femtolisp/opcodes.h | 2 +- femtolisp/print.c | 6 +- femtolisp/read.c | 12 +- femtolisp/system.lsp | 58 ++- femtolisp/table.c | 2 +- 11 files changed, 633 insertions(+), 962 deletions(-) create mode 100644 femtolisp/flisp.boot diff --git a/femtolisp/builtins.c b/femtolisp/builtins.c index 9690534..40675e8 100644 --- a/femtolisp/builtins.c +++ b/femtolisp/builtins.c @@ -147,46 +147,10 @@ static value_t fl_set_top_level_value(value_t *args, u_int32_t nargs) return args[1]; } -extern value_t LAMBDA; - -static value_t fl_setsyntax(value_t *args, u_int32_t nargs) -{ - argcount("set-syntax!", nargs, 2); - symbol_t *sym = tosymbol(args[0], "set-syntax!"); - if (sym->syntax && (sym->syntax == TAG_CONST || isspecial(sym->syntax))) - lerrorf(ArgError, "set-syntax!: cannot define syntax for %s", - symbol_name(args[0])); - if (args[1] == FL_F) { - sym->syntax = 0; - } - else { - if (!iscvalue(args[1]) && - (!iscons(args[1]) || car_(args[1])!=LAMBDA)) - type_error("set-syntax!", "function", args[1]); - sym->syntax = args[1]; - } - return args[1]; -} - -static value_t fl_symbolsyntax(value_t *args, u_int32_t nargs) -{ - argcount("symbol-syntax", nargs, 1); - symbol_t *sym = tosymbol(args[0], "symbol-syntax"); - // must avoid returning built-in syntax expanders, because they - // don't behave like functions (they take their arguments directly - // from the form rather than from the stack of evaluated arguments) - if (sym->syntax == TAG_CONST || isspecial(sym->syntax)) - return FL_F; - return sym->syntax; -} - static void global_env_list(symbol_t *root, value_t *pv) { while (root != NULL) { - if (root->name[0] != ':' && - (root->binding != UNBOUND || - (root->syntax && root->syntax != TAG_CONST && - !isspecial(root->syntax)))) { + if (root->name[0] != ':' && (root->binding != UNBOUND)) { *pv = fl_cons(tagptr(root,TAG_SYM), *pv); } global_env_list(root->left, pv); @@ -429,8 +393,6 @@ extern void table_init(); extern void iostream_init(); static builtinspec_t builtin_info[] = { - { "set-syntax!", fl_setsyntax }, - { "symbol-syntax", fl_symbolsyntax }, { "environment", fl_global_env }, { "constant?", fl_constantp }, { "top-level-value", fl_top_level_value }, diff --git a/femtolisp/compiler.lsp b/femtolisp/compiler.lsp index e26a3fd..2a1a72b 100644 --- a/femtolisp/compiler.lsp +++ b/femtolisp/compiler.lsp @@ -1,13 +1,13 @@ ; -*- scheme -*- -(define (make-enum-table keys) +(define (make-enum-table offset keys) (let ((e (table))) (for 0 (1- (length keys)) (lambda (i) - (put! e (aref keys i) i))))) + (put! e (aref keys i) (+ offset i)))))) (define Instructions - (make-enum-table + (make-enum-table 0 [:nop :dup :pop :call :tcall :jmp :brf :brt :jmp.l :brf.l :brt.l :ret :tapply @@ -15,7 +15,7 @@ :number? :bound? :pair? :builtin? :vector? :fixnum? :cons :list :car :cdr :set-car! :set-cdr! - :eval :apply + :apply :+ :- :* :/ := :< :compare @@ -37,10 +37,10 @@ :vector? 1 :fixnum? 1 :cons 2 :car 1 :cdr 1 :set-car! 2 - :set-cdr! 2 :eval 1 - :apply 2 :< 2 - :compare 2 :aref 2 - :aset! 3 := 2)) + :set-cdr! 2 :apply 2 + :< 2 :compare 2 + :aref 2 :aset! 3 + := 2)) (define 1/Instructions (table.invert Instructions)) @@ -372,7 +372,9 @@ (:/ (if (= nargs 0) (argc-error head 1) (emit g b nargs))) - (:vector (emit g b nargs)) + (:vector (if (= nargs 0) + (emit g :loadv []) + (emit g b nargs))) (else (emit g (if (and tail? (eq? b :apply)) :tapply b))))) (emit g (if tail? :tcall :call) nargs))))))) diff --git a/femtolisp/cvalues.c b/femtolisp/cvalues.c index 1e76339..0ddfa72 100644 --- a/femtolisp/cvalues.c +++ b/femtolisp/cvalues.c @@ -465,7 +465,7 @@ value_t cvalue_array(value_t *args, u_int32_t nargs) cnt = nargs - 1; if (nargs > MAX_ARGS) - cnt += llength(args[MAX_ARGS]); + cnt += (llength(args[MAX_ARGS])-1); fltype_t *type = get_array_type(args[0]); elsize = type->elsz; sz = elsize * cnt; diff --git a/femtolisp/flisp.boot b/femtolisp/flisp.boot new file mode 100644 index 0000000..74e322e --- /dev/null +++ b/femtolisp/flisp.boot @@ -0,0 +1,478 @@ +zero? +#function(">\x015\x00/&\x0b" []) +vector.map +#function(">\x022\x004\x015\x01\x03\x01@\x04\x02\x0b" [#function("A\x022\x004\x015\x00\x03\x01@\x04\x02\x0b" [#function("A\x02/6\x00\x000#\x022\x00\x016\x00\x005\x006\x02\x006\x02\x015\x00*\x03\x01+\x0b" [])]) + vector.alloc]) length]) +vector->list +#function(">\x012\x004\x015\x00\x03\x01.@\x04\x03\x0b" [#function("A\x0305\x002\x00\x016\x01\x006\x00\x005\x00#\x02*6\x00\x01\x1b:\x00\x01\x0b" [])]) length]) +untrace +#function(">\x012\x004\x015\x00\x03\x01@\x04\x02\x0b" [#function("A\x025\x00\x1d2\x00\x0d\x06%\x004\x016\x00\x004\x024\x034\x044\x055\x00\x03\x01\x03\x01\x03\x01\x03\x01\x04\x02\x0b-\x0b" [trace-lambda set-top-level-value! + cadr caar last-pair caddr]) + top-level-value]) +trace +#function(">\x012\x004\x015\x00\x03\x01@\x03\x02\x022\x02\x0b" [#function("A\x022\x004\x015\x00\x03\x01@\x04\x02\x0b" [#function("A\x022\x004\x015\x00\x03\x01@\x04\x02\x0b" [#function("A\x026\x01\x00\x1d2\x00\x0d\x11\x06c\x004\x016\x02\x002\x006\x00\x004\x022\x03\x1c\x012\x042\x05\x1c\x02\x1c\x012\x062\x076\x02\x00\x1c\x02\x1c\x02\x1c\x014\x084\x092\x0a<5\x00\x03\x02\x03\x012\x042\x0b\x1c\x02\x1c\x014\x022\x076\x01\x00\x1c\x02\x1c\x014\x085\x00\x03\x01\x03\x02\x1c\x01\x03\x06\x1c\x03\x04\x02\x0b-\x0b" [trace-lambda + set-top-level-value! nconc begin princ "(" print quote copy-list map #function(">\x012\x002\x012\x02\x1c\x022\x035\x00\x1c\x02\x1c\x03\x0b" [begin + princ " " print]) ")\n"]) to-proper]) cadr]) top-level-value ok]) +transpose +#function(">\x014\x004\x015\x00\x1b\x0c\x0b" [mapcar list]) +to-proper +#function(">\x015\x00\x12\x06\x0b\x005\x00\x0b5\x00\x10\x06\x16\x005\x00\x1c\x01\x0b5\x00\x1d4\x005\x00\x1e\x03\x01\x1b\x0b" [to-proper]) +table.values +#function(">\x014\x002\x01<.5\x00\x04\x03\x0b" [table.foldl #function(">\x035\x015\x02\x1b\x0b" [])]) +table.foreach +#function(">\x024\x002\x01<.5\x01\x04\x03\x0b" [table.foldl #function(">\x036\x00\x005\x005\x01\x03\x02\x02,\x0b" [])]) +table.invert +#function(">\x012\x004\x01\x03\x00@\x04\x02\x0b" [#function("A\x024\x002\x01<.6\x00\x00\x03\x03\x025\x00\x0b" [table.foldl #function(">\x034\x006\x00\x005\x015\x00\x04\x03\x0b" [put!])]) + table]) +table.keys +#function(">\x014\x002\x01<.5\x00\x04\x03\x0b" [table.foldl #function(">\x035\x005\x02\x1b\x0b" [])]) +table.pairs +#function(">\x014\x002\x01<.5\x00\x04\x03\x0b" [table.foldl #function(">\x035\x005\x01\x1b5\x02\x1b\x0b" [])]) +table.clone +#function(">\x012\x004\x01\x03\x00@\x04\x02\x0b" [#function("A\x024\x002\x01<.6\x00\x00\x03\x03\x025\x00\x0b" [table.foldl #function(">\x034\x006\x00\x005\x005\x01\x04\x03\x0b" [put!])]) + table]) +symbol-syntax +#function(">\x014\x004\x015\x00-\x04\x03\x0b" [get *syntax-environment*]) +string.trim +#function(">\x032\x00--@\x04\x03\x0b" [#function("A\x032\x00<9\x00\x022\x01<9\x01\x022\x024\x036\x00\x00\x03\x01@\x04\x02\x0b" [#function(">\x045\x025\x03'\x01\x06\x1a\x00\x024\x005\x014\x015\x005\x02\x03\x02\x03\x02\x061\x006\x00\x005\x005\x014\x025\x005\x02\x03\x025\x03\x04\x04\x0b5\x02\x0b" [string.find + string.char string.inc]) #function(">\x034\x005\x02/\x03\x02\x01\x06\"\x00\x024\x015\x014\x025\x004\x035\x005\x02\x03\x02\x03\x02\x03\x02\x067\x006\x00\x015\x005\x014\x035\x005\x02\x03\x02\x04\x03\x0b5\x02\x0b" [> string.find + string.char + string.dec]) + #function("A\x024\x006\x01\x006\x00\x006\x01\x006\x01\x01/5\x00\x03\x046\x00\x016\x01\x006\x01\x025\x00\x03\x03\x04\x03\x0b" [string.sub]) + length])]) +string.tail +#function(">\x024\x005\x004\x015\x00/5\x01\x03\x034\x025\x00\x03\x01\x04\x03\x0b" [string.sub string.inc sizeof]) +string.rep +#function(">\x025\x011\x04'\x06A\x004\x005\x01/\x03\x02\x06\x17\x002\x01\x0b5\x010&\x06%\x004\x025\x00\x04\x01\x0b5\x011\x02&\x066\x004\x025\x005\x00\x04\x02\x0b4\x025\x005\x005\x00\x04\x03\x0b4\x035\x01\x03\x01\x06\\\x004\x025\x004\x045\x005\x010#\x02\x03\x02\x04\x02\x0b4\x044\x025\x005\x00\x03\x025\x011\x02%\x02\x04\x02\x0b" [<= "" string odd? + string.rep]) +string.join +#function(">\x025\x00\x12\x06\x0b\x002\x00\x0b2\x014\x02\x03\x00@\x04\x02\x0b" ["" #function("A\x024\x005\x006\x00\x00\x1d\x03\x02\x024\x012\x02<6\x00\x00\x1e\x03\x02\x024\x035\x00\x04\x01\x0b" [io.write for-each #function(">\x014\x006\x00\x006\x01\x01\x03\x02\x024\x006\x00\x005\x00\x04\x02\x0b" [io.write]) + io.tostring!]) buffer]) +string.map +#function(">\x022\x004\x01\x03\x004\x025\x01\x03\x01@\x04\x03\x0b" [#function("A\x032\x00/@\x03\x02\x024\x015\x00\x04\x01\x0b" [#function("A\x02-5\x006\x00\x01'\x061\x00\x024\x006\x00\x006\x01\x004\x016\x01\x015\x00\x03\x02\x03\x01\x03\x02\x024\x026\x01\x015\x00\x03\x029\x00\x05\x03\x00\x0b" [io.putc + string.char string.inc]) io.tostring!]) buffer length]) +splice-form? +#function(">\x015\x00\x17\x01\x06\x1b\x00\x025\x00\x1d2\x00\x0d\x01\x07\x1b\x00\x025\x00\x1d2\x01\x0d\x01\x07%\x00\x025\x002\x02\x0d\x0b" [*comma-at* *comma-dot* *comma*]) +set-syntax! +#function(">\x024\x004\x015\x005\x01\x04\x03\x0b" [put! *syntax-environment*]) +self-evaluating? +#function(">\x015\x00\x10\x01\x06\x0e\x00\x025\x00\x14\x11\x01\x07/\x00\x024\x005\x00\x03\x01\x01\x06/\x00\x025\x00\x14\x01\x06/\x00\x025\x004\x015\x00\x03\x01\x0d\x0b" [constant? top-level-value]) +repl +#function(">\x002\x00--@\x04\x03\x0b" [#function("A\x032\x00<9\x00\x022\x01<9\x01\x025\x01\x03\x00\x024\x02\x04\x00\x0b" [#function(">\x004\x002\x01\x03\x01\x024\x024\x03\x03\x01\x022\x042\x05<2\x06<=@\x04\x02\x0b" [princ "> " + io.flush + *output-stream* + #function("A\x024\x004\x01\x03\x01\x11\x01\x06\x19\x00\x022\x024\x035\x00\x03\x01@\x04\x02\x0b" [io.eof? + *input-stream* #function("A\x024\x005\x00\x03\x01\x025\x008\x01\x02,\x0b" [print that]) load-process]) + #function(">\x004\x00\x04\x00\x0b" [read]) + #function(">\x014\x004\x01\x03\x01\x024\x025\x00\x04\x01\x0b" [io.discardbuffer + *input-stream* raise])]) #function(">\x002\x00<2\x01<=\x06\x17\x004\x02\x03\x00\x026\x00\x01\x04\x00\x0b-\x0b" [#function(">\x006\x00\x00\x03\x00\x01\x06\x10\x00\x024\x00\x04\x00\x0b" [newline]) + #function(">\x014\x005\x00\x04\x01\x0b" [print-exception]) + newline]) newline])]) +revappend +#function(">\x024\x004\x015\x00\x03\x015\x01\x04\x02\x0b" [nconc reverse]) +reverse +#function(">\x014\x004\x01.5\x00\x04\x03\x0b" [foldl cons]) +separate +#function(">\x026\x00\x005\x005\x01..\x04\x04\x0b" [] #0=[#function(">\x045\x01\x12\x06\x0e\x005\x025\x03\x1b\x0b5\x005\x01\x1d\x03\x01\x06+\x006\x00\x005\x005\x01\x1e5\x01\x1d5\x02\x1b5\x03\x04\x04\x0b,\x06B\x006\x00\x005\x005\x01\x1e5\x025\x01\x1d5\x03\x1b\x04\x04\x0b-\x0b" [] #0#) ()]) +ref-uint16-LE +#function(">\x024\x005\x005\x01/\"\x02*/\x03\x024\x005\x005\x010\"\x02*1\x08\x03\x02\"\x02\x0b" [ash]) +ref-uint32-LE +#function(">\x024\x005\x005\x01/\"\x02*/\x03\x024\x005\x005\x010\"\x02*1\x08\x03\x024\x005\x005\x011\x02\"\x02*1\x10\x03\x024\x005\x005\x011\x03\"\x02*1\x18\x03\x02\"\x04\x0b" [ash]) +remainder +#function(">\x025\x005\x005\x01%\x025\x01$\x02#\x02\x0b" []) +quote-value +#function(">\x014\x005\x00\x03\x01\x06\x0e\x005\x00\x0b2\x015\x00\x1c\x02\x0b" [self-evaluating? quote]) +print-exception +#function(">\x015\x00\x17\x01\x06\x1d\x00\x025\x00\x1d2\x00\x0d\x01\x06\x1d\x00\x024\x015\x001\x04\x03\x02\x06H\x004\x024\x032\x044\x055\x00\x03\x012\x064\x075\x00\x03\x012\x08\x03\x06\x024\x094\x034\x0a5\x00\x03\x01\x03\x02\x05\x09\x015\x00\x17\x01\x06_\x00\x025\x00\x1d2\x0b\x0d\x01\x06_\x00\x025\x00\x1e\x17\x06u\x004\x024\x032\x0c4\x055\x00\x03\x012\x0d\x03\x04\x05\x09\x015\x00\x17\x01\x06\x83\x00\x025\x00\x1d2\x0e\x0d\x06\x9b\x004\x024\x032\x0f\x03\x02\x024\x024\x035\x00\x1e\x1b!\x05\x09\x015\x00\x17\x01\x06\xa9\x00\x025\x00\x1d2\x10\x0d\x06\xc8\x004\x114\x075\x00\x03\x01\x03\x01\x024\x024\x032\x124\x055\x00\x03\x01\x03\x03\x05\x09\x014\x135\x00\x03\x01\x01\x06\xdb\x00\x024\x015\x001\x02\x03\x02\x06\xf8\x004\x024\x035\x00\x1d2\x14\x03\x03\x022\x154\x055\x00\x03\x01@\x03\x02\x05\x09\x014\x024\x032\x16\x03\x02\x024\x094\x035\x00\x03\x02\x024\x024\x034\x17\x03\x02\x02,\x0b" [type-error + length= io.princ *stderr* "type-error: " cadr ": expected " caddr ", got " + io.print cadddr unbound-error "unbound-error: eval: variable " " has no value" + error "error: " load-error print-exception "in file " list? ": " #function("A\x024\x005\x00\x03\x01\x01\x07\x10\x00\x025\x00\x14\x06\x18\x004\x01\x05\x1a\x004\x024\x035\x00\x04\x02\x0b" [string? + io.princ io.print *stderr*]) "*** Unhandled exception: " *linefeed*]) +print-to-string +#function(">\x012\x004\x01\x03\x00@\x04\x02\x0b" [#function("A\x024\x005\x006\x00\x00\x03\x02\x024\x015\x00\x04\x01\x0b" [io.print io.tostring!]) buffer]) +println +#function("?\x004\x005\x00!4\x01\x03\x00\x02\x0b" [print newline]) +print +#function("?\x004\x004\x015\x00\x1b\x0c\x0b" [io.print *output-stream*]) +princ +#function("?\x004\x004\x015\x00\x1b\x0c\x0b" [io.princ *output-stream*]) +procedure? +#function(">\x015\x00\x18\x01\x07&\x00\x024\x005\x00\x03\x012\x01\x0d\x01\x07&\x00\x025\x00\x17\x01\x06&\x00\x025\x00\x1d2\x02\x0d\x0b" [typeof function lambda]) +positive? +#function(">\x014\x005\x00/\x04\x02\x0b" [>]) +peephole +#function(">\x015\x00\x0b" []) +pad-r +#function(">\x034\x005\x004\x015\x025\x014\x025\x00\x03\x01#\x02\x03\x02\x04\x02\x0b" [string string.rep length]) +pad-l +#function(">\x034\x004\x015\x025\x014\x025\x00\x03\x01#\x02\x03\x025\x00\x04\x02\x0b" [string string.rep length]) +odd? +#function(">\x014\x005\x00\x03\x01\x11\x0b" [even?]) +nreconc +#function(">\x024\x004\x015\x00\x03\x015\x01\x04\x02\x0b" [nconc nreverse]) +nreverse +#function(">\x012\x00.@\x04\x02\x0b" [#function("A\x02-6\x00\x00\x17\x06\"\x00\x026\x00\x00\x1e6\x00\x005\x006\x00\x009\x00\x02 \x02:\x00\x00\x05\x03\x00\x025\x00\x0b" [])]) +newline +#function(">\x004\x004\x01\x03\x01\x02,\x0b" [princ *linefeed*]) +nestlist +#function(">\x034\x005\x02/\x03\x02\x06\x0e\x00.\x0b5\x014\x015\x005\x005\x01\x03\x015\x020#\x02\x03\x03\x1b\x0b" [<= nestlist]) +nlist* +#function("?\x005\x00\x1e\x10\x06\x0d\x005\x00\x1d\x0b5\x004\x005\x00\x1e! \x0b" [nlist*]) +negative? +#function(">\x015\x00/'\x0b" []) +mod +#function(">\x025\x005\x005\x01%\x025\x01$\x02#\x02\x0b" []) +memv +#function(">\x025\x01\x10\x06\x0a\x00-\x0b5\x01\x1d5\x00\x0e\x06\x16\x005\x01\x0b,\x06$\x004\x005\x005\x01\x1e\x04\x02\x0b-\x0b" [memv]) +mark-label +#function(">\x024\x005\x004\x015\x01\x04\x03\x0b" [emit :label]) +map-int +#function(">\x024\x005\x01/\x03\x02\x06\x0e\x00.\x0b2\x015\x00/\x03\x01.\x1b.@\x04\x03\x0b" [<= #function("A\x035\x009\x01\x0206\x00\x010#\x022\x00\x016\x00\x016\x01\x005\x00\x03\x01.\x1b \x026\x00\x01\x1e:\x00\x01\x0b" [])])]) +mapcar +#function("?\x016\x00\x005\x005\x01\x04\x02\x0b" [] #0=[#function(">\x025\x01\x12\x06\x0d\x005\x00\x04\x00\x0b5\x01\x1d\x10\x06\x18\x005\x01\x1d\x0b,\x068\x005\x004\x004\x015\x01\x03\x02!6\x00\x005\x004\x004\x025\x01\x03\x02\x03\x02\x1b\x0b-\x0b" [map car cdr] #0#) ()]) +map! +#function(">\x025\x01-5\x01\x17\x06\x1f\x00\x025\x015\x005\x01\x1d\x03\x01\x1f\x025\x01\x1e9\x01\x05\x05\x00\x02\x0b" []) +member +#function(">\x025\x01\x10\x06\x0a\x00-\x0b5\x01\x1d5\x00\x0f\x06\x16\x005\x01\x0b,\x06$\x004\x005\x005\x01\x1e\x04\x02\x0b-\x0b" [member]) +make-label +#function(">\x014\x00\x04\x00\x0b" [gensym]) +make-code-emitter +#function(">\x00.4\x00\x03\x00/)\x03\x0b" [table]) +make-enum-table +#function(">\x022\x004\x01\x03\x00@\x04\x02\x0b" [#function("A\x02/4\x004\x016\x00\x01\x03\x01\x03\x012\x02\x014\x006\x00\x006\x01\x015\x00*6\x01\x005\x00\"\x02\x04\x03\x0b" [put!])]) + table]) +make-system-image +#function(">\x012\x004\x015\x004\x024\x034\x04\x03\x04@\x04\x02\x0b" [#function("A\x024\x002\x01<4\x02\x03\x00\x03\x02\x024\x035\x00\x04\x01\x0b" [for-each #function(">\x015\x00\x16\x01\x06.\x00\x024\x005\x00\x03\x01\x11\x01\x06.\x00\x024\x015\x00\x03\x01\x18\x11\x01\x06.\x00\x024\x024\x015\x00\x03\x01\x03\x01\x11\x06]\x004\x036\x00\x005\x00\x03\x02\x024\x046\x00\x002\x05\x03\x02\x024\x036\x00\x004\x015\x00\x03\x01\x03\x02\x024\x046\x00\x002\x05\x04\x02\x0b-\x0b" [constant? + top-level-value iostream? io.print io.write "\n"]) environment io.close]) + file :write :create :truncate]) +macroexpand-in +#function(">\x025\x00\x10\x06\x0b\x005\x00\x0b2\x004\x015\x00\x1d5\x01\x03\x02@\x04\x02\x0b" [#function("A\x025\x00\x06\x1d\x004\x004\x015\x00\x03\x016\x00\x00\x1e!4\x025\x00\x03\x01\x04\x02\x0b2\x034\x046\x00\x00\x03\x01@\x04\x02\x0b" [macroexpand-in cadr caddr #function("A\x025\x00\x06\x16\x004\x005\x006\x01\x00\x1e!6\x01\x01\x04\x02\x0b6\x01\x00\x1d2\x01\x0d\x06$\x006\x01\x00\x0b6\x01\x00\x1d2\x02\x0d\x06Q\x004\x032\x024\x046\x01\x00\x03\x014\x004\x056\x01\x00\x03\x016\x01\x01\x03\x024\x066\x01\x00\x03\x01\x04\x04\x0b6\x01\x00\x1d2\x07\x0d\x06s\x002\x084\x046\x01\x00\x03\x014\x094\x0a6\x01\x00\x03\x01\x03\x01@\x04\x03\x0b4\x0b2\x0c<6\x01\x00\x04\x02\x0b" [macroexpand-in + quote lambda nlist* cadr caddr cdddr let-syntax #function("A\x034\x005\x014\x014\x022\x03<5\x00\x03\x026\x02\x01\x03\x02\x04\x02\x0b" [macroexpand-in + nconc map #function(">\x015\x00\x1d4\x004\x015\x00\x03\x016\x03\x01\x03\x026\x03\x01\x1c\x03\x0b" [macroexpand-in cadr])]) f-body cddr map #function(">\x014\x005\x006\x02\x01\x04\x02\x0b" [macroexpand-in])]) + macrocall?]) assq]) +macroexpand +#function(">\x014\x005\x00.\x04\x02\x0b" [macroexpand-in]) +macroexpand-1 +#function(">\x015\x00\x10\x06\x0b\x005\x00\x0b2\x004\x015\x00\x03\x01@\x04\x02\x0b" [#function("A\x025\x00\x06\x0f\x005\x006\x00\x00\x1e\x0c\x0b6\x00\x00\x0b" []) macrocall?]) +lookup-sym +#function(">\x045\x01\x12\x06\x0b\x002\x00\x0b2\x015\x01\x1d@\x04\x02\x0b" [(global) #function("A\x022\x004\x016\x00\x005\x00/\x03\x03@\x04\x02\x0b" [#function("A\x025\x00\x06\x1e\x006\x01\x03\x06\x14\x002\x005\x00\x1c\x02\x0b2\x016\x01\x025\x00\x1c\x03\x0b4\x026\x01\x006\x01\x01\x1e6\x01\x03\x01\x073\x00\x026\x00\x00\x12\x06<\x006\x01\x02\x05B\x006\x01\x020\"\x02-\x04\x04\x0b" [arg + closed lookup-sym]) index-of])]) +macrocall? +#function(">\x015\x00\x1d\x14\x01\x06\x15\x00\x024\x004\x015\x00\x1d-\x04\x03\x0b" [get *syntax-environment*]) +map +#function(">\x025\x01\x10\x06\x0b\x005\x01\x0b5\x005\x01\x1d\x03\x014\x005\x005\x01\x1e\x03\x02\x1b\x0b" [map]) +load +#function(">\x012\x004\x015\x004\x02\x03\x02@\x04\x02\x0b" [#function("A\x022\x00<2\x01<=\x0b" [#function(">\x002\x00-@\x03\x02---\x04\x03\x0b" [#function("A\x022\x00<9\x00\x0b" [#function(">\x034\x006\x01\x00\x03\x01\x11\x06\"\x006\x00\x004\x016\x01\x00\x03\x015\x004\x025\x01\x03\x01\x04\x03\x0b4\x036\x01\x00\x03\x01\x024\x025\x01\x04\x01\x0b" [io.eof? + read load-process io.close])])]) #function(">\x014\x006\x00\x00\x03\x01\x024\x012\x026\x01\x005\x00\x1c\x03\x04\x01\x0b" [io.close raise + load-error])]) file + :read]) +load-process +#function(">\x014\x005\x00\x04\x01\x0b" [eval]) +list-partition +#function(">\x024\x005\x01/\x03\x02\x06\x13\x004\x012\x02\x04\x01\x0b4\x034\x045\x005\x01/..\x03\x05\x04\x01\x0b" [<= error "list-partition: invalid count" nreverse + list-part-]) +list-part- +#function(">\x055\x00\x10\x06\x1f\x004\x005\x02/\x03\x02\x06\x1c\x004\x015\x03\x03\x015\x04\x1b\x0b5\x04\x0b4\x025\x025\x01\x03\x02\x06>\x004\x035\x005\x01/.4\x015\x03\x03\x015\x04\x1b\x04\x05\x0b4\x035\x00\x1e5\x0105\x02\"\x025\x00\x1d5\x03\x1b5\x04\x04\x05\x0b" [> nreverse >= list-part-]) +list-ref +#function(">\x024\x005\x005\x01\x03\x02\x1d\x0b" [list-tail]) +list->vector +#function(">\x014\x005\x00\x0c\x0b" [vector]) +list* +#function("?\x005\x00\x1e\x10\x06\x0d\x005\x00\x1d\x0b5\x00\x1d4\x005\x00\x1e!\x1b\x0b" [list*]) +list-head +#function(">\x024\x005\x01/\x03\x02\x06\x0e\x00.\x0b5\x00\x1d4\x015\x00\x1e5\x010#\x02\x03\x02\x1b\x0b" [<= list-head]) +list-tail +#function(">\x024\x005\x01/\x03\x02\x06\x0f\x005\x00\x0b4\x015\x00\x1e5\x010#\x02\x04\x02\x0b" [<= list-tail]) +list? +#function(">\x015\x00\x12\x01\x07\x19\x00\x025\x00\x17\x01\x06\x19\x00\x024\x005\x00\x1e\x04\x01\x0b" [list?]) +listp +#function(">\x015\x00\x12\x01\x07\x0d\x00\x025\x00\x17\x0b" []) +length> +#function(">\x025\x01/'\x06\x0c\x005\x00\x0b5\x01/&\x06\x1e\x005\x00\x17\x01\x06\x1d\x00\x025\x00\x0b5\x00\x12\x06)\x005\x01/'\x0b4\x005\x00\x1e5\x010#\x02\x04\x02\x0b" [length>]) +length= +#function(">\x025\x01/'\x06\x0b\x00-\x0b5\x01/&\x06\x16\x005\x00\x12\x0b5\x00\x12\x06!\x005\x01/&\x0b4\x005\x00\x1e5\x010#\x02\x04\x02\x0b" [length=]) +last-pair +#function(">\x015\x00\x10\x06\x0b\x005\x00\x0b5\x00\x1e\x10\x06\x15\x005\x00\x0b,\x06!\x004\x005\x00\x1e\x04\x01\x0b-\x0b" [last-pair]) +lastcdr +#function(">\x015\x00\x10\x06\x0b\x005\x00\x0b4\x005\x00\x1e\x04\x01\x0b" [lastcdr]) +just-compile-args +#function(">\x034\x002\x01<5\x01\x04\x02\x0b" [for-each #function(">\x014\x006\x00\x006\x00\x02-5\x00\x04\x04\x0b" [compile-in])]) +iota +#function(">\x014\x004\x015\x00\x04\x02\x0b" [map-int identity]) +io.readline +#function(">\x014\x005\x002\x01\x04\x02\x0b" [io.readuntil #\x000a]) +in-env? +#function(">\x025\x01\x17\x01\x06!\x00\x024\x005\x005\x01\x1d\x03\x02\x01\x07!\x00\x024\x015\x005\x01\x1e\x04\x02\x0b" [memq in-env?]) +index-of +#function(">\x035\x01\x12\x06\x0a\x00-\x0b5\x005\x01\x1d\x0d\x06\x16\x005\x02\x0b,\x06)\x004\x005\x005\x01\x1e5\x020\"\x02\x04\x03\x0b-\x0b" [index-of]) +hex5 +#function(">\x014\x004\x015\x001\x10\x03\x021\x052\x02\x04\x03\x0b" [pad-l number->string #\0]) +identity +#function(">\x015\x00\x0b" []) +get-defined-vars +#function(">\x014\x006\x00\x005\x00\x03\x01\x04\x01\x0b" [delete-duplicates] #0=[#function(">\x015\x00\x10\x06\x0a\x00.\x0b5\x00\x1d2\x00\x0d\x01\x06\x19\x00\x025\x00\x1e\x17\x06\\\x004\x015\x00\x03\x01\x14\x01\x060\x00\x024\x015\x00\x03\x01\x1c\x01\x01\x07[\x00\x024\x015\x00\x03\x01\x17\x01\x06U\x00\x024\x025\x00\x03\x01\x14\x01\x06U\x00\x024\x025\x00\x03\x01\x1c\x01\x01\x07[\x00\x02.\x0b5\x00\x1d2\x03\x0d\x06s\x004\x044\x056\x00\x005\x00\x1e\x03\x02\x0c\x0b.\x0b" [define + cadr caadr begin append map] #0#) ()]) +function? +#function(">\x015\x00\x18\x01\x07&\x00\x024\x005\x00\x03\x012\x01\x0d\x01\x07&\x00\x025\x00\x17\x01\x06&\x00\x025\x00\x1d2\x02\x0d\x0b" [typeof function lambda]) +for-each +#function(">\x025\x01\x17\x06\x1a\x005\x005\x01\x1d\x03\x01\x024\x005\x005\x01\x1e\x04\x02\x0b,\x0b" [for-each]) +foldl +#function(">\x035\x02\x12\x06\x0b\x005\x01\x0b4\x005\x005\x005\x02\x1d5\x01\x03\x025\x02\x1e\x04\x03\x0b" [foldl]) +foldr +#function(">\x035\x02\x12\x06\x0b\x005\x01\x0b5\x005\x02\x1d4\x005\x005\x015\x02\x1e\x03\x03\x04\x02\x0b" [foldr]) +filter +#function(">\x026\x00\x005\x005\x01.\x04\x03\x0b" [] #0=[#function(">\x035\x01\x12\x06\x0b\x005\x02\x0b5\x005\x01\x1d\x03\x01\x06&\x006\x00\x005\x005\x01\x1e5\x01\x1d5\x02\x1b\x04\x03\x0b,\x067\x006\x00\x005\x005\x01\x1e5\x02\x04\x03\x0b-\x0b" [] #0#) ()]) +f-body +#function(">\x012\x006\x00\x005\x00\x03\x01@\x04\x02\x0b" [#function("A\x022\x004\x015\x00\x03\x01@\x04\x02\x0b" [#function("A\x025\x00\x12\x06\x0c\x006\x00\x00\x0b2\x005\x006\x00\x00\x1c\x034\x012\x02<5\x00\x03\x02\x1b\x0b" [lambda map #function(">\x01-\x0b" [])]) + get-defined-vars])] [#function(">\x015\x00\x10\x06\x0a\x00-\x0b5\x00\x1e.\x0d\x06\x16\x005\x00\x1d\x0b,\x06 \x002\x005\x00\x1b\x0b-\x0b" [begin]) + ()]) +expand +#function(">\x014\x005\x00\x04\x01\x0b" [macroexpand]) +every +#function(">\x025\x01\x10\x01\x07\x1f\x00\x025\x005\x01\x1d\x03\x01\x01\x06\x1f\x00\x024\x005\x005\x01\x1e\x04\x02\x0b" [every]) +even? +#function(">\x014\x005\x000\x03\x02/&\x0b" [logand]) +eval +#function(">\x014\x004\x015\x00\x03\x01\x03\x01\x04\x00\x0b" [compile-thunk expand]) +error +#function("?\x004\x002\x015\x00\x1b\x04\x01\x0b" [raise error]) +emit-nothing +#function(">\x015\x00\x0b" []) +encode-byte-code +#function(">\x012\x004\x014\x025\x00\x03\x01\x03\x01@\x04\x02\x0b" [#function("A\x022\x004\x014\x025\x00\x03\x011\x034\x032\x04<5\x00\x03\x02$\x02\"\x022\x05\x03\x02@\x04\x02\x0b" [#function("A\x022\x004\x016\x00\x00\x03\x01@\x04\x02\x0b" [#function("A\x022\x004\x015\x00\x03\x01/4\x02\x03\x004\x02\x03\x004\x03\x03\x00-@\x04\x07\x0b" [#function("A\x07-5\x015\x00'\x06\x90\x00\x026\x00\x005\x01*9\x05\x025\x054\x00\x0d\x06>\x004\x015\x026\x00\x005\x010\"\x02*4\x025\x04\x03\x01\x03\x03\x025\x011\x02\"\x029\x01\x05\x8d\x004\x035\x044\x044\x054\x066\x01\x00\x01\x06X\x00\x024\x075\x052\x08\x03\x02\x06e\x002\x095\x05@\x03\x02\x05g\x005\x05\x03\x02\x03\x01\x03\x02\x025\x010\"\x029\x01\x025\x015\x00'\x06\x8c\x002\x0a6\x00\x005\x01*@\x03\x02\x05\x8d\x00-\x05\x03\x00\x024\x0b2\x0c<5\x03\x03\x02\x024\x0d5\x04\x04\x01\x0b" [:label + put! sizeof io.write byte get Instructions memq (:jmp :brt :brf) + #function("A\x025\x004\x00\x0e\x06\x0d\x004\x01\x0b5\x004\x02\x0e\x06\x18\x004\x03\x0b5\x004\x04\x0e\x06#\x004\x05\x0b-\x0b" [:jmp :jmp.l :brt :brt.l :brf :brf.l]) + #function("A\x022\x006\x00\x05@\x04\x02\x0b" [#function("A\x024\x005\x002\x01\x03\x02\x06&\x004\x026\x01\x044\x036\x00\x00\x03\x01\x03\x02\x026\x01\x010\"\x02:\x01\x01\x0b4\x005\x002\x04\x03\x02\x06J\x004\x026\x01\x044\x056\x00\x00\x03\x01\x03\x02\x026\x01\x010\"\x02:\x01\x01\x0b4\x005\x002\x06\x03\x02\x06\x8b\x004\x026\x01\x044\x056\x00\x00\x03\x01\x03\x02\x026\x01\x010\"\x02:\x01\x01\x024\x026\x01\x044\x056\x02\x006\x01\x01*\x03\x01\x03\x02\x026\x01\x010\"\x02:\x01\x01\x0b4\x005\x002\x07\x03\x02\x06\xca\x004\x086\x01\x034\x096\x01\x04\x03\x016\x00\x00\x03\x03\x024\x026\x01\x046\x03\x00\x06\xb8\x004\x03\x05\xba\x004\x0a/\x03\x01\x03\x02\x026\x01\x010\"\x02:\x01\x01\x0b-\x0b" [memv + (:loadv.l :loadg.l :setg.l) io.write uint32 (:loada :seta :call :tcall :loadv + :loadg :setg :list :+ :- :* :/ + :vector :argc :vargc :loadi8 + :let) uint8 (:loadc :setc) + (:jmp :brf :brt) put! sizeof uint16])]) table.foreach #function(">\x024\x006\x00\x045\x00\x03\x02\x024\x016\x00\x046\x02\x00\x06\x1c\x004\x02\x05\x1e\x004\x034\x046\x00\x025\x01\x03\x02\x03\x01\x04\x02\x0b" [io.seek + io.write uint32 uint16 get]) io.tostring!]) length table buffer]) + list->vector]) + >= length count #function(">\x014\x005\x002\x01\x04\x02\x0b" [memq + (:loadv :loadg :setg :jmp :brt :brf)]) 65536]) peephole nreverse]) +emit +#function("?\x024\x005\x012\x01\x03\x02\x06\x19\x002\x025\x000*@\x03\x02\x05\x1a\x00-\x025\x00/4\x035\x015\x02\x1b5\x00/*\x03\x02+\x025\x00\x0b" [memq (:loadv :loadg :setg) + #function("A\x022\x006\x00\x001\x02*@\x04\x02\x0b" [#function("A\x022\x006\x01\x02\x1d@\x04\x02\x0b" [#function("A\x022\x004\x016\x01\x005\x00\x03\x02\x06\x1c\x004\x026\x01\x005\x00\x03\x02\x059\x004\x036\x01\x005\x006\x00\x00\x03\x03\x026\x00\x000\"\x02:\x00\x00\x026\x00\x000#\x02@\x04\x02\x0b" [#function("A\x026\x03\x001\x026\x01\x00+\x025\x00\x1c\x01:\x03\x02\x024\x005\x002\x01\x03\x02\x06+\x002\x026\x03\x01@\x03\x02:\x03\x01\x0b-\x0b" [>= + 256 #function("A\x025\x004\x00\x0e\x06\x0d\x004\x01\x0b5\x004\x02\x0e\x06\x18\x004\x03\x0b5\x004\x04\x0e\x06#\x004\x05\x0b-\x0b" [:loadv :loadv.l :loadg :loadg.l :setg :setg.l])]) + has? get put!])])]) nreconc]) +disassemble +#function(">\x014\x005\x00/\x03\x02\x024\x01\x04\x00\x0b" [disassemble- newline]) +disassemble- +#function(">\x022\x004\x015\x00\x03\x01@\x04\x02\x0b" [#function("A\x022\x005\x00/*5\x000*@\x04\x03\x0b" [#function("A\x032\x00-@\x04\x02\x0b" [#function("A\x022\x00<9\x00\x022\x01/4\x026\x00\x00\x03\x01@\x04\x03\x0b" [#function(">\x015\x00\x17\x01\x06\x10\x00\x025\x00\x1d2\x00\x0d\x06'\x004\x012\x02\x03\x01\x024\x035\x006\x03\x010\"\x02\x04\x02\x0b4\x045\x00\x04\x01\x0b" [compiled-lambda + princ "\n" disassemble- print]) #function("A\x03-5\x005\x01'\x06 \x00\x022\x004\x014\x026\x01\x005\x00*\x03\x02@\x03\x02\x05\x03\x00\x0b" [#function("A\x024\x006\x00\x00/\x03\x02\x06\x14\x004\x01\x03\x00\x05\x15\x00-\x02/6\x04\x010#\x022\x02 + newline #function(">\x014\x002\x01\x04\x01\x0b" [princ "\t"]) princ hex5 ": " string.tail string "\t" + #function("A\x024\x005\x002\x01\x03\x02\x06,\x006\x02\x006\x03\x014\x026\x03\x006\x01\x00\x03\x02*\x03\x01\x026\x01\x001\x04\"\x02:\x01\x00\x0b4\x005\x002\x03\x03\x02\x06R\x006\x02\x006\x03\x016\x03\x006\x01\x00**\x03\x01\x026\x01\x000\"\x02:\x01\x00\x0b4\x005\x002\x04\x03\x02\x06w\x004\x054\x066\x03\x006\x01\x00*\x03\x01\x03\x01\x026\x01\x000\"\x02:\x01\x00\x0b4\x005\x002\x07\x03\x02\x06\xb8\x004\x054\x066\x03\x006\x01\x00*\x03\x012\x08\x03\x02\x026\x01\x000\"\x02:\x01\x00\x024\x054\x066\x03\x006\x01\x00*\x03\x01\x03\x01\x026\x01\x000\"\x02:\x01\x00\x0b4\x005\x002\x09\x03\x02\x06\xe3\x004\x052\x0a4\x0b4\x0c6\x03\x006\x01\x00\x03\x02\x03\x01\x03\x02\x026\x01\x001\x02\"\x02:\x01\x00\x0b4\x005\x002\x0d\x03\x02\x06\x0e\x014\x052\x0a4\x0b4\x026\x03\x006\x01\x00\x03\x02\x03\x01\x03\x02\x026\x01\x001\x04\"\x02:\x01\x00\x0b-\x0b" [memv + (:loadv.l :loadg.l :setg.l) ref-uint32-LE (:loadv :loadg :setg) + (:loada :seta :call :tcall :list :+ :- :* :/ :vector :argc :vargc :loadi8 + :let) princ number->string (:loadc :setc) " " (:jmp :brf :brt) "@" hex5 + ref-uint16-LE (:jmp.l :brf.l :brt.l)])]) get 1/Instructions]) length])])]) + function->vector]) +display +#function(">\x014\x005\x00\x03\x01\x02,\x0b" [princ]) +delete-duplicates +#function(">\x015\x00\x10\x06\x0b\x005\x00\x0b2\x005\x00\x1d5\x00\x1e@\x04\x03\x0b" [#function("A\x034\x005\x005\x01\x03\x02\x06\x14\x004\x015\x01\x04\x01\x0b5\x004\x015\x01\x03\x01\x1b\x0b" [member delete-duplicates])]) +count +#function(">\x024\x005\x005\x01/\x04\x03\x0b" [count-]) +count- +#function(">\x035\x01\x12\x06\x0b\x005\x02\x0b4\x005\x005\x01\x1e5\x005\x01\x1d\x03\x01\x06$\x005\x020\"\x02\x05&\x005\x02\x04\x03\x0b" [count-]) +copy-tree +#function(">\x015\x00\x10\x06\x0b\x005\x00\x0b4\x005\x00\x1d\x03\x014\x005\x00\x1e\x03\x01\x1b\x0b" [copy-tree]) +copy-list +#function(">\x015\x00\x10\x06\x0b\x005\x00\x0b5\x00\x1d4\x005\x00\x1e\x03\x01\x1b\x0b" [copy-list]) +const-to-idx-vec +#function(">\x012\x005\x000*5\x001\x02*@\x04\x03\x0b" [#function("A\x032\x004\x015\x01\x03\x01@\x04\x02\x0b" [#function("A\x024\x002\x01<6\x00\x00\x03\x02\x025\x00\x0b" [table.foreach #function(">\x026\x00\x005\x015\x00+\x0b" [])]) + vector.alloc])]) +cond->if +#function(">\x014\x005\x00\x1e\x04\x01\x0b" [cond-clauses->if]) +cond-clauses->if +#function(">\x015\x00\x10\x06\x0a\x00-\x0b2\x005\x00\x1d@\x04\x02\x0b" [#function("A\x025\x00\x1d2\x00\x0d\x06\x12\x002\x015\x00\x1e\x1b\x0b2\x025\x00\x1d2\x015\x00\x1e\x1b4\x036\x00\x00\x1e\x03\x01\x1c\x04\x0b" [else begin if cond-clauses->if])]) +compile-while +#function(">\x042\x004\x015\x00\x03\x014\x015\x00\x03\x01@\x04\x03\x0b" [#function("A\x034\x006\x00\x006\x00\x01--\x03\x04\x024\x016\x00\x005\x00\x03\x02\x024\x006\x00\x006\x00\x01-6\x00\x02\x03\x04\x024\x026\x00\x004\x035\x01\x03\x03\x024\x026\x00\x004\x04\x03\x02\x024\x006\x00\x006\x00\x01-6\x00\x03\x03\x04\x024\x026\x00\x004\x055\x00\x03\x03\x024\x016\x00\x005\x01\x04\x02\x0b" [compile-in + mark-label + emit :brf + :pop :jmp]) + make-label]) +compile-short-circuit +#function(">\x065\x03\x10\x06\x15\x004\x005\x005\x015\x025\x04\x04\x04\x0b5\x03\x1e\x10\x06*\x004\x005\x005\x015\x025\x03\x1d\x04\x04\x0b2\x014\x025\x00\x03\x01@\x04\x02\x0b" [compile-in #function("A\x024\x006\x00\x006\x00\x01-6\x00\x03\x1d\x03\x04\x024\x016\x00\x004\x02\x03\x02\x024\x016\x00\x006\x00\x055\x00\x03\x03\x024\x016\x00\x004\x03\x03\x02\x024\x046\x00\x006\x00\x016\x00\x026\x00\x03\x1e6\x00\x046\x00\x05\x03\x06\x024\x056\x00\x005\x00\x04\x02\x0b" [compile-in + emit :dup :pop compile-short-circuit mark-label]) make-label]) +compile-let +#function(">\x042\x005\x03\x1d5\x03\x1e@\x04\x03\x0b" [#function("A\x034\x005\x014\x014\x025\x00\x03\x01\x03\x01\x03\x02\x06\x19\x00-\x05%\x004\x034\x042\x055\x00\x03\x02\x03\x01\x024\x066\x00\x004\x074\x086\x00\x015\x00,\x03\x03\x03\x03\x022\x094\x0a6\x00\x006\x00\x015\x01\x03\x03@\x04\x02\x0b" [length= length cadr + error string "apply: incorrect number of arguments to " + emit :loadv compile-f + #function("A\x024\x006\x01\x004\x01\x03\x02\x024\x006\x01\x006\x01\x02\x06\x1c\x004\x02\x05\x1e\x004\x0305\x00\"\x02\x04\x03\x0b" [emit + :close :tcall :call]) compile-arglist])]) +compile-or +#function(">\x044\x005\x005\x015\x025\x03-4\x01\x04\x06\x0b" [compile-short-circuit :brt]) +compile-prog1 +#function(">\x034\x005\x005\x01-4\x015\x02\x03\x01\x03\x04\x024\x025\x02\x03\x01\x17\x065\x004\x035\x005\x01-4\x025\x02\x03\x01\x03\x04\x024\x045\x004\x05\x04\x02\x0b-\x0b" [compile-in cadr cddr compile-begin emit :pop]) +compile-f +#function("?\x022\x004\x01\x03\x004\x025\x01\x03\x01@\x04\x03\x0b" [#function("A\x036\x00\x02\x12\x11\x06\x1f\x004\x005\x004\x014\x024\x035\x01\x03\x01\x03\x01\x03\x03\x05R\x004\x045\x01\x03\x01\x12\x06:\x004\x005\x004\x054\x035\x01\x03\x01\x03\x03\x05R\x004\x005\x004\x065\x01\x10\x06J\x00/\x05P\x004\x035\x01\x03\x01\x03\x03\x024\x075\x004\x085\x01\x03\x016\x00\x00\x1b,4\x096\x00\x01\x03\x01\x03\x04\x024\x005\x004\x0a\x03\x02\x024\x0b4\x0c5\x00/*\x03\x014\x0d5\x00\x03\x01\x04\x02\x0b" [emit + :let 1+ length lastcdr :argc :vargc compile-in to-proper caddr :ret function + encode-byte-code const-to-idx-vec]) make-code-emitter cadr]) +compile-call +#function(">\x042\x005\x03\x1d@\x04\x02\x0b" [#function("A\x022\x005\x00\x14\x01\x065\x00\x024\x015\x006\x00\x01\x03\x02\x11\x01\x065\x00\x025\x00\x16\x01\x065\x00\x024\x025\x00\x03\x01\x01\x065\x00\x024\x035\x00\x03\x01\x18\x06A\x004\x035\x00\x03\x01\x05C\x005\x00@\x04\x02\x0b" [#function("A\x022\x005\x00\x18\x01\x06\x12\x00\x024\x015\x00\x03\x01@\x04\x02\x0b" [#function("A\x025\x00\x11\x06\x19\x004\x006\x02\x006\x02\x01-6\x00\x00\x03\x04\x05\x1a\x00-\x022\x014\x026\x02\x006\x02\x016\x02\x03\x1e\x03\x03@\x04\x02\x0b" [compile-in + #function("A\x026\x00\x00\x06\x18\x002\x004\x014\x026\x00\x00-\x03\x03@\x04\x02\x0b4\x036\x03\x006\x03\x02\x06(\x004\x04\x05*\x004\x055\x00\x04\x03\x0b" [#function("A\x025\x00\x01\x06\x14\x00\x024\x006\x04\x03\x1e5\x00\x03\x02\x11\x06#\x004\x016\x02\x005\x00\x03\x02\x05$\x00-\x022\x026\x01\x00@\x04\x02\x0b" [length= argc-error + #function("A\x025\x004\x00\x0e\x06*\x006\x01\x00/&\x06\x1c\x004\x016\x05\x004\x02\x04\x02\x0b4\x016\x05\x006\x02\x006\x01\x00\x04\x03\x0b5\x004\x03\x0e\x06b\x006\x01\x00/&\x06D\x004\x016\x05\x004\x04\x04\x02\x0b6\x01\x000&\x06T\x004\x056\x05\x00\x04\x01\x0b4\x016\x05\x006\x02\x006\x01\x00\x04\x03\x0b5\x004\x06\x0e\x06\x89\x006\x01\x00/&\x06{\x004\x076\x03\x000\x04\x02\x0b4\x016\x05\x006\x02\x006\x01\x00\x04\x03\x0b5\x004\x08\x0e\x06\xc1\x006\x01\x00/&\x06\xa3\x004\x016\x05\x004\x09\x04\x02\x0b6\x01\x000&\x06\xb3\x004\x056\x05\x00\x04\x01\x0b4\x016\x05\x006\x02\x006\x01\x00\x04\x03\x0b5\x004\x0a\x0e\x06\xe8\x006\x01\x00/&\x06\xda\x004\x076\x03\x000\x04\x02\x0b4\x016\x05\x006\x02\x006\x01\x00\x04\x03\x0b5\x004\x0b\x0e\x06\x12\x016\x01\x00/&\x06\x04\x014\x016\x05\x004\x0c2\x0d\x04\x03\x0b4\x016\x05\x006\x02\x006\x01\x00\x04\x03\x0b4\x016\x05\x006\x05\x02\x01\x06%\x01\x026\x02\x004\x0e\x0d\x06-\x014\x0f\x050\x016\x02\x00\x04\x02\x0b" [:list + emit :loadnil :+ :load0 emit-nothing :- argc-error :* :load1 :/ :vector + :loadv [] :apply :tapply])]) get arg-counts emit :tcall :call]) + compile-arglist]) builtin->instruction]) in-env? constant? top-level-value])]) +compile-for +#function(">\x054\x005\x04\x03\x01\x068\x004\x015\x005\x01-5\x02\x03\x04\x024\x015\x005\x01-5\x03\x03\x04\x024\x015\x005\x01-5\x04\x03\x04\x024\x025\x004\x03\x04\x02\x0b4\x042\x05\x04\x01\x0b" [1arg-lambda? compile-in emit :for error + "for: third form must be a 1-argument lambda"]) +compile-app +#function(">\x042\x005\x03\x1d@\x04\x02\x0b" [#function("A\x025\x00\x17\x01\x06\x1f\x00\x025\x00\x1d2\x00\x0d\x01\x06\x1f\x00\x024\x014\x025\x00\x03\x01\x03\x01\x063\x004\x036\x00\x006\x00\x016\x00\x026\x00\x03\x04\x04\x0b4\x046\x00\x006\x00\x016\x00\x026\x00\x03\x04\x04\x0b" [lambda list? cadr compile-let + compile-call])]) +compile-arglist +#function(">\x032\x004\x015\x024\x02\x03\x02@\x04\x02\x0b" [#function("A\x025\x00\x069\x004\x006\x00\x004\x016\x00\x024\x02\x03\x026\x00\x01\x03\x03\x022\x034\x044\x052\x06<4\x075\x004\x02\x03\x02\x03\x02\x1b@\x03\x02\x024\x020\"\x02\x0b4\x006\x00\x006\x00\x026\x00\x01\x03\x03\x024\x086\x00\x02\x04\x01\x0b" [just-compile-args + list-head + MAX_ARGS #function("A\x024\x006\x01\x006\x01\x01-5\x00\x04\x04\x0b" [compile-in]) + nconc map #function(">\x014\x005\x00\x1b\x0b" [list]) + list-partition + length]) length> + MAX_ARGS]) +compile +#function(">\x014\x00.5\x00\x04\x02\x0b" [compile-f]) +compile-and +#function(">\x044\x005\x005\x015\x025\x03,4\x01\x04\x06\x0b" [compile-short-circuit :brf]) +compile-begin +#function(">\x045\x03\x10\x06\x14\x004\x005\x005\x015\x02-\x04\x04\x0b5\x03\x1e\x10\x06)\x004\x005\x005\x015\x025\x03\x1d\x04\x04\x0b4\x005\x005\x01-5\x03\x1d\x03\x04\x024\x015\x004\x02\x03\x02\x024\x035\x005\x015\x025\x03\x1e\x04\x04\x0b" [compile-in emit :pop compile-begin]) +compile-if +#function(">\x042\x004\x015\x00\x03\x014\x015\x00\x03\x01@\x04\x03\x0b" [#function("A\x034\x006\x00\x006\x00\x01-4\x016\x00\x03\x03\x01\x03\x04\x024\x026\x00\x004\x035\x00\x03\x03\x024\x006\x00\x006\x00\x016\x00\x024\x046\x00\x03\x03\x01\x03\x04\x026\x00\x02\x06H\x004\x026\x00\x004\x05\x03\x02\x05S\x004\x026\x00\x004\x065\x01\x03\x03\x024\x076\x00\x005\x00\x03\x02\x024\x006\x00\x006\x00\x016\x00\x024\x086\x00\x03\x03\x01\x17\x06~\x004\x096\x00\x03\x03\x01\x05\x7f\x00-\x03\x04\x024\x076\x00\x005\x01\x04\x02\x0b" [compile-in + cadr emit :brf caddr :ret :jmp mark-label cdddr cadddr]) make-label]) +compile-in +#function(">\x045\x03\x14\x06\x15\x004\x005\x005\x015\x032\x01\x04\x04\x0b5\x03\x10\x06\xa1\x005\x03/\x0d\x06+\x004\x025\x004\x03\x04\x02\x0b5\x030\x0d\x06;\x004\x025\x004\x04\x04\x02\x0b5\x03,\x0d\x06K\x004\x025\x004\x05\x04\x02\x0b5\x03-\x0d\x06[\x004\x025\x004\x06\x04\x02\x0b5\x03.\x0d\x06k\x004\x025\x004\x07\x04\x02\x0b5\x03\x1a\x01\x06\x88\x00\x024\x085\x031\x80\x03\x02\x01\x06\x88\x00\x024\x095\x031\x7f\x03\x02\x06\x96\x004\x025\x004\x0a5\x03\x04\x03\x0b4\x025\x004\x0b5\x03\x04\x03\x0b2\x0c5\x03\x1d@\x04\x02\x0b" [compile-sym + [:loada :loadc :loadg] emit :load0 :load1 :loadt :loadf :loadnil >= <= + :loadi8 :loadv #function("A\x025\x002\x00\x0e\x06\x1b\x004\x016\x00\x004\x024\x036\x00\x03\x03\x01\x04\x03\x0b5\x002\x04\x0e\x068\x004\x056\x00\x006\x00\x016\x00\x024\x066\x00\x03\x03\x01\x04\x04\x0b5\x002\x07\x0e\x06Q\x004\x086\x00\x006\x00\x016\x00\x026\x00\x03\x04\x04\x0b5\x002\x09\x0e\x06k\x004\x0a6\x00\x006\x00\x016\x00\x026\x00\x03\x1e\x04\x04\x0b5\x002\x0b\x0e\x06\x81\x004\x0c6\x00\x006\x00\x016\x00\x03\x04\x03\x0b5\x002\x0d\x0e\x06\xa7\x004\x016\x00\x004\x024\x0e6\x00\x016\x00\x03\x03\x02\x03\x03\x024\x016\x00\x004\x0f\x04\x02\x0b5\x002\x10\x0e\x06\xc1\x004\x116\x00\x006\x00\x016\x00\x026\x00\x03\x1e\x04\x04\x0b5\x002\x12\x0e\x06\xdb\x004\x136\x00\x006\x00\x016\x00\x026\x00\x03\x1e\x04\x04\x0b5\x002\x14\x0e\x06\xff\x004\x156\x00\x006\x00\x014\x036\x00\x03\x03\x012\x094\x166\x00\x03\x03\x01\x1b\x04\x04\x0b5\x002\x17\x0e\x06'\x014\x186\x00\x006\x00\x014\x036\x00\x03\x03\x014\x196\x00\x03\x03\x014\x1a6\x00\x03\x03\x01\x04\x05\x0b5\x002\x1b\x0e\x06V\x014\x056\x00\x006\x00\x01-4\x196\x00\x03\x03\x01\x03\x04\x024\x1c6\x00\x006\x00\x014\x036\x00\x03\x03\x012\x1d\x04\x04\x0b5\x002\x1e\x0e\x06\xac\x014\x056\x00\x006\x00\x01-2\x0d.4\x036\x00\x03\x03\x01\x1c\x03\x03\x04\x024\x1f4\x196\x00\x03\x03\x01\x03\x01\x06\x88\x01-\x05\x8e\x014 2!\x03\x01\x024\x056\x00\x006\x00\x01-4\x196\x00\x03\x03\x01\x03\x04\x024\x016\x00\x004\"\x04\x02\x0b4#6\x00\x006\x00\x016\x00\x026\x00\x03\x04\x04\x0b" [quote + emit :loadv cadr cond compile-in cond->if if compile-if begin compile-begin + prog1 compile-prog1 lambda compile-f :closure and compile-and or compile-or + while compile-while cddr for compile-for caddr cadddr set! compile-sym [:seta + :setc :setg] trycatch 1arg-lambda? error "trycatch: second form must be a 1-argument lambda" + :trycatch compile-app])]) +compile-sym +#function(">\x042\x004\x015\x025\x01/,\x03\x04@\x04\x02\x0b" [#function("A\x022\x005\x00\x1d@\x04\x02\x0b" [#function("A\x025\x002\x00\x0e\x06\x1e\x004\x016\x01\x006\x01\x03/*4\x026\x00\x00\x03\x01\x04\x03\x0b5\x002\x03\x0e\x06A\x004\x016\x01\x006\x01\x030*4\x026\x00\x00\x03\x014\x046\x00\x00\x03\x01\x04\x04\x0b4\x016\x01\x006\x01\x031\x02*6\x01\x02\x04\x03\x0b" [arg + emit cadr closed caddr])]) lookup-sym]) +compile-thunk +#function(">\x014\x002\x01.5\x00\x1c\x03\x04\x01\x0b" [compile lambda]) +char? +#function(">\x014\x005\x00\x03\x012\x01\x0d\x0b" [typeof wchar]) +cdddr +#function(">\x015\x00\x1e\x1e\x1e\x0b" []) +cddar +#function(">\x015\x00\x1d\x1e\x1e\x0b" []) +cddr +#function(">\x015\x00\x1e\x1e\x0b" []) +cdadr +#function(">\x015\x00\x1e\x1d\x1e\x0b" []) +cdaar +#function(">\x015\x00\x1d\x1d\x1e\x0b" []) +cdar +#function(">\x015\x00\x1d\x1e\x0b" []) +cadddr +#function(">\x015\x00\x1e\x1e\x1e\x1d\x0b" []) +caddr +#function(">\x015\x00\x1e\x1e\x1d\x0b" []) +cadar +#function(">\x015\x00\x1d\x1e\x1d\x0b" []) +caadr +#function(">\x015\x00\x1e\x1d\x1d\x0b" []) +caaar +#function(">\x015\x00\x1d\x1d\x1d\x0b" []) +caar +#function(">\x015\x00\x1d\x1d\x0b" []) +cadr +#function(">\x015\x00\x1e\x1d\x0b" []) +builtin->instruction +#function(">\x012\x004\x014\x022\x035\x00\x03\x02\x03\x01@\x04\x02\x0b" [#function("A\x024\x004\x015\x00\x03\x02\x01\x06\x11\x00\x025\x00\x0b" [has? Instructions]) intern string #\:]) +bq-bracket +#function(">\x015\x00\x10\x06\x13\x004\x004\x015\x00\x03\x01\x1c\x02\x0b5\x00\x1d2\x02\x0d\x06'\x004\x004\x035\x00\x03\x01\x1c\x02\x0b5\x00\x1d2\x04\x0d\x06;\x002\x054\x035\x00\x03\x01\x1c\x02\x0b5\x00\x1d2\x06\x0d\x06K\x004\x035\x00\x04\x01\x0b,\x06Z\x004\x004\x015\x00\x03\x01\x1c\x02\x0b-\x0b" [list bq-process *comma* cadr + *comma-at* copy-list *comma-dot*]) +bq-bracket1 +#function(">\x015\x00\x17\x01\x06\x10\x00\x025\x00\x1d2\x00\x0d\x06\x1a\x004\x015\x00\x04\x01\x0b4\x025\x00\x04\x01\x0b" [*comma* cadr bq-process]) +bq-process +#function(">\x014\x005\x00\x03\x01\x06$\x005\x00\x19\x06!\x002\x014\x024\x035\x00\x03\x01\x03\x01@\x04\x02\x0b5\x00\x0b5\x00\x10\x061\x002\x045\x00\x1c\x02\x0b5\x00\x1d2\x05\x0d\x06I\x004\x024\x024\x065\x00\x03\x01\x03\x01\x04\x01\x0b5\x00\x1d2\x07\x0d\x06Y\x004\x065\x00\x04\x01\x0b4\x084\x095\x00\x03\x02\x11\x06y\x002\x0a4\x0b5\x00\x03\x014\x0c4\x0d5\x00\x03\x02@\x04\x03\x0b,\x06\x86\x002\x0e5\x00.@\x04\x03\x0b-\x0b" [self-evaluating? #function("A\x025\x00\x1d2\x00\x0d\x06\x12\x004\x015\x00\x1e\x1b\x0b4\x024\x015\x00\x1c\x03\x0b" [list + vector apply]) bq-process vector->list quote backquote cadr *comma* any + splice-form? #function("A\x035\x00\x12\x06\x0e\x002\x005\x01\x1b\x0b4\x012\x025\x01\x1b4\x035\x00\x03\x01\x1c\x01\x04\x02\x0b" [list + nconc nlist* bq-process]) lastcdr map bq-bracket1 #function("A\x03-5\x00\x17\x01\x06\x12\x00\x025\x00\x1d2\x00\x0d\x11\x06+\x00\x024\x015\x00\x1d\x03\x015\x01\x1b9\x01\x025\x00\x1e9\x00\x05\x03\x00\x022\x025\x00\x17\x06E\x004\x035\x014\x045\x00\x03\x01\x1c\x01\x03\x02\x05j\x005\x00\x12\x06T\x004\x055\x01\x03\x01\x05j\x00,\x06i\x004\x035\x014\x065\x00\x03\x01\x1c\x01\x03\x02\x05j\x00-@\x04\x02\x0b" [*comma* + bq-bracket #function("A\x025\x00\x1e\x12\x06\x0d\x005\x00\x1d\x0b2\x005\x00\x1b\x0b" [nconc]) nreconc cadr nreverse bq-process])]) +assv +#function(">\x025\x01\x10\x06\x0a\x00-\x0b4\x005\x01\x03\x015\x00\x0e\x06\x1a\x005\x01\x1d\x0b,\x06(\x004\x015\x005\x01\x1e\x04\x02\x0b-\x0b" [caar assv]) +assoc +#function(">\x025\x01\x10\x06\x0a\x00-\x0b4\x005\x01\x03\x015\x00\x0f\x06\x1a\x005\x01\x1d\x0b,\x06(\x004\x015\x005\x01\x1e\x04\x02\x0b-\x0b" [caar assoc]) +argc-error +#function(">\x024\x004\x012\x025\x002\x035\x015\x010&\x06\x1a\x002\x04\x05\x1c\x002\x05\x03\x05\x04\x01\x0b" [error string "compile error: " " expects " " argument." + " arguments."]) +arg-counts +#table(:not 1 :set-cdr! 2 :cons 2 :number? 1 :equal? 2 :cdr 1 :vector? 1 :eqv? 2 :apply 2 := 2 :atom? 1 :aref 2 :compare 2 :< 2 :null? 1 :eq? 2 :car 1 :set-car! 2 :builtin? 1 :aset! 3 :bound? 1 :boolean? 1 :pair? 1 :symbol? 1 :fixnum? 1) +any +#function(">\x025\x01\x17\x01\x06\x1f\x00\x025\x005\x01\x1d\x03\x01\x01\x07\x1f\x00\x024\x005\x005\x01\x1e\x04\x02\x0b" [any]) +__start +#function(">\x014\x00\x03\x00\x025\x00\x1e\x17\x06!\x005\x00\x1e8\x01\x024\x024\x035\x00\x03\x01\x03\x01\x051\x005\x008\x01\x024\x044\x05\x03\x01\x024\x06\x03\x00\x024\x07/\x04\x01\x0b" [__init_globals *argv* __script cadr princ + *banner* repl exit]) +__script +#function(">\x012\x00<2\x01<=\x0b" [#function(">\x004\x006\x00\x00\x04\x01\x0b" [load]) + #function(">\x014\x005\x00\x03\x01\x024\x010\x04\x01\x0b" [print-exception exit])]) +__init_globals +#function(">\x004\x002\x01\x0d\x01\x07\x1b\x00\x024\x002\x02\x0d\x01\x07\x1b\x00\x024\x002\x03\x0d\x06*\x002\x048\x05\x022\x068\x07\x053\x002\x088\x05\x022\x098\x07\x024\x0a8\x0b\x024\x0c8\x0d\x0b" [*os-name* win32 win64 windows "\\" + *directory-separator* "\r\n" *linefeed* "/" + "\n" *stdout* *output-stream* *stdin* + *input-stream*]) +abs +#function(">\x015\x00/'\x06\x0e\x005\x00#\x01\x0b5\x00\x0b" []) +append +#function("?\x005\x00\x12\x06\x0a\x00.\x0b5\x00\x1e\x12\x06\x15\x005\x00\x1d\x0b,\x06'\x004\x005\x00\x1d4\x015\x00\x1e!\x04\x02\x0b-\x0b" [append2 append]) +append2 +#function(">\x025\x00\x12\x06\x0b\x005\x01\x0b5\x00\x1d4\x005\x00\x1e5\x01\x03\x02\x1b\x0b" [append2]) +MAX_ARGS +127 +Instructions +#table(:nop 0 :tapply 12 :set-cdr! 32 :/ 37 :setc 58 :cons 27 :equal? 15 :cdr 30 :call 3 :eqv? 14 := 38 :setg.l 59 :list 28 :atom? 16 :aref 42 :load0 47 :let 65 :argc 62 :< 39 :null? 18 :loadg 52 :load1 48 :car 29 :brt.l 10 :vargc 63 :loada 53 :set-car! 31 :setg 56 :aset! 43 :bound? 22 :pair? 23 :symbol? 20 :fixnum? 26 :loadi8 49 :not 17 :* 36 :pop 2 :loadnil 46 :brf 6 :vector 41 :- 35 :loadv 50 :closure 60 :number? 21 :trycatch 61 :loadv.l 51 :vector? 25 :brf.l 9 :seta 57 :apply 33 :dup 1 :for 66 :loadc 54 :compare 40 :eq? 13 :+ 34 :jmp 5 :loadt 44 :brt 7 :builtin? 24 :loadg.l 55 :close 64 :tcall 4 :ret 11 :boolean? 19 :loadf 45 :jmp.l 8) +>= +#function(">\x025\x015\x00'\x01\x07\x11\x00\x025\x005\x01&\x0b" []) +> +#function(">\x025\x015\x00'\x0b" []) +<= +#function(">\x025\x005\x01'\x01\x07\x11\x00\x025\x005\x01&\x0b" []) +1arg-lambda? +#function(">\x015\x00\x17\x01\x065\x00\x025\x00\x1d2\x00\x0d\x01\x065\x00\x025\x00\x1e\x17\x01\x065\x00\x024\x015\x00\x03\x01\x17\x01\x065\x00\x024\x024\x015\x00\x03\x010\x04\x02\x0b" [lambda cadr length=]) +1/Instructions +#table(2 :pop 45 :loadf 59 :setg.l 15 :equal? 38 := 50 :loadv 61 :trycatch 14 :eqv? 30 :cdr 40 :compare 11 :ret 28 :list 48 :load1 22 :bound? 36 :* 60 :closure 41 :vector 0 :nop 29 :car 56 :setg 23 :pair? 17 :not 4 :tcall 43 :aset! 3 :call 58 :setc 21 :number? 8 :jmp.l 39 :< 63 :vargc 51 :loadv.l 53 :loada 66 :for 44 :loadt 65 :let 55 :loadg.l 5 :jmp 27 :cons 46 :loadnil 34 :+ 6 :brf 16 :atom? 42 :aref 10 :brt.l 31 :set-car! 25 :vector? 54 :loadc 13 :eq? 19 :boolean? 47 :load0 12 :tapply 32 :set-cdr! 62 :argc 20 :symbol? 26 :fixnum? 35 :- 9 :brf.l 7 :brt 37 :/ 18 :null? 52 :loadg 49 :loadi8 1 :dup 24 :builtin? 64 :close 33 :apply 57 :seta) +1- +#function(">\x015\x000#\x02\x0b" []) +1+ +#function(">\x015\x000\"\x02\x0b" []) +/= +#function(">\x025\x005\x01&\x11\x0b" []) +*whitespace* +"\t\n\v\f\r \u0085  ᠎           \u2028\u2029  　" +*syntax-environment* +#table(define #function("?\x015\x00\x14\x06\x12\x002\x005\x005\x01\x1d\x1c\x03\x0b2\x005\x00\x1d2\x015\x00\x1e4\x025\x01\x03\x01\x1c\x03\x1c\x03\x0b" [set! lambda f-body]) letrec #function("?\x012\x004\x014\x025\x00\x03\x024\x034\x044\x012\x05<5\x00\x03\x025\x01\x03\x02\x03\x01\x1c\x034\x012\x06<5\x00\x03\x02\x1b\x0b" [lambda + map car f-body nconc #function(">\x012\x005\x00\x1b\x0b" [set!]) + #function(">\x01-\x0b" [])]) backquote #function(">\x014\x005\x00\x04\x01\x0b" [bq-process]) assert #function(">\x012\x005\x00,2\x012\x022\x035\x00\x1c\x02\x1c\x02\x1c\x02\x1c\x04\x0b" [if + raise quote assert-failed]) label #function(">\x022\x005\x00\x1c\x012\x015\x005\x01\x1c\x03\x1c\x03-\x1c\x02\x0b" [lambda set!]) do #function("?\x022\x004\x01\x03\x005\x01\x1d4\x024\x035\x00\x03\x024\x024\x045\x00\x03\x024\x022\x05<5\x00\x03\x02@\x04\x06\x0b" [#function("A\x062\x005\x002\x015\x022\x025\x014\x032\x04\x1c\x014\x056\x00\x01\x1e\x03\x01\x03\x024\x032\x04\x1c\x014\x056\x00\x02\x03\x014\x035\x00\x1c\x014\x055\x04\x03\x01\x03\x02\x1c\x01\x03\x03\x1c\x04\x1c\x03\x1c\x02\x1c\x014\x035\x00\x1c\x014\x055\x03\x03\x01\x03\x02\x1c\x03\x0b" [letrec + lambda if nconc begin copy-list]) gensym map car cadr #function(">\x014\x005\x00\x03\x01\x17\x06\x13\x004\x015\x00\x04\x01\x0b5\x00\x1d\x0b" [cddr + caddr])]) when #function("?\x012\x005\x004\x015\x01\x03\x01-\x1c\x04\x0b" [if f-body]) dotimes #function("?\x012\x005\x00\x1d4\x015\x00\x03\x01@\x04\x03\x0b" [#function("A\x032\x00/2\x015\x010\x1c\x032\x025\x00\x1c\x014\x036\x00\x01\x03\x01\x1c\x03\x1c\x04\x0b" [for + - lambda f-body]) cadr]) unwind-protect #function(">\x022\x004\x01\x03\x00@\x04\x02\x0b" [#function("A\x022\x002\x016\x00\x002\x025\x00\x1c\x012\x036\x00\x012\x045\x00\x1c\x02\x1c\x03\x1c\x03\x1c\x036\x00\x01\x1c\x03\x0b" [prog1 + trycatch lambda begin raise]) gensym]) define-macro #function("?\x012\x002\x015\x00\x1d\x1c\x022\x025\x00\x1e4\x035\x01\x03\x01\x1c\x03\x1c\x03\x0b" [set-syntax! + quote lambda f-body]) unless #function("?\x012\x005\x00-4\x015\x01\x03\x01\x1c\x04\x0b" [if f-body]) let #function("?\x012\x00-@\x04\x02\x0b" [#function("A\x026\x00\x00\x14\x06!\x006\x00\x009\x00\x026\x00\x01\x1d:\x00\x00\x026\x00\x01\x1e:\x00\x01\x05\"\x00-\x022\x002\x014\x022\x03<6\x00\x00\x03\x024\x046\x00\x01\x03\x01\x1c\x034\x022\x05<6\x00\x00\x03\x02@\x04\x03\x0b" [#function("A\x036\x00\x00\x06\x14\x002\x006\x00\x005\x00\x1c\x03\x05\x16\x005\x005\x01\x1b\x0b" [label]) + lambda map #function(">\x015\x00\x17\x06\x0c\x005\x00\x1d\x0b5\x00\x0b" []) f-body #function(">\x015\x00\x17\x06\x0f\x004\x005\x00\x04\x01\x0b-\x0b" [cadr])])]) throw #function(">\x022\x002\x012\x022\x03\x1c\x025\x005\x01\x1c\x04\x1c\x02\x0b" [raise + list quote thrown-value]) time #function(">\x012\x004\x01\x03\x00@\x04\x02\x0b" [#function("A\x022\x005\x002\x01\x1c\x01\x1c\x02\x1c\x012\x026\x00\x002\x032\x042\x052\x01\x1c\x015\x00\x1c\x032\x06\x1c\x04\x1c\x03\x1c\x03\x0b" [let + time.now prog1 princ "Elapsed time: " - " seconds\n"]) gensym]) let* #function("?\x015\x00\x10\x06\x0f\x004\x005\x01\x04\x01\x0b2\x014\x025\x00\x03\x01\x1c\x014\x032\x04\x1c\x015\x00\x1e\x1c\x014\x055\x01\x03\x01\x03\x03\x1c\x034\x065\x00\x03\x01\x1c\x02\x0b" [f-body + lambda caar nconc let* copy-list cadar]) case #function("?\x012\x00-@\x04\x02\x0b" [#function("A\x022\x00<9\x00\x022\x014\x02\x03\x00@\x04\x02\x0b" [#function(">\x025\x012\x00\x0d\x06\x0d\x002\x00\x0b5\x01\x12\x06\x15\x00-\x0b5\x01\x10\x06(\x002\x015\x004\x025\x01\x03\x01\x1c\x03\x0b5\x01\x1e\x12\x06=\x002\x015\x004\x025\x01\x1d\x03\x01\x1c\x03\x0b2\x035\x002\x045\x01\x1c\x02\x1c\x03\x0b" [else + eqv? quote-value memv quote]) #function("A\x022\x005\x006\x01\x00\x1c\x02\x1c\x014\x012\x02\x1c\x014\x034\x042\x05<6\x01\x01\x03\x02\x03\x01\x03\x02\x1c\x03\x0b" [let nconc cond + copy-list map #function(">\x016\x01\x006\x00\x005\x00\x1d\x03\x025\x00\x1e\x1b\x0b" [])]) + gensym])]) catch #function(">\x022\x004\x01\x03\x00@\x04\x02\x0b" [#function("A\x022\x006\x00\x012\x015\x00\x1c\x012\x022\x032\x045\x00\x1c\x022\x052\x065\x00\x1c\x022\x072\x08\x1c\x02\x1c\x032\x052\x095\x00\x1c\x026\x00\x00\x1c\x03\x1c\x042\x0a5\x00\x1c\x022\x0b5\x00\x1c\x02\x1c\x04\x1c\x03\x1c\x03\x0b" [trycatch + lambda if and pair? eq car quote thrown-value cadr caddr raise]) gensym])) +*print-width* +80 +*linefeed* +"\n" +*directory-separator* +"/" +*print-pretty* +#t +*argv* +("./flisp") +*banner* +"; _\n; |_ _ _ |_ _ | . _ _\n; | (-||||_(_)|__|_)|_)\n;-------------------|----------------------------------------------------------\n\n" diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c index e178107..7e9b464 100644 --- a/femtolisp/flisp.c +++ b/femtolisp/flisp.c @@ -53,10 +53,8 @@ #include "opcodes.h" static char *builtin_names[] = - { // special forms - "quote", "cond", "if", "and", "or", "while", "lambda", - "trycatch", "%apply", "set!", "prog1", "for", "begin", - + { NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, + NULL, NULL, NULL, NULL, NULL, // predicates "eq?", "eqv?", "equal?", "atom?", "not", "null?", "boolean?", "symbol?", "number?", "bound?", "pair?", "builtin?", "vector?", "fixnum?", @@ -65,7 +63,7 @@ static char *builtin_names[] = "cons", "list", "car", "cdr", "set-car!", "set-cdr!", // execution - "eval", "apply", + "apply", // arithmetic "+", "-", "*", "/", "=", "<", "compare", @@ -80,7 +78,7 @@ static short builtin_arg_counts[] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, ANYARGS, 1, 1, 2, 2, - 1, 2, + 2, ANYARGS, -1, ANYARGS, -1, 2, 2, 2, ANYARGS, 2, 3 }; @@ -89,25 +87,15 @@ value_t StaticStack[N_STACK]; value_t *Stack = StaticStack; uint32_t SP = 0; -typedef struct _stackseg_t { - value_t *Stack; - uint32_t SP; - struct _stackseg_t *prev; -} stackseg_t; - -stackseg_t stackseg0 = { StaticStack, 0, NULL }; -stackseg_t *current_stack_seg = &stackseg0; - value_t NIL, FL_T, FL_F, LAMBDA, QUOTE, IF, TRYCATCH; value_t BACKQUOTE, COMMA, COMMAAT, COMMADOT, FUNCTION; value_t IOError, ParseError, TypeError, ArgError, UnboundError, MemoryError; value_t DivideError, BoundsError, Error, KeyError, EnumerationError; value_t conssym, symbolsym, fixnumsym, vectorsym, builtinsym; value_t definesym, defmacrosym, forsym, labelsym, printprettysym, setqsym; -value_t printwidthsym, tsym, Tsym, fsym, Fsym, booleansym, nullsym, elsesym; +value_t printwidthsym, tsym, Tsym, fsym, Fsym, booleansym, nullsym, evalsym; static fltype_t *functiontype; -static value_t eval_sexpr(value_t e, value_t *penv, int tail, uint32_t envsz); static value_t apply_cl(uint32_t nargs); static value_t *alloc_words(int n); static value_t relocate(value_t v); @@ -357,8 +345,11 @@ static value_t *alloc_words(int n) #define mark_cons(c) bitvector_set(consflags, cons_index(c), 1) #define unmark_cons(c) bitvector_set(consflags, cons_index(c), 0) +static value_t the_empty_vector; + value_t alloc_vector(size_t n, int init) { + if (n == 0) return the_empty_vector; value_t *c = alloc_words(n+1); value_t v = tagptr(c, TAG_VECTOR); vector_setsize(v, n); @@ -418,7 +409,8 @@ static value_t relocate(value_t v) newsz = sz; if (vector_elt(v,-1) & 0x1) newsz += vector_grow_amt(sz); - nc = alloc_vector(newsz, 0); + nc = tagptr(alloc_words(newsz+1), TAG_VECTOR); + vector_setsize(nc, newsz); a = vector_elt(v,0); forward(v, nc); i = 0; @@ -478,8 +470,6 @@ static void trace_globals(symbol_t *root) } } -static value_t special_apply_form; -static value_t apply1_args; static value_t memory_exception_value; void gc(int mustgrow) @@ -488,18 +478,12 @@ void gc(int mustgrow) void *temp; uint32_t i; readstate_t *rs; - stackseg_t *ss; curheap = tospace; lim = curheap+heapsize-sizeof(cons_t); - ss = current_stack_seg; - ss->SP = SP; - while (ss) { - for (i=0; i < ss->SP; i++) - ss->Stack[i] = relocate(ss->Stack[i]); - ss = ss->prev; - } + for (i=0; i < SP; i++) + Stack[i] = relocate(Stack[i]); trace_globals(symtab); relocate_typetable(); rs = readstate; @@ -512,9 +496,8 @@ void gc(int mustgrow) rs = rs->prev; } lasterror = relocate(lasterror); - special_apply_form = relocate(special_apply_form); - apply1_args = relocate(apply1_args); memory_exception_value = relocate(memory_exception_value); + the_empty_vector = relocate(the_empty_vector); sweep_finalizers(); @@ -551,13 +534,25 @@ void gc(int mustgrow) // utils ---------------------------------------------------------------------- -#define topeval(e, env) (selfevaluating(e) ? (e) : eval_sexpr((e),env,1,2)) - // apply function with n args on the stack static value_t _applyn(uint32_t n) { - PUSH(fixnum(n)); - return topeval(special_apply_form, NULL); + value_t f = Stack[SP-n-1]; + uint32_t saveSP = SP; + value_t v; + if (isbuiltinish(f)) { + if (uintval(f) > N_BUILTINS) { + v = ((builtin_t)ptr(f))(&Stack[SP-n], n); + SP = saveSP; + return v; + } + } + else if (isfunction(f)) { + v = apply_cl(n); + SP = saveSP; + return v; + } + type_error("apply", "function", f); } value_t apply(value_t f, value_t l) @@ -567,7 +562,7 @@ value_t apply(value_t f, value_t l) PUSH(f); while (iscons(v)) { - if (n == MAX_ARGS) { + if ((SP-n-1) == MAX_ARGS) { PUSH(v); break; } @@ -575,6 +570,7 @@ value_t apply(value_t f, value_t l) v = cdr_(v); } n = SP - n - 1; + assert(n <= MAX_ARGS+1); v = _applyn(n); POPN(n+1); return v; @@ -700,94 +696,7 @@ static value_t list(value_t *args, uint32_t nargs) return v; } -#define eval(e) (selfevaluating(e) ? (e) : eval_sexpr((e),penv,0,envsz)) -#define tail_eval(xpr) do { \ - if (selfevaluating(xpr)) { SP=saveSP; return (xpr); } \ - else { e=(xpr); goto eval_top; } } while (0) - -/* eval a list of expressions, giving a list of the results */ -static value_t evlis(value_t *pv, value_t *penv, uint32_t envsz) -{ - PUSH(NIL); - PUSH(NIL); - value_t *rest = &Stack[SP-1]; - value_t a, v = *pv; - while (iscons(v)) { - a = car_(v); - v = eval(a); - PUSH(v); - v = mk_cons(); - car_(v) = Stack[SP-1]; - cdr_(v) = NIL; - POPN(1); - if (*rest == NIL) - Stack[SP-2] = v; - else - cdr_(*rest) = v; - *rest = v; - v = *pv = cdr_(*pv); - } - POPN(1); - return POP(); -} - -/* - If we start to run out of space on the lisp value stack, we allocate - a new stack array and put it on the top of the chain. The new stack - is active until this function returns. Any return past this function - must free the new segment. -*/ -static value_t new_stackseg(value_t e, value_t *penv, int tail, uint32_t envsz) -{ - stackseg_t s; - - s.prev = current_stack_seg; - s.Stack = (value_t*)malloc(N_STACK * sizeof(value_t)); - if (s.Stack == NULL) - lerror(MemoryError, "eval: stack overflow"); - current_stack_seg->SP = SP; - current_stack_seg = &s; - SP = 0; - Stack = s.Stack; - value_t v = NIL; - int err = 0; - FL_TRY { - v = eval_sexpr(e, penv, tail, envsz); - } - FL_CATCH { - err = 1; - v = lasterror; - } - free(s.Stack); - current_stack_seg = s.prev; - SP = current_stack_seg->SP; - Stack = current_stack_seg->Stack; - if (err) raise(v); - return v; -} - -static value_t do_trycatch(value_t expr, value_t *penv, uint32_t envsz) -{ - value_t v; - - FL_TRY { - v = eval(expr); - } - FL_CATCH { - v = cdr_(Stack[SP-1]); - if (!iscons(v)) { - v = FL_F; // 1-argument form - } - else { - v = car_(v); - Stack[SP-1] = eval(v); - v = applyn(1, Stack[SP-1], lasterror); - } - } - return v; -} - -static value_t do_trycatch2() +static value_t do_trycatch() { uint32_t saveSP = SP; value_t v; @@ -806,725 +715,6 @@ static value_t do_trycatch2() return v; } -/* stack setup on entry: - n n+1 ... - +-----+-----+-----+-----+-----+-----+-----+-----+ - | LL | VAL | VAL | CLO | | | | | - +-----+-----+-----+-----+-----+-----+-----+-----+ - ^ ^ - | | - penv SP (who knows where) - - where LL is the lambda list, CLO is a closed-up environment vector - (which can be empty, i.e. NIL). An environment vector is just a copy - of the stack from LL through CLO. - There might be zero values, in which case LL is NIL. - - penv[-1] tells you the environment size, from LL through CLO, as a fixnum. -*/ -static value_t eval_sexpr(value_t e, value_t *penv, int tail, uint32_t envsz) -{ - value_t f, v, *pv, *lenv; - cons_t *c; - symbol_t *sym; - uint32_t saveSP, bp, nargs; - int i, noeval=0; - fixnum_t s, lo, hi; - int64_t accum; - - /* - ios_printf(ios_stdout, "eval "); print(ios_stdout, e, 0); - ios_printf(ios_stdout, " in "); print(ios_stdout, penv[0], 0); - ios_printf(ios_stdout, "\n"); - */ - saveSP = SP; - eval_top: - if (issymbol(e)) { - sym = (symbol_t*)ptr(e); - while (1) { - v = *penv++; - while (iscons(v)) { - if (car_(v)==e) { SP=saveSP; return *penv; } - v = cdr_(v); penv++; - } - if (v != NIL) { - if (v == e) { SP=saveSP; return *penv; } // dotted list - penv++; - } - if (*penv == NIL) break; - assert(isvector(*penv)); - penv = &vector_elt(*penv, 0); - } - if (__unlikely((v = sym->binding) == UNBOUND)) - raise(list2(UnboundError, e)); - SP = saveSP; - return v; - } - if (__unlikely(SP >= (N_STACK-MAX_ARGS-4))) { - v = new_stackseg(e, penv, tail, envsz); - SP = saveSP; - return v; - } - bp = SP; - v = car_(e); - PUSH(cdr_(e)); - if (selfevaluating(v)) f=v; - else if (issymbol(v) && (f=((symbol_t*)ptr(v))->syntax) && f!=TAG_CONST) { - // handle special syntax forms - if (isspecial(f)) - goto apply_special; - else { - PUSH(f); - noeval = 2; - v = Stack[bp]; - goto move_args; - } - } - else f = eval(v); - PUSH(f); - v = Stack[bp]; - // evaluate argument list, placing arguments on stack - while (iscons(v)) { - if (SP-bp-2 == MAX_ARGS) { - v = evlis(&Stack[bp], penv, envsz); - PUSH(v); - break; - } - v = car_(v); - v = eval(v); - PUSH(v); - v = Stack[bp] = cdr_(Stack[bp]); - } - do_apply: - nargs = SP - bp - 2; - if (isbuiltinish(f)) { - // handle builtin function - apply_special: - switch (uintval(f)) { - // special forms - case F_QUOTE: - if (__unlikely(!iscons(Stack[bp]))) - lerror(ArgError, "quote: expected argument"); - v = car_(Stack[bp]); - break; - case F_SETQ: - e = car(Stack[bp]); - v = car(cdr_(Stack[bp])); - v = eval(v); - while (1) { - f = *penv++; - while (iscons(f)) { - if (car_(f)==e) { - *penv = v; - SP = saveSP; - return v; - } - f = cdr_(f); penv++; - } - if (f != NIL) { - if (f == e) { - *penv = v; - SP = saveSP; - return v; - } - penv++; - } - if (*penv == NIL) break; - penv = &vector_elt(*penv, 0); - } - sym = tosymbol(e, "set!"); - if (sym->syntax != TAG_CONST) - sym->binding = v; - break; - case F_LAMBDA: - // build a closure (lambda args body . env) - if (*penv != NIL) { - // save temporary environment to the heap - lenv = penv; - assert(penv[envsz-1]==NIL || isvector(penv[envsz-1])); - pv = alloc_words(envsz + 1); - PUSH(tagptr(pv, TAG_VECTOR)); - pv[0] = fixnum(envsz); - pv++; - while (envsz--) - *pv++ = *penv++; - assert(pv[-1]==NIL || isvector(pv[-1])); - // environment representation changed; install - // the new representation so everybody can see it - lenv[0] = NIL; - lenv[1] = Stack[SP-1]; - } - else { - PUSH(penv[1]); // env has already been captured; share - } - c = (cons_t*)ptr(v=cons_reserve(3)); - e = Stack[bp]; - if (!iscons(e)) goto notpair; - c->car = LAMBDA; - c->cdr = tagptr(c+1, TAG_CONS); c++; - c->car = car_(e); //argsyms - c->cdr = tagptr(c+1, TAG_CONS); c++; - if (!iscons(e=cdr_(e))) goto notpair; - c->car = car_(e); //body - c->cdr = Stack[SP-1]; //env - break; - case F_IF: - if (!iscons(Stack[bp])) goto notpair; - v = car_(Stack[bp]); - if (eval(v) != FL_F) { - v = cdr_(Stack[bp]); - if (!iscons(v)) goto notpair; - v = car_(v); - } - else { - v = cdr_(Stack[bp]); - if (!iscons(v)) goto notpair; - if (!iscons(v=cdr_(v))) v = FL_F; // allow 2-arg form - else v = car_(v); - } - tail_eval(v); - break; - case F_COND: - pv = &Stack[bp]; v = FL_F; - while (iscons(*pv)) { - c = tocons(car_(*pv), "cond"); - v = c->car; - // allow last condition to be 'else' - if (iscons(cdr_(*pv)) || v != elsesym) - v = eval(v); - if (v != FL_F) { - *pv = cdr_(car_(*pv)); - // evaluate body forms - if (iscons(*pv)) { - while (iscons(cdr_(*pv))) { - v = car_(*pv); - v = eval(v); - *pv = cdr_(*pv); - } - tail_eval(car_(*pv)); - } - break; - } - *pv = cdr_(*pv); - } - break; - case F_AND: - pv = &Stack[bp]; v = FL_T; - if (iscons(*pv)) { - while (iscons(cdr_(*pv))) { - if ((v=eval(car_(*pv))) == FL_F) { - SP = saveSP; return FL_F; - } - *pv = cdr_(*pv); - } - tail_eval(car_(*pv)); - } - break; - case F_OR: - pv = &Stack[bp]; v = FL_F; - if (iscons(*pv)) { - while (iscons(cdr_(*pv))) { - if ((v=eval(car_(*pv))) != FL_F) { - SP = saveSP; return v; - } - *pv = cdr_(*pv); - } - tail_eval(car_(*pv)); - } - break; - case F_WHILE: - PUSH(cdr(Stack[bp])); - lenv = &Stack[SP-1]; - PUSH(*lenv); - Stack[bp] = car_(Stack[bp]); - value_t *cond = &Stack[bp]; - PUSH(FL_F); - pv = &Stack[SP-1]; - while (eval(*cond) != FL_F) { - *lenv = Stack[SP-2]; - while (iscons(*lenv)) { - *pv = eval(car_(*lenv)); - *lenv = cdr_(*lenv); - } - } - v = *pv; - break; - case F_BEGIN: - // return last arg - pv = &Stack[bp]; - if (iscons(*pv)) { - while (iscons(cdr_(*pv))) { - v = car_(*pv); - (void)eval(v); - *pv = cdr_(*pv); - } - tail_eval(car_(*pv)); - } - v = FL_F; - break; - case F_PROG1: - // return first arg - pv = &Stack[bp]; - if (__unlikely(!iscons(*pv))) - lerror(ArgError, "prog1: too few arguments"); - PUSH(eval(car_(*pv))); - *pv = cdr_(*pv); - while (iscons(*pv)) { - (void)eval(car_(*pv)); - *pv = cdr_(*pv); - } - v = POP(); - break; - case F_FOR: - if (!iscons(Stack[bp])) goto notpair; - v = car_(Stack[bp]); - lo = tofixnum(eval(v), "for"); - Stack[bp] = cdr_(Stack[bp]); - if (!iscons(Stack[bp])) goto notpair; - v = car_(Stack[bp]); - hi = tofixnum(eval(v), "for"); - Stack[bp] = cdr_(Stack[bp]); - if (!iscons(Stack[bp])) goto notpair; - v = car_(Stack[bp]); - f = eval(v); - v = car(cdr(f)); - if (!iscons(v) || !iscons(cdr_(cdr_(f))) || cdr_(v) != NIL || - car_(f) != LAMBDA) - lerror(ArgError, "for: expected 1 argument lambda"); - f = cdr_(f); - PUSH(f); // save function cdr - SP += 3; // make space - Stack[SP-1] = cdr_(cdr_(f)); // cloenv - v = FL_F; - for(s=lo; s <= hi; s++) { - f = Stack[SP-4]; - Stack[SP-3] = car_(f); // lambda list - Stack[SP-2] = fixnum(s); // argument value - v = car_(cdr_(f)); - if (!selfevaluating(v)) v = eval_sexpr(v, &Stack[SP-3], 0, 3); - } - break; - case F_TRYCATCH: - v = do_trycatch(car(Stack[bp]), penv, envsz); - break; - - // ordinary functions - case F_BOUNDP: - argcount("bound?", nargs, 1); - sym = tosymbol(Stack[SP-1], "bound?"); - v = (sym->binding == UNBOUND) ? FL_F : FL_T; - break; - case F_EQ: - argcount("eq?", nargs, 2); - v = ((Stack[SP-2] == Stack[SP-1]) ? FL_T : FL_F); - break; - case F_CONS: - argcount("cons", nargs, 2); - if (curheap > lim) - gc(0); - c = (cons_t*)curheap; - curheap += sizeof(cons_t); - c->car = Stack[SP-2]; - c->cdr = Stack[SP-1]; - v = tagptr(c, TAG_CONS); - break; - case F_LIST: - if (nargs) - v = list(&Stack[SP-nargs], nargs); - else - v = NIL; - break; - case F_CAR: - argcount("car", nargs, 1); - v = Stack[SP-1]; - if (!iscons(v)) goto notpair; - v = car_(v); - break; - case F_CDR: - argcount("cdr", nargs, 1); - v = Stack[SP-1]; - if (!iscons(v)) goto notpair; - v = cdr_(v); - break; - case F_SETCAR: - argcount("set-car!", nargs, 2); - car(v=Stack[SP-2]) = Stack[SP-1]; - break; - case F_SETCDR: - argcount("set-cdr!", nargs, 2); - cdr(v=Stack[SP-2]) = Stack[SP-1]; - break; - case F_VECTOR: - if (nargs > MAX_ARGS) { - i = llength(Stack[SP-1]); - nargs--; - } - else i = 0; - v = alloc_vector(nargs+i, 0); - memcpy(&vector_elt(v,0), &Stack[bp+2], nargs*sizeof(value_t)); - if (i > 0) { - e = Stack[SP-1]; - while (iscons(e)) { - vector_elt(v,nargs) = car_(e); - nargs++; - e = cdr_(e); - } - } - break; - case F_AREF: - argcount("aref", nargs, 2); - v = Stack[SP-2]; - if (isvector(v)) { - i = tofixnum(Stack[SP-1], "aref"); - if (__unlikely((unsigned)i >= vector_size(v))) - bounds_error("aref", v, Stack[SP-1]); - v = vector_elt(v, i); - } - else if (isarray(v)) { - v = cvalue_array_aref(&Stack[SP-2]); - } - else { - // TODO other sequence types? - type_error("aref", "sequence", v); - } - break; - case F_ASET: - argcount("aset!", nargs, 3); - e = Stack[SP-3]; - if (isvector(e)) { - i = tofixnum(Stack[SP-2], "aset!"); - if (__unlikely((unsigned)i >= vector_size(e))) - bounds_error("aset!", v, Stack[SP-1]); - vector_elt(e, i) = (v=Stack[SP-1]); - } - else if (isarray(e)) { - v = cvalue_array_aset(&Stack[SP-3]); - } - else { - type_error("aset!", "sequence", e); - } - break; - case F_ATOM: - argcount("atom?", nargs, 1); - v = (iscons(Stack[SP-1]) ? FL_F : FL_T); - break; - case F_CONSP: - argcount("pair?", nargs, 1); - v = (iscons(Stack[SP-1]) ? FL_T : FL_F); - break; - case F_SYMBOLP: - argcount("symbol?", nargs, 1); - v = ((issymbol(Stack[SP-1])) ? FL_T : FL_F); - break; - case F_NUMBERP: - argcount("number?", nargs, 1); - v = (isfixnum(Stack[SP-1]) || iscprim(Stack[SP-1]) ? FL_T : FL_F); - break; - case F_FIXNUMP: - argcount("fixnum?", nargs, 1); - v = (isfixnum(Stack[SP-1]) ? FL_T : FL_F); - break; - case F_BUILTINP: - argcount("builtin?", nargs, 1); - v = Stack[SP-1]; - v = ((isbuiltinish(v) && v!=FL_F && v!=FL_T && v!=NIL) - ? FL_T : FL_F); - break; - case F_VECTORP: - argcount("vector?", nargs, 1); - v = ((isvector(Stack[SP-1])) ? FL_T : FL_F); - break; - case F_NOT: - argcount("not", nargs, 1); - v = ((Stack[SP-1] == FL_F) ? FL_T : FL_F); - break; - case F_NULL: - argcount("null?", nargs, 1); - v = ((Stack[SP-1] == NIL) ? FL_T : FL_F); - break; - case F_BOOLEANP: - argcount("boolean?", nargs, 1); - v = Stack[SP-1]; - v = ((v == FL_T || v == FL_F) ? FL_T : FL_F); - break; - case F_ADD: - s = 0; - i = bp+2; - if (nargs > MAX_ARGS) goto add_ovf; - for (; i < (int)SP; i++) { - if (__likely(isfixnum(Stack[i]))) { - s += numval(Stack[i]); - if (__unlikely(!fits_fixnum(s))) { - i++; - goto add_ovf; - } - } - else { - add_ovf: - v = fl_add_any(&Stack[i], SP-i, s); - SP = saveSP; - return v; - } - } - v = fixnum(s); - break; - case F_SUB: - if (__unlikely(nargs < 1)) lerror(ArgError, "-: too few arguments"); - i = bp+2; - if (nargs == 1) { - if (__likely(isfixnum(Stack[i]))) - v = fixnum(-numval(Stack[i])); - else - v = fl_neg(Stack[i]); - break; - } - if (nargs == 2) { - if (__likely(bothfixnums(Stack[i], Stack[i+1]))) { - s = numval(Stack[i]) - numval(Stack[i+1]); - if (__likely(fits_fixnum(s))) { - v = fixnum(s); - break; - } - Stack[i+1] = fixnum(-numval(Stack[i+1])); - } - else { - Stack[i+1] = fl_neg(Stack[i+1]); - } - } - else { - // we need to pass the full arglist on to fl_add_any - // so it can handle rest args properly - PUSH(Stack[i]); - Stack[i] = fixnum(0); - Stack[i+1] = fl_neg(fl_add_any(&Stack[i], nargs, 0)); - Stack[i] = POP(); - } - v = fl_add_any(&Stack[i], 2, 0); - break; - case F_MUL: - accum = 1; - i = bp+2; - if (nargs > MAX_ARGS) goto mul_ovf; - for (; i < (int)SP; i++) { - if (__likely(isfixnum(Stack[i]))) { - accum *= numval(Stack[i]); - } - else { - mul_ovf: - v = fl_mul_any(&Stack[i], SP-i, accum); - SP = saveSP; - return v; - } - } - if (__likely(fits_fixnum(accum))) - v = fixnum(accum); - else - v = return_from_int64(accum); - break; - case F_DIV: - if (__unlikely(nargs < 1)) lerror(ArgError, "/: too few arguments"); - i = bp+2; - if (nargs == 1) { - v = fl_div2(fixnum(1), Stack[i]); - } - else { - if (nargs > 2) { - PUSH(Stack[i]); - Stack[i] = fixnum(1); - Stack[i+1] = fl_mul_any(&Stack[i], nargs, 1); - Stack[i] = POP(); - } - v = fl_div2(Stack[i], Stack[i+1]); - } - break; - case F_COMPARE: - argcount("compare", nargs, 2); - v = compare(Stack[SP-2], Stack[SP-1]); - break; - case F_NUMEQ: - argcount("=", nargs, 2); - v = Stack[SP-2]; e = Stack[SP-1]; - if (bothfixnums(v, e)) { - v = (v == e) ? FL_T : FL_F; - } - else { - v = (!numeric_compare(v,e,1,0,"=")) ? FL_T : FL_F; - } - break; - case F_LT: - argcount("<", nargs, 2); - if (bothfixnums(Stack[SP-2], Stack[SP-1])) { - v = (numval(Stack[SP-2]) < numval(Stack[SP-1])) ? FL_T : FL_F; - } - else { - v = (numval(compare(Stack[SP-2], Stack[SP-1])) < 0) ? - FL_T : FL_F; - } - break; - case F_EQUAL: - argcount("equal?", nargs, 2); - if (Stack[SP-2] == Stack[SP-1]) { - v = FL_T; - } - else if (eq_comparable(Stack[SP-2],Stack[SP-1])) { - v = FL_F; - } - else { - v = (numval(compare(Stack[SP-2], Stack[SP-1]))==0) ? - FL_T : FL_F; - } - break; - case F_EQV: - argcount("eqv?", nargs, 2); - if (Stack[SP-2] == Stack[SP-1]) { - v = FL_T; - } - else if (!leafp(Stack[SP-2]) || !leafp(Stack[SP-1])) { - v = FL_F; - } - else { - v = (numval(compare(Stack[SP-2], Stack[SP-1]))==0) ? - FL_T : FL_F; - } - break; - case F_EVAL: - argcount("eval", nargs, 1); - e = Stack[SP-1]; - if (selfevaluating(e)) { SP=saveSP; return e; } - envsz = 2; - if (tail) { - assert((ulong_t)(penv-Stack) (signed)bp+1); - if (isfunction(f)) { - i = SP; - e = apply_cl(nargs); - SP = i; - if (noeval == 2) { - if (selfevaluating(e)) { SP=saveSP; return(e); } - noeval = 0; - goto eval_top; - } - else { - SP = saveSP; - return e; - } - } - else if (__likely(iscons(f))) { - // apply lambda expression - f = Stack[bp+1] = cdr_(f); - if (!iscons(f)) goto notpair; - v = car_(f); // arglist - i = nargs; - while (iscons(v)) { - if (i == 0) - lerror(ArgError, "apply: too few arguments"); - i--; - v = cdr_(v); - } - if (v == NIL) { - if (i > 0) - lerror(ArgError, "apply: too many arguments"); - } - else { - v = NIL; - if (i > 0) { - v = list(&Stack[SP-i], i); - if (nargs > MAX_ARGS) { - c = (cons_t*)curheap; - (c-2)->cdr = (c-1)->car; - } - } - Stack[SP-i] = v; - SP -= (i-1); - } - f = cdr_(Stack[bp+1]); - if (!iscons(f)) goto notpair; - e = car_(f); - if (selfevaluating(e)) { SP=saveSP; return(e); } - PUSH(cdr_(f)); // add closed environment - assert(Stack[SP-1]==NIL || isvector(Stack[SP-1])); - Stack[bp+1] = car_(Stack[bp+1]); // put lambda list - - if (noeval == 2) { - // macro: evaluate body in lambda environment - e = eval_sexpr(e, &Stack[bp+1], 1, SP - bp - 1); - if (selfevaluating(e)) { SP=saveSP; return(e); } - noeval = 0; - // macro: evaluate expansion in calling environment - goto eval_top; - } - else { - envsz = SP - bp - 1; - if (tail) { - // ok to overwrite environment - for(i=0; i < (int)envsz; i++) - penv[i] = Stack[bp+1+i]; - SP = (penv-Stack)+envsz; - assert(penv[envsz-1]==NIL || isvector(penv[envsz-1])); - goto eval_top; - } - else { - penv = &Stack[bp+1]; - tail = 1; - goto eval_top; - } - } - // not reached - } - apply_type_error: - type_error("apply", "function", f); - notpair: - lerror(TypeError, "expected cons"); - return NIL; -} - /* stack on entry: caller's responsibility: @@ -1664,9 +854,6 @@ static value_t apply_cl(uint32_t nargs) v = apply_cl(i); } } - else if (iscons(func)) { - v = _applyn(i); - } else { type_error("apply", "function", func); } @@ -1789,10 +976,6 @@ static value_t apply_cl(uint32_t nargs) POPN(i); PUSH(v); break; - case OP_EVAL: - v = toplevel_eval(POP()); - PUSH(v); - break; case OP_TAPPLY: case OP_APPLY: @@ -1918,7 +1101,7 @@ static value_t apply_cl(uint32_t nargs) PUSH(v); } break; - case F_NUMEQ: + case OP_NUMEQ: v = Stack[SP-2]; e = Stack[SP-1]; if (bothfixnums(v, e)) { v = (v == e) ? FL_T : FL_F; @@ -1953,9 +1136,11 @@ static value_t apply_cl(uint32_t nargs) } else i = 0; v = alloc_vector(n+i, 0); - memcpy(&vector_elt(v,0), &Stack[SP-n], n*sizeof(value_t)); - e = POP(); - POPN(n-1); + if (n) { + memcpy(&vector_elt(v,0), &Stack[SP-n], n*sizeof(value_t)); + e = POP(); + POPN(n-1); + } if (n > MAX_ARGS) { i = n-1; while (iscons(e)) { @@ -2155,7 +1340,7 @@ static value_t apply_cl(uint32_t nargs) break; case OP_TRYCATCH: - v = do_trycatch2(); + v = do_trycatch(); POPN(1); Stack[SP-1] = v; break; @@ -2183,10 +1368,27 @@ static void print_function(value_t v, ios_t *f, int princ) (void)princ; function_t *fn = value2c(function_t*,v); outs("#function(", f); - int newindent = HPOS; - fl_print_child(f, fn->bcode, 0); outindent(newindent, f); - fl_print_child(f, fn->vals, 0); outindent(newindent, f); - fl_print_child(f, fn->env, 0); + char *data = cvalue_data(fn->bcode); + size_t sz = cvalue_len(fn->bcode); + outc('"', f); + size_t i; uint8_t c; + for(i=0; i < sz; i++) { + c = data[i]; + if (c == '\\') + outsn("\\\\", f, 2); + else if (c == '"') + outsn("\\\"", f, 2); + else if (c >= 32 && c < 0x7f) + outc(c, f); + else + ios_printf(f, "\\x%02x", c); + } + outsn("\" ", f, 2); + fl_print_child(f, fn->vals, 0); + if (fn->env != NIL) { + outc(' ', f); + fl_print_child(f, fn->env, 0); + } outc(')', f); } @@ -2300,34 +1502,27 @@ static void lisp_init(void) forsym = symbol("for"); labelsym = symbol("label"); setqsym = symbol("set!"); - elsesym = symbol("else"); + evalsym = symbol("eval"); tsym = symbol("t"); Tsym = symbol("T"); fsym = symbol("f"); Fsym = symbol("F"); set(printprettysym=symbol("*print-pretty*"), FL_T); set(printwidthsym=symbol("*print-width*"), fixnum(SCR_WIDTH)); lasterror = NIL; - special_apply_form = fl_cons(builtin(F_SPECIAL_APPLY), NIL); - apply1_args = fl_cons(NIL, NIL); i = 0; - while (isspecial(builtin(i))) { - if (i != F_SPECIAL_APPLY) - ((symbol_t*)ptr(symbol(builtin_names[i])))->syntax = builtin(i); - i++; - } - for (; i < F_TRUE; i++) { + for (i=F_EQ; i < F_TRUE; i++) { setc(symbol(builtin_names[i]), builtin(i)); } setc(symbol("eq"), builtin(F_EQ)); setc(symbol("equal"), builtin(F_EQUAL)); #ifdef LINUX - set(symbol("*os-name*"), symbol("linux")); + setc(symbol("*os-name*"), symbol("linux")); #elif defined(WIN32) || defined(WIN64) - set(symbol("*os-name*"), symbol("win32")); + setc(symbol("*os-name*"), symbol("win32")); #elif defined(MACOSX) - set(symbol("*os-name*"), symbol("macos")); + setc(symbol("*os-name*"), symbol("macos")); #else - set(symbol("*os-name*"), symbol("unknown")); + setc(symbol("*os-name*"), symbol("unknown")); #endif cvalues_init(); @@ -2343,6 +1538,9 @@ static void lisp_init(void) memory_exception_value = list2(MemoryError, cvalue_static_cstring("out of memory")); + the_empty_vector = tagptr(alloc_words(1), TAG_VECTOR); + vector_setsize(the_empty_vector, 0); + functiontype = define_opaque_type(FUNCTION, sizeof(function_t), &function_vtable, NULL); @@ -2357,9 +1555,9 @@ value_t toplevel_eval(value_t expr) { value_t v; uint32_t saveSP = SP; - PUSH(NIL); - PUSH(NIL); - v = topeval(expr, &Stack[SP-2]); + PUSH(symbol_value(evalsym)); + PUSH(expr); + v = apply_cl(1); SP = saveSP; return v; } @@ -2383,6 +1581,8 @@ extern value_t fl_file(value_t *args, uint32_t nargs); int main(int argc, char *argv[]) { value_t e, v; + int saveSP; + symbol_t *sym; char fname_buf[1024]; locale_is_utf8 = u8_is_locale_utf8(setlocale(LC_ALL, "")); @@ -2394,7 +1594,7 @@ int main(int argc, char *argv[]) strcat(fname_buf, EXEDIR); strcat(fname_buf, PATHSEPSTRING); } - strcat(fname_buf, "system.lsp"); + strcat(fname_buf, "flisp.boot"); FL_TRY { // install toplevel exception handler @@ -2402,11 +1602,22 @@ int main(int argc, char *argv[]) PUSH(symbol(":read")); value_t f = fl_file(&Stack[SP-2], 2); POPN(2); - PUSH(f); + PUSH(f); saveSP = SP; while (1) { e = read_sexpr(Stack[SP-1]); if (ios_eof(value2c(ios_t*,Stack[SP-1]))) break; - v = toplevel_eval(e); + if (isfunction(e)) { + // stage 0 format: series of thunks + PUSH(e); + (void)_applyn(0); + SP = saveSP; + } + else { + // stage 1 format: symbol/value pairs + sym = tosymbol(e, "bootstrap"); + v = read_sexpr(Stack[SP-1]); + sym->binding = v; + } } ios_close(value2c(ios_t*,Stack[SP-1])); POPN(1); diff --git a/femtolisp/flisp.h b/femtolisp/flisp.h index 14a8375..dcd176d 100644 --- a/femtolisp/flisp.h +++ b/femtolisp/flisp.h @@ -117,23 +117,18 @@ extern uint32_t SP; (arg = args[i])) || 1)); i++) enum { - // special forms - F_QUOTE=0, F_COND, F_IF, F_AND, F_OR, F_WHILE, F_LAMBDA, - F_TRYCATCH, F_SPECIAL_APPLY, F_SETQ, F_PROG1, F_FOR, F_BEGIN, - // functions - F_EQ, F_EQV, F_EQUAL, F_ATOM, F_NOT, F_NULL, F_BOOLEANP, F_SYMBOLP, + F_EQ=13, F_EQV, F_EQUAL, F_ATOM, F_NOT, F_NULL, F_BOOLEANP, F_SYMBOLP, F_NUMBERP, F_BOUNDP, F_CONSP, F_BUILTINP, F_VECTORP, F_FIXNUMP, F_CONS, F_LIST, F_CAR, F_CDR, F_SETCAR, F_SETCDR, - F_EVAL, F_APPLY, + F_APPLY, F_ADD, F_SUB, F_MUL, F_DIV, F_NUMEQ, F_LT, F_COMPARE, F_VECTOR, F_AREF, F_ASET, F_TRUE, F_FALSE, F_NIL, N_BUILTINS }; -#define isspecial(v) (uintval(v) <= (unsigned int)F_BEGIN) extern value_t NIL, FL_T, FL_F; @@ -247,6 +242,7 @@ typedef struct { #define cv_isPOD(cv) (cv_class(cv)->init != NULL) #define cvalue_data(v) cv_data((cvalue_t*)ptr(v)) +#define cvalue_len(v) cv_len((cvalue_t*)ptr(v)) #define value2c(type, v) ((type)cv_data((cvalue_t*)ptr(v))) #define valid_numtype(v) ((v) < N_NUMTYPES) diff --git a/femtolisp/opcodes.h b/femtolisp/opcodes.h index 51eafcf..32439a8 100644 --- a/femtolisp/opcodes.h +++ b/femtolisp/opcodes.h @@ -10,7 +10,7 @@ enum { OP_FIXNUMP, OP_CONS, OP_LIST, OP_CAR, OP_CDR, OP_SETCAR, OP_SETCDR, - OP_EVAL, OP_APPLY, + OP_APPLY, OP_ADD, OP_SUB, OP_MUL, OP_DIV, OP_NUMEQ, OP_LT, OP_COMPARE, diff --git a/femtolisp/print.c b/femtolisp/print.c index 3425958..e383064 100644 --- a/femtolisp/print.c +++ b/femtolisp/print.c @@ -72,7 +72,8 @@ void print_traverse(value_t v) return; } if (isvector(v)) { - mark_cons(v); + if (vector_size(v) > 0) + mark_cons(v); unsigned int i; for(i=0; i < vector_size(v); i++) print_traverse(vector_elt(v,i)); @@ -225,8 +226,7 @@ static int indentevery(value_t v) value_t c = car_(v); if (c == LAMBDA || c == labelsym || c == setqsym) return 0; - value_t f; - if (issymbol(c) && (f=((symbol_t*)ptr(c))->syntax) && isspecial(f)) + if (c == IF) // TODO: others return !allsmallp(cdr_(v)); return 0; } diff --git a/femtolisp/read.c b/femtolisp/read.c index aeb224d..3963990 100644 --- a/femtolisp/read.c +++ b/femtolisp/read.c @@ -346,7 +346,7 @@ static u_int32_t peek() static value_t read_vector(value_t label, u_int32_t closer) { - value_t v=alloc_vector(4, 1), elt; + value_t v=the_empty_vector, elt; u_int32_t i=0; PUSH(v); if (label != UNBOUND) @@ -354,7 +354,12 @@ static value_t read_vector(value_t label, u_int32_t closer) while (peek() != closer) { if (ios_eof(F)) lerror(ParseError, "read: unexpected end of input"); - if (i >= vector_size(v)) + if (i == 0) { + v = Stack[SP-1] = alloc_vector(4, 1); + if (label != UNBOUND) + ptrhash_put(&readstate->backrefs, (void*)label, (void*)v); + } + else if (i >= vector_size(v)) Stack[SP-1] = vector_grow(v); elt = do_read_sexpr(UNBOUND); v = Stack[SP-1]; @@ -362,7 +367,8 @@ static value_t read_vector(value_t label, u_int32_t closer) i++; } take(); - vector_setsize(v, i); + if (i > 0) + vector_setsize(v, i); return POP(); } diff --git a/femtolisp/system.lsp b/femtolisp/system.lsp index bf3e5de..205ceaf 100644 --- a/femtolisp/system.lsp +++ b/femtolisp/system.lsp @@ -11,6 +11,11 @@ ((eq (cdr e) ()) (car e)) (#t (cons 'begin e))))) +(set! *syntax-environment* (table)) + +(set! set-syntax! + (lambda (s v) (put! *syntax-environment* s v))) + (set-syntax! 'define-macro (lambda (form . body) (list 'set-syntax! (list 'quote (car form)) @@ -21,6 +26,8 @@ (list 'set! form (car body)) (list 'set! (car form) (list 'lambda (cdr form) (f-body body))))) +(define (symbol-syntax s) (get *syntax-environment* s #f)) + (define (map f lst) (if (atom? lst) lst (cons (f (car lst)) (map f (cdr lst))))) @@ -417,7 +424,6 @@ first))) (define (iota n) (map-int identity n)) -(define ι iota) (define (for-each f l) (if (pair? l) @@ -482,16 +488,6 @@ ; text I/O -------------------------------------------------------------------- -(if (or (eq? *os-name* 'win32) - (eq? *os-name* 'win64) - (eq? *os-name* 'windows)) - (begin (define *directory-separator* "\\") - (define *linefeed* "\r\n")) - (begin (define *directory-separator* "/") - (define *linefeed* "\n"))) - -(define *output-stream* *stdout*) -(define *input-stream* *stdin*) (define (print . args) (apply io.print (cons *output-stream* args))) (define (princ . args) (apply io.princ (cons *output-stream* args))) @@ -512,8 +508,6 @@ (set! l (cons (aref v (- n i)) l)))) l)) -(define (vu8 . elts) (apply array (cons 'uint8 elts))) - (define (vector.map f v) (let* ((n (length v)) (nv (vector.alloc n))) @@ -610,7 +604,7 @@ ; toplevel -------------------------------------------------------------------- (define (macrocall? e) (and (symbol? (car e)) - (symbol-syntax (car e)))) + (get *syntax-environment* (car e) #f))) (define (macroexpand-1 e) (if (atom? e) e @@ -650,8 +644,9 @@ (define (expand x) (macroexpand x)) -(if (not (bound? 'load-process)) - (define (load-process x) (eval (expand x)))) +(define (eval x) ((compile-thunk (expand x)))) + +(define (load-process x) (eval x)) (define (load filename) (let ((F (file filename :read))) @@ -669,9 +664,6 @@ (io.close F) (raise `(load-error ,filename ,e))))))) -(load (string *install-dir* *directory-separator* "compiler.lsp")) -(define (load-process x) ((compile-thunk (expand x)))) - (define *banner* (string.tail " ; _ ; |_ _ _ |_ _ | . _ _ @@ -738,14 +730,38 @@ (io.princ *stderr* *linefeed*) #t) +(define (make-system-image fname) + (let ((f (file fname :write :create :truncate))) + (for-each (lambda (s) + (if (and (bound? s) + (not (constant? s)) + (not (builtin? (top-level-value s))) + (not (iostream? (top-level-value s)))) + (begin + (io.print f s) (io.write f "\n") + (io.print f (top-level-value s)) (io.write f "\n")))) + (environment)) + (io.close f))) + +; initialize globals that need to be set at load time +(define (__init_globals) + (if (or (eq? *os-name* 'win32) + (eq? *os-name* 'win64) + (eq? *os-name* 'windows)) + (begin (set! *directory-separator* "\\") + (set! *linefeed* "\r\n")) + (begin (set! *directory-separator* "/") + (set! *linefeed* "\n"))) + (set! *output-stream* *stdout*) + (set! *input-stream* *stdin*)) + (define (__script fname) (trycatch (load fname) (lambda (e) (begin (print-exception e) (exit 1))))) (define (__start argv) - ; reload this file with our new definition of load - (load (string *install-dir* *directory-separator* "system.lsp")) + (__init_globals) (if (pair? (cdr argv)) (begin (set! *argv* (cdr argv)) (__script (cadr argv))) diff --git a/femtolisp/table.c b/femtolisp/table.c index b366ad8..e28e90d 100644 --- a/femtolisp/table.c +++ b/femtolisp/table.c @@ -85,7 +85,7 @@ value_t fl_table(value_t *args, uint32_t nargs) { size_t cnt = (size_t)nargs; if (nargs > MAX_ARGS) - cnt += llength(args[MAX_ARGS]); + cnt += (llength(args[MAX_ARGS])-1); if (cnt & 1) lerror(ArgError, "table: arguments must come in pairs"); value_t nt;