ref: 25812731cc2b3aa707b4c50d7e094f03490ded1c
parent: 5ab7a7c1e10e681ec792ffb7467f7250f374e88c
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Mon Apr 20 20:56:05 EDT 2009
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
--- a/femtolisp/builtins.c
+++ b/femtolisp/builtins.c
@@ -147,46 +147,10 @@
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 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 },--- 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)))))))
--- a/femtolisp/cvalues.c
+++ b/femtolisp/cvalues.c
@@ -465,7 +465,7 @@
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;
--- /dev/null
+++ b/femtolisp/flisp.boot
@@ -1,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<B\x025\x00\x0b" [#function(">\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<B\x025\x01\x0b" [#function(">\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])+#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<B\x025\x00\x0b" [#function(">\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<B\x0b" [1- length #function(">\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<B\x024\x034\x046\x00\x00\x03\x012\x054\x064\x075\x00\x03\x010\x03\x022\x08\x03\x04\x026\x00\x000\"\x02:\x00\x00\x022\x095\x00@\x04\x02\x0b" [>+ 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"
--- 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 @@
"cons", "list", "car", "cdr", "set-car!", "set-cdr!",
// execution
- "eval", "apply",
+ "apply",
// arithmetic
"+", "-", "*", "/", "=", "<", "compare",
@@ -80,7 +78,7 @@
{ 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,15 +87,6 @@
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;
@@ -104,10 +93,9 @@
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 @@
#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 @@
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 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 *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 @@
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 @@
// 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 @@
PUSH(f);
while (iscons(v)) {- if (n == MAX_ARGS) {+ if ((SP-n-1) == MAX_ARGS) {PUSH(v);
break;
}
@@ -575,6 +570,7 @@
v = cdr_(v);
}
n = SP - n - 1;
+ assert(n <= MAX_ARGS+1);
v = _applyn(n);
POPN(n+1);
return v;
@@ -700,95 +696,8 @@
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)
+static value_t do_trycatch()
{- 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()
-{uint32_t saveSP = SP;
value_t v;
value_t thunk = Stack[SP-2];
@@ -806,725 +715,6 @@
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)<N_STACK);
- penv[0] = NIL;
- penv[1] = NIL;
- SP = (penv-Stack) + 2;
- }
- else {- PUSH(NIL);
- PUSH(NIL);
- tail = 1;
- penv = &Stack[SP-2];
- }
- goto eval_top;
- case F_SPECIAL_APPLY:
- POPN(2);
- v = POP();
- saveSP = SP;
- nargs = numval(v);
- bp = SP-nargs-2;
- f = Stack[bp+1];
- penv = &Stack[bp+1];
- goto do_apply;
- case F_APPLY:
- argcount("apply", nargs, 2);- v = Stack[SP-1]; // second arg is new arglist
- f = Stack[bp+1] = Stack[SP-2]; // first arg is new function
- POPN(2); // pop apply's args
- move_args:
- while (iscons(v)) {- if (SP-bp-2 == MAX_ARGS) {- PUSH(v);
- break;
- }
- PUSH(car_(v));
- v = cdr_(v);
- }
- goto do_apply;
- case F_TRUE:
- case F_FALSE:
- case F_NIL:
- goto apply_type_error;
- default:
- // function pointer tagged as a builtin
- v = ((builtin_t)ptr(f))(&Stack[bp+2], nargs);
- }
- SP = saveSP;
- return v;
- }
- f = Stack[bp+1];
- assert((signed)SP > (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: <func> <args...>
caller's responsibility:
@@ -1664,9 +854,6 @@
v = apply_cl(i);
}
}
- else if (iscons(func)) {- v = _applyn(i);
- }
else { type_error("apply", "function", func);}
@@ -1789,10 +976,6 @@
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 @@
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 @@
}
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 @@
break;
case OP_TRYCATCH:
- v = do_trycatch2();
+ v = do_trycatch();
POPN(1);
Stack[SP-1] = v;
break;
@@ -2183,10 +1368,27 @@
(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,21 +1502,14 @@
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));@@ -2321,13 +1516,13 @@
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 @@
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 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 @@
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 @@
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 @@
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);
--- a/femtolisp/flisp.h
+++ b/femtolisp/flisp.h
@@ -117,16 +117,12 @@
(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,
@@ -133,7 +129,6 @@
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 @@
#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)
--- a/femtolisp/opcodes.h
+++ b/femtolisp/opcodes.h
@@ -10,7 +10,7 @@
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,
--- a/femtolisp/print.c
+++ b/femtolisp/print.c
@@ -72,7 +72,8 @@
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 @@
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;
}
--- a/femtolisp/read.c
+++ b/femtolisp/read.c
@@ -346,7 +346,7 @@
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 @@
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 @@
i++;
}
take();
- vector_setsize(v, i);
+ if (i > 0)
+ vector_setsize(v, i);
return POP();
}
--- 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,9 +644,10 @@
(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)))
(trycatch
@@ -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,6 +730,31 @@
(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)
@@ -744,8 +761,7 @@
(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)))
--- a/femtolisp/table.c
+++ b/femtolisp/table.c
@@ -85,7 +85,7 @@
{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;