ref: 929ec92a653b36aea0aaf454084eb49f049b7462
parent: 51f645a916842c2ea52d52c70a6e554eb32f631f
author: JeffBezanson <[email protected]>
date: Sun Aug 9 14:04:03 EDT 2009
adding support for eof-object renaming exported symbol NIL to FL_NIL making default vector fill #f some misc. cleanup
--- a/femtolisp/aliases.scm
+++ b/femtolisp/aliases.scm
@@ -39,6 +39,7 @@
(define (exact? x) (integer? x))
(define (inexact? x) (not (exact? x)))
(define quotient div0)
+(define remainder mod0)
(define (inexact x) x)
(define (exact x)
(if (exact? x) x
@@ -90,6 +91,7 @@
(define close-output-port io.close)
(define (read-char (s *input-stream*)) (io.getc s))
(define (write-char c (s *output-stream*)) (io.putc s c))
+(define (port-eof? p) (io.eof? p))
(define (open-input-string str)
(let ((b (buffer)))
(io.write b str)
--- a/femtolisp/builtins.c
+++ b/femtolisp/builtins.c
@@ -29,8 +29,8 @@
static value_t fl_nconc(value_t *args, u_int32_t nargs)
{if (nargs == 0)
- return NIL;
- value_t lst, first=NIL;
+ return FL_NIL;
+ value_t lst, first=FL_NIL;
value_t *pcdr = &first;
cons_t *c;
uint32_t i=0;
@@ -44,7 +44,7 @@
c = (cons_t*)ptr(c->cdr);
pcdr = &c->cdr;
}
- else if (lst != NIL) {+ else if (lst != FL_NIL) { type_error("nconc", "cons", lst);}
}
@@ -100,7 +100,7 @@
if (cv_class(cv)->eltype != NULL)
return size_wrap(cvalue_arraylen(a));
}
- else if (a == NIL) {+ else if (a == FL_NIL) {return fixnum(0);
}
else if (iscons(a)) {@@ -120,7 +120,7 @@
if (nargs > 0)
exit(tofixnum(args[0], "exit"));
exit(0);
- return NIL;
+ return FL_NIL;
}
static value_t fl_symbol(value_t *args, u_int32_t nargs)
@@ -173,7 +173,7 @@
{(void)args;
argcount("environment", nargs, 0);- value_t lst = NIL;
+ value_t lst = FL_NIL;
fl_gc_handle(&lst);
global_env_list(symtab, &lst);
fl_free_gc_handles(1);
@@ -286,9 +286,9 @@
if (nargs == 2)
f = args[1];
else
- f = NIL;
- v = alloc_vector((unsigned)i, f==NIL);
- if (f != NIL) {+ f = FL_F;
+ v = alloc_vector((unsigned)i, f==FL_F);
+ if (f != FL_F) {int k;
for(k=0; k < i; k++)
vector_elt(v,k) = f;
--- a/femtolisp/color.lsp
+++ b/femtolisp/color.lsp
@@ -84,6 +84,6 @@
(let ((result ()))
(dotimes (x 25)
(dotimes (y 25)
- (if (and (/= x y) (can-attack x y))
+ (if (and (not (= x y)) (can-attack x y))
(set! result (cons (cons x y) result)) ())))
result))
--- a/femtolisp/cvalues.c
+++ b/femtolisp/cvalues.c
@@ -638,6 +638,8 @@
return booleansym;
if (args[0] == NIL)
return nullsym;
+ if (args[0] == FL_EOF)
+ return symbol("eof-object");if (isbuiltin(args[0]))
return builtinsym;
return FUNCTION;
--- a/femtolisp/flisp.boot
+++ b/femtolisp/flisp.boot
@@ -1,1 +1,1 @@
-(*banner* "; _\n; |_ _ _ |_ _ | . _ _\n; | (-||||_(_)|__|_)|_)\n;-------------------|----------------------------------------------------------\n\n" *syntax-environment* #table(with-bindings #fn(">000s1c0qe1c2|32e1e3|32e1c4|3243;" [#fn("B000r3e0c1L1e2c3g2|33L1e4e2c5|}3331c6e0c7L1e4\x7f3132e0c7L1e4e2c8|g2333132L3L144;" [nconc let map #.list copy-list #fn("8000r2c0|}L3;" [set!]) unwind-protect begin #fn("8000r2c0|}L3;" [set!])]) map #.car cadr #fn("6000r1e040;" [gensym])]) letrec #fn("?000s1e0e0c1L1e2c3|32L1e2c4|32e5}3134L1e2c6|3242;" [nconc lambda map #.car #fn("9000r1e0c1L1e2|3142;" [nconc set! copy-list]) copy-list #fn("6000r1^;" [])]) backquote #fn("7000r1e0|41;" [bq-process]) assert #fn("<000r1c0|]c1c2c3|L2L2L2L4;" [if raise quote assert-failed]) label #fn(":000r2c0|L1c1|}L3L3^L2;" [lambda set!]) do #fn("A000s2c0qe130}Me2c3|32e2e4|32e2c5|3245;" [#fn("B000r5c0|c1g2c2}e3c4L1e5\x7fN3132e3c4L1e5i0231e3|L1g432L133L4L3L2L1e3|L1g332L3;" [letrec lambda if nconc begin copy-list]) gensym map #.car cadr #fn("7000r1e0|31F680e1|41;|M;" [cddr caddr])]) when #fn("<000s1c0|c1}K^L4;" [if begin]) dotimes #fn(";000s1c0q|M|\x8442;" [#fn("=000r2c0`c1}aL3e2c3L1|L1L1e4\x7f3133L4;" [for - nconc lambda copy-list])]) unwind-protect #fn("8000r2c0qe130e13042;" [#fn("@000r2c0}c1_\x7fL3L2L1c2c3~c1|L1c4}L1c5|L2L3L3L3}L1L3L3;" [let lambda prog1 trycatch begin raise]) gensym]) define-macro #fn("?000s1c0c1|ML2e2c3L1|NL1e4}3133L3;" [set-syntax! quote nconc lambda copy-list]) receive #fn("@000s2c0c1_}L3e2c1L1|L1e3g23133L3;" [call-with-values lambda nconc copy-list]) unless #fn("=000s1c0|^c1}KL4;" [if begin]) let #fn(":000s1c0q^41;" [#fn("<000r1~C6D0~m02\x7fMo002\x7fNo01530^2c0qe1c2L1e3c4~32L1e5\x7f3133e3c6~3242;" [#fn("8000r2~6;0c0~|L3530|}K;" [label]) nconc lambda map #fn("6000r1|F650|M;|;" []) copy-list #fn("6000r1|F650|\x84;^;" [])])]) cond #fn("9000s0c0q^41;" [#fn("7000r1c0qm02|~41;" [#fn("7000r1|?640^;c0q|M41;" [#fn(";000r1|Mc0<17702|M]<6@0|N\x8550|M;c1|NK;|N\x85@0c2|Mi10~N31L3;c3|Mc1|NKi10~N31L4;" [else begin or if])] cond-clauses->if)])]) throw #fn(":000r2c0c1c2c3L2|}L4L2;" [raise list quote thrown-value]) time #fn("7000r1c0qe13041;" [#fn(">000r1c0|c1L1L2L1c2~c3c4c5c1L1|L3c6L4L3L3;" [let time.now prog1 princ "Elapsed time: " - " seconds\n"]) gensym]) let* #fn("A000s1|?6E0e0c1L1_L1e2}3133L1;e0c1L1e3|31L1L1e2|NF6H0e0c4L1|NL1e2}3133L1530}3133e5|31L2;" [nconc lambda copy-list caar let* cadar]) case #fn(":000s1c0q^41;" [#fn("7000r1c0m02c1qe23041;" [#fn(";000r2}c0\x8250c0;}\x8540^;}C6=0c1|e2}31L3;}?6=0c3|e2}31L3;}N\x85>0c3|e2}M31L3;e4c5}326=0c6|c7}L2L3;c8|c7}L2L3;" [else eq? quote-value eqv? every #.symbol? memq quote memv] vals->cond) #fn("<000r1c0|i10L2L1e1c2L1e3c4qi113232L3;" [let nconc cond map #fn("8000r1i10~|M32|NK;" [])]) gensym])]) with-output-to #fn("=000s1e0c1L1c2|L2L1L1e3}3143;" [nconc with-bindings *output-stream* copy-list]) catch #fn("7000r2c0qe13041;" [#fn("@000r1c0\x7fc1|L1c2c3c4|L2c5c6|L2c7c8L2L3c5c9|L2~L3L4c:|L2c;|L2L4L3L3;" [trycatch lambda if and pair? eq car quote thrown-value cadr caddr raise]) gensym])) *whitespace* "\t\n\v\f\r \u0085 \u2028\u2029 " /= #fn("7000r2|}W@;" [] /=) 1+ #fn("7000r1|aw;" [] 1+) 1- #fn("7000r1|ax;" [] 1-) 1arg-lambda? #fn("8000r1|F16T02|Mc0<16J02|NF16B02|\x84F16:02e1|\x84a42;" [lambda length=] 1arg-lambda?) <= #fn("7000r2|}X17602|}W;" [] <=) > #fn("7000r2}|X;" [] >) >= #fn("7000r2}|X17602|}W;" [] >=) Instructions #table(not 16 vargc 67 load1 49 = 39 setc.l 64 sub2 72 brne.l 83 largc 74 brnn 85 loadc.l 58 loadi8 50 < 40 nop 0 set-cdr! 32 loada 55 bound? 21 / 37 neg 73 brn.l 88 lvargc 75 brt 7 trycatch 68 null? 17 load0 48 jmp.l 8 loadv 51 seta 61 keyargs 91 * 36 function? 26 builtin? 23 aref 43 optargs 89 vector? 24 loadt 45 brf 6 symbol? 19 cdr 30 for 69 loadc00 78 pop 2 pair? 22 cadr 84 closure 65 loadf 46 compare 41 loadv.l 52 setg.l 60 brn 87 eqv? 13 aset! 44 eq? 12 atom? 15 boolean? 18 brt.l 10 tapply 70 dummy_nil 94 loada0 76 brbound 90 list 28 dup 1 apply 33 loadc 57 l\ No newline at end of file
+(*banner* "; _\n; |_ _ _ |_ _ | . _ _\n; | (-||||_(_)|__|_)|_)\n;-------------------|----------------------------------------------------------\n\n" *interactive* #f *syntax-environment* #table(with-bindings #fn(">000s1c0qe1c2|32e1e3|32e1c4|3243;" [#fn("B000r3e0c1L1e2c3g2|33L1e4e2c5|}3331c6e0c7L1e4\x7f3132e0c7L1e4e2c8|g2333132L3L144;" [nconc let map #.list copy-list #fn("8000r2c0|}L3;" [set!]) unwind-protect begin #fn("8000r2c0|}L3;" [set!])]) map #.car cadr #fn("6000r1e040;" [gensym])]) letrec #fn("?000s1e0e0c1L1e2c3|32L1e2c4|32e5}3134L1e2c6|3242;" [nconc lambda map #.car #fn("9000r1e0c1L1e2|3142;" [nconc set! copy-list]) copy-list #fn("6000r1^;" [])]) backquote #fn("7000r1e0|41;" [bq-process]) assert #fn("<000r1c0|]c1c2c3|L2L2L2L4;" [if raise quote assert-failed]) label #fn(":000r2c0|L1c1|}L3L3^L2;" [lambda set!]) do #fn("A000s2c0qe130}Me2c3|32e2e4|32e2c5|3245;" [#fn("B000r5c0|c1g2c2}e3c4L1e5\x7fN3132e3c4L1e5i0231e3|L1g432L133L4L3L2L1e3|L1g332L3;" [letrec lambda if nconc begin copy-list]) gensym map #.car cadr #fn("7000r1e0|31F680e1|41;|M;" [cddr caddr])]) when #fn("<000s1c0|c1}K^L4;" [if begin]) dotimes #fn(";000s1c0q|M|\x8442;" [#fn("=000r2c0`c1}aL3e2c3L1|L1L1e4\x7f3133L4;" [for - nconc lambda copy-list])]) unwind-protect #fn("8000r2c0qe130e13042;" [#fn("@000r2c0}c1_\x7fL3L2L1c2c3~c1|L1c4}L1c5|L2L3L3L3}L1L3L3;" [let lambda prog1 trycatch begin raise]) gensym]) define-macro #fn("?000s1c0c1|ML2e2c3L1|NL1e4}3133L3;" [set-syntax! quote nconc lambda copy-list]) receive #fn("@000s2c0c1_}L3e2c1L1|L1e3g23133L3;" [call-with-values lambda nconc copy-list]) unless #fn("=000s1c0|^c1}KL4;" [if begin]) let #fn(":000s1c0q^41;" [#fn("<000r1~C6D0~m02\x7fMo002\x7fNo01530^2c0qe1c2L1e3c4~32L1e5\x7f3133e3c6~3242;" [#fn("8000r2~6;0c0~|L3530|}K;" [label]) nconc lambda map #fn("6000r1|F650|M;|;" []) copy-list #fn("6000r1|F650|\x84;^;" [])])]) cond #fn("9000s0c0q^41;" [#fn("7000r1c0qm02|~41;" [#fn("7000r1|?640^;c0q|M41;" [#fn(";000r1|Mc0<17702|M]<6@0|N\x8550|M;c1|NK;|N\x85@0c2|Mi10~N31L3;c3|Mc1|NKi10~N31L4;" [else begin or if])] cond-clauses->if)])]) throw #fn(":000r2c0c1c2c3L2|}L4L2;" [raise list quote thrown-value]) time #fn("7000r1c0qe13041;" [#fn(">000r1c0|c1L1L2L1c2~c3c4c5c1L1|L3c6L4L3L3;" [let time.now prog1 princ "Elapsed time: " - " seconds\n"]) gensym]) let* #fn("A000s1|?6E0e0c1L1_L1e2}3133L1;e0c1L1e3|31L1L1e2|NF6H0e0c4L1|NL1e2}3133L1530}3133e5|31L2;" [nconc lambda copy-list caar let* cadar]) case #fn(":000s1c0q^41;" [#fn("7000r1c0m02c1qe23041;" [#fn(";000r2}c0\x8250c0;}\x8540^;}C6=0c1|e2}31L3;}?6=0c3|e2}31L3;}N\x85>0c3|e2}M31L3;e4c5}326=0c6|c7}L2L3;c8|c7}L2L3;" [else eq? quote-value eqv? every #.symbol? memq quote memv] vals->cond) #fn("<000r1c0|i10L2L1e1c2L1e3c4qi113232L3;" [let nconc cond map #fn("8000r1i10~|M32|NK;" [])]) gensym])]) with-output-to #fn("=000s1e0c1L1c2|L2L1L1e3}3143;" [nconc with-bindings *output-stream* copy-list]) catch #fn("7000r2c0qe13041;" [#fn("@000r1c0\x7fc1|L1c2c3c4|L2c5c6|L2c7c8L2L3c5c9|L2~L3L4c:|L2c;|L2L4L3L3;" [trycatch lambda if and pair? eq car quote thrown-value cadr caddr raise]) gensym])) *whitespace* "\t\n\v\f\r \u0085 \u2028\u2029 " 1+ #fn("7000r1|aw;" [] 1+) 1- #fn("7000r1|ax;" [] 1-) 1arg-lambda? #fn("8000r1|F16T02|Mc0<16J02|NF16B02|\x84F16:02e1|\x84a42;" [lambda length=] 1arg-lambda?) <= #fn("7000r2|}X17602|}W;" [] <=) > #fn("7000r2}|X;" [] >) >= #fn("7000r2}|X17602|}W;" [] >=) Instructions #table(not 16 vargc 67 load1 49 = 39 setc.l 64 sub2 72 brne.l 83 largc 74 brnn 85 loadc.l 58 loadi8 50 < 40 nop 0 set-cdr! 32 loada 55 bound? 21 / 37 neg 73 brn.l 88 lvargc 75 brt 7 trycatch 68 null? 17 load0 48 jmp.l 8 loadv 51 seta 61 keyargs 91 * 36 function? 26 builtin? 23 aref 43 optargs 89 vector? 24 loadt 45 brf 6 symbol? 19 cdr 30 for 69 loadc00 78 pop 2 pair? 22 cadr 84 closure 65 loadf 46 compare 41 loadv.l 52 setg.l 60 brn 87 eqv? 13 aset! 44 eq? 12 atom? 15 boolean? 18 brt.l 10 tapply 70 dummy_nil 94 loada0 76 brbound 90 list 28 dup 1 apply 33 loadc 57 loadc01 79 \ No newline at end of file
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -89,13 +89,12 @@
static value_t *GCHandleStack[N_GC_HANDLES];
static uint32_t N_GCHND = 0;
-value_t NIL, FL_T, FL_F;
+value_t FL_NIL, FL_T, FL_F, FL_EOF, QUOTE;
value_t IOError, ParseError, TypeError, ArgError, UnboundError, MemoryError;
value_t DivideError, BoundsError, Error, KeyError, EnumerationError;
value_t printwidthsym, printreadablysym, printprettysym;
-value_t QUOTE;
-static value_t LAMBDA, IF, TRYCATCH;
+static value_t NIL, LAMBDA, IF, TRYCATCH;
static value_t BACKQUOTE, COMMA, COMMAAT, COMMADOT, FUNCTION;
static value_t pairsym, symbolsym, fixnumsym, vectorsym, builtinsym, vu8sym;
@@ -378,7 +377,7 @@
if (init) {unsigned int i;
for(i=0; i < n; i++)
- vector_elt(v, i) = NIL;
+ vector_elt(v, i) = FL_F;
}
return v;
}
@@ -1242,7 +1241,8 @@
NEXT_OP;
OP(OP_FUNCTIONP)
v = Stack[SP-1];
- Stack[SP-1] = ((tag(v)==TAG_FUNCTION &&v!=FL_F&&v!=FL_T&&v!=NIL) ||
+ Stack[SP-1] = ((tag(v)==TAG_FUNCTION &&
+ (uintval(v)<=OP_ASET || v>(N_BUILTINS<<3))) ||
iscbuiltin(v)) ? FL_T : FL_F;
NEXT_OP;
OP(OP_VECTORP)
@@ -2100,9 +2100,10 @@
N_STACK = 262144;
Stack = malloc(N_STACK*sizeof(value_t));
- NIL = builtin(OP_THE_EMPTY_LIST);
+ FL_NIL = NIL = builtin(OP_THE_EMPTY_LIST);
FL_T = builtin(OP_BOOL_CONST_T);
FL_F = builtin(OP_BOOL_CONST_F);
+ FL_EOF = builtin(OP_EOF_OBJECT);
LAMBDA = symbol("lambda"); FUNCTION = symbol("function"); QUOTE = symbol("quote"); TRYCATCH = symbol("trycatch"); BACKQUOTE = symbol("backquote"); COMMA = symbol("*comma*");--- a/femtolisp/flisp.h
+++ b/femtolisp/flisp.h
@@ -56,7 +56,7 @@
#define issymbol(x) (tag(x) == TAG_SYM)
#define isfixnum(x) (((x)&3) == TAG_NUM)
#define bothfixnums(x,y) ((((x)|(y))&3) == TAG_NUM)
-#define isbuiltin(x) ((tag(x) == TAG_FUNCTION) && (x) < (OP_BOOL_CONST_T<<3))
+#define isbuiltin(x) ((tag(x) == TAG_FUNCTION) && uintval(x) <= OP_ASET)
#define isvector(x) (tag(x) == TAG_VECTOR)
#define iscvalue(x) (tag(x) == TAG_CVALUE)
#define iscprim(x) (tag(x) == TAG_CPRIM)
@@ -113,7 +113,7 @@
#define N_BUILTINS ((int)N_OPCODES)
-extern value_t NIL, FL_T, FL_F;
+extern value_t FL_NIL, FL_T, FL_F, FL_EOF;
/* read, eval, print main entry points */
value_t read_sexpr(value_t f);
--- a/femtolisp/iostream.c
+++ b/femtolisp/iostream.c
@@ -49,6 +49,19 @@
return isiostream(args[0]) ? FL_T : FL_F;
}
+value_t fl_eof_object(value_t *args, uint32_t nargs)
+{+ (void)args;
+ argcount("eof-object", nargs, 0);+ return FL_EOF;
+}
+
+value_t fl_eof_objectp(value_t *args, uint32_t nargs)
+{+ argcount("eof-object?", nargs, 1);+ return (FL_EOF == args[0]) ? FL_T : FL_F;
+}
+
static ios_t *toiostream(value_t v, char *fname)
{if (!isiostream(v))
@@ -101,8 +114,11 @@
else {arg = args[0];
}
- (void)toiostream(arg, "read");
- return read_sexpr(arg);
+ ios_t *s = toiostream(arg, "read");
+ value_t v = read_sexpr(arg);
+ if (ios_eof(s))
+ return FL_EOF;
+ return v;
}
value_t fl_iogetc(value_t *args, u_int32_t nargs)
@@ -111,7 +127,8 @@
ios_t *s = toiostream(args[0], "io.getc");
uint32_t wc;
if (ios_getutf8(s, &wc) == IOS_EOF)
- lerror(IOError, "io.getc: end of file reached");
+ //lerror(IOError, "io.getc: end of file reached");
+ return FL_EOF;
return mk_wchar(wc);
}
@@ -215,7 +232,8 @@
else data = cp_data((cprim_t*)ptr(cv));
size_t got = ios_read(value2c(ios_t*,args[0]), data, n);
if (got < n)
- lerror(IOError, "io.read: end of input reached");
+ //lerror(IOError, "io.read: end of input reached");
+ return FL_EOF;
return cv;
}
@@ -306,7 +324,7 @@
}
((char*)cv->data)[n] = '\0';
if (n == 0 && ios_eof(src))
- return FL_F;
+ return FL_EOF;
return str;
}
@@ -345,7 +363,7 @@
else {char *b = ios_takebuf(st, &n); n--;
b[n] = '\0';
- str = cvalue_from_ref(stringtype, b, n, NIL);
+ str = cvalue_from_ref(stringtype, b, n, FL_NIL);
cv_autorelease((cvalue_t*)ptr(str));
}
return str;
@@ -362,6 +380,8 @@
static builtinspec_t iostreamfunc_info[] = { { "iostream?", fl_iostreamp },+ { "eof-object", fl_eof_object },+ { "eof-object?", fl_eof_objectp }, { "dump", fl_dump }, { "file", fl_file }, { "buffer", fl_buffer },@@ -399,9 +419,9 @@
assign_global_builtins(iostreamfunc_info);
setc(symbol("*stdout*"), cvalue_from_ref(iostreamtype, ios_stdout,- sizeof(ios_t), NIL));
+ sizeof(ios_t), FL_NIL));
setc(symbol("*stderr*"), cvalue_from_ref(iostreamtype, ios_stderr,- sizeof(ios_t), NIL));
+ sizeof(ios_t), FL_NIL));
setc(symbol("*stdin*" ), cvalue_from_ref(iostreamtype, ios_stdin,- sizeof(ios_t), NIL));
+ sizeof(ios_t), FL_NIL));
}
--- a/femtolisp/opcodes.h
+++ b/femtolisp/opcodes.h
@@ -29,7 +29,7 @@
OP_BRNE, OP_BRNEL, OP_CADR, OP_BRNN, OP_BRNNL, OP_BRN, OP_BRNL,
OP_OPTARGS, OP_BRBOUND, OP_KEYARGS,
- OP_BOOL_CONST_T, OP_BOOL_CONST_F, OP_THE_EMPTY_LIST,
+ OP_BOOL_CONST_T, OP_BOOL_CONST_F, OP_THE_EMPTY_LIST, OP_EOF_OBJECT,
N_OPCODES
};
--- a/femtolisp/print.c
+++ b/femtolisp/print.c
@@ -386,8 +386,11 @@
else if (v == FL_F) { outsn("#f", f, 2);}
- else if (v == NIL) {+ else if (v == FL_NIL) { outsn("()", f, 2);+ }
+ else if (v == FL_EOF) {+ outsn("#<eof>", f, 6);}
else if (isbuiltin(v)) {if (!print_princ)
--- a/femtolisp/string.c
+++ b/femtolisp/string.c
@@ -151,7 +151,7 @@
size_t len = cv_len((cvalue_t*)ptr(args[0]));
size_t dlen = cv_len((cvalue_t*)ptr(args[1]));
size_t ssz, tokend=0, tokstart=0, i=0;
- value_t first=NIL, c=NIL, last;
+ value_t first=FL_NIL, c=FL_NIL, last;
size_t junk;
fl_gc_handle(&first);
fl_gc_handle(&last);
@@ -164,7 +164,7 @@
tokend = i;
ssz = tokend - tokstart;
last = c; // save previous cons cell
- c = fl_cons(cvalue_string(ssz), NIL);
+ c = fl_cons(cvalue_string(ssz), FL_NIL);
// we've done allocation; reload movable pointers
s = cv_data((cvalue_t*)ptr(args[0]));
@@ -173,7 +173,7 @@
if (ssz) memcpy(cv_data((cvalue_t*)ptr(car_(c))), &s[tokstart], ssz);
// link new cell
- if (last == NIL)
+ if (last == FL_NIL)
first = c; // first time, save first cons
else
((cons_t*)ptr(last))->cdr = c;
--- a/femtolisp/system.lsp
+++ b/femtolisp/system.lsp
@@ -97,7 +97,6 @@
((eqv? (caar lst) item) (car lst))
(#t (assv item (cdr lst)))))
-(define (/= a b) (not (= a b)))
(define (> a b) (< b a))
(define (<= a b) (or (< a b) (= a b)))
(define (>= a b) (or (< b a) (= a b)))
@@ -116,8 +115,6 @@
-1))
0)))
(define (mod x y) (- x (* (div x y) y)))
-(define quotient div0)
-(define remainder mod0)
(define (random n)
(if (integer? n)
(mod (rand) n)
@@ -547,7 +544,10 @@
(define (io.readall s)
(let ((b (buffer)))
(io.copy b s)
- (io.tostring! b)))
+ (let ((str (io.tostring! b)))
+ (if (and (equal? str "") (io.eof? s))
+ (eof-object)
+ str))))
(define-macro (with-output-to stream . body)
`(with-bindings ((*output-stream* ,stream))
@@ -777,7 +777,7 @@
(if p
(symbol (string.join (map string (reverse! p)) "/"))
'lambda)))
- (let ((st (reverse! (list-tail st 5)))
+ (let ((st (reverse! (list-tail st (if *interactive* 5 4))))
(e (filter closure? (map (lambda (s) (and (bound? s)
(top-level-value s)))
(environment))))
@@ -883,8 +883,10 @@
(__init_globals)
(if (pair? (cdr argv))
(begin (set! *argv* (cdr argv))
+ (set! *interactive* #f)
(__script (cadr argv)))
(begin (set! *argv* argv)
+ (set! *interactive* #t)
(princ *banner*)
(repl)))
(exit 0))
--- a/femtolisp/table.c
+++ b/femtolisp/table.c
@@ -99,7 +99,7 @@
htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(nt));
htable_new(h, cnt/2);
uint32_t i;
- value_t k=NIL, arg=NIL;
+ value_t k=FL_NIL, arg=FL_NIL;
FOR_ARGS(i,0,arg,args) {if (i&1)
equalhash_put(h, (void*)k, (void*)arg);
--- a/femtolisp/unittest.lsp
+++ b/femtolisp/unittest.lsp
@@ -152,6 +152,9 @@
(assert (equal? ((lambda ((x 0) . r) (list x r)) 1 2 3) '(1 (2 3))))
; keyword arguments
+(assert (keyword? kw:))
+(assert (not (keyword? 'kw)))
+(assert (not (keyword? ':)))
(assert (equal? ((lambda (x (a 2) (b: a) . r) (list x a b r)) 1 0 8 4 5)
'(1 0 0 (8 4 5))))
(assert (equal? ((lambda (x (a 2) (b: a) . r) (list x a b r)) 0 b: 3 1)
@@ -177,6 +180,16 @@
(assert (not (eq? (gensym) (gensym))))
(assert (not (equal? (string (gensym)) (string (gensym)))))
(let ((gs (gensym))) (assert (eq? gs gs)))
+
+; eof object
+(assert (eof-object? (eof-object)))
+(assert (not (eof-object? 1)))
+(assert (not (eof-object? 'a)))
+(assert (not (eof-object? '())))
+(assert (not (eof-object? #f)))
+(assert (not (null? (eof-object))))
+(assert (not (builtin? (eof-object))))
+(assert (not (function? (eof-object))))
; ok, a couple end-to-end tests as well
(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))