ref: 4d79d1ed7c483fc45687e94ffc5c6568d78e916c
parent: bdb751c9fa7754d1e2df51773e9dc9e119ed58b8
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Fri Feb 7 22:26:03 EST 2025
remove #f (nil to be used instead) References: https://todo.sr.ht/~ft/femtolisp/22
--- a/boot/flisp.boot
+++ b/boot/flisp.boot
@@ -1,1 +1,1 @@
-(*builtins* #(0 0 0 0 0 0 0 0 0 0 0 0 #fn("5000n10<:" #()) #fn("5000n10=:" #()) 0 0 0 0 #fn("5000n10B:" #()) 0 0 0 0 0 #fn("5000n10H:" #()) 0 0 0 #fn("8000z0700}2:" #(<)) 0 #fn("6000n201N:" #()) 0 #fn("6000n201P:" #()) #fn("6000n201Q:" #()) #fn("5000n10R:" #()) #fn("5000n10S:" #()) #fn("5000n10T:" #()) 0 #fn("5000n10V:" #()) #fn("5000n10W:" #()) #fn("5000n10X:" #()) #fn("5000n10Y:" #()) #fn("5000n10Z:" #()) #fn("5000n10[:" #()) #fn("5000n10\\:" #()) #fn("5000n10]:" #()) 0 #fn("6000n201_:" #()) 0 0 0 #fn("6000n201c:" #()) #fn("6000n201d:" #()) #fn("7000z00:" #()) #fn("8000z0700}2:" #(apply)) #fn("8000z0700}2:" #(+)) #fn("8000z0700}2:" #(-)) #fn("8000z0700}2:" #(*)) #fn("8000z0700}2:" #(/)) #fn("8000z0700}2:" #(div0)) #fn("8000z0700}2:" #(=)) #fn("6000n201m:" #()) 0 #fn("8000z0700}2:" #(vector)) #fn("8000z0700}2:" #(aset!)) 0 0 0 0 0 0 0 0 0 0 0 #fn("9000n3012082>1|:" #(#fn("6000n1A061:" #()))) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 #fn("8000z0700}2:" #(aref)) 0 #fn("5000n10\x8e:" #()) 0) *properties* #table(*funvars* #table(*prompt* (#f) lz-unpack ((data :to destination) (data :size decompressed-bytes)) void? ((x)) >= ((a . rest)) rand-uint64 (nil) help ((term)) length= ((lst n)) = ((a . rest)) car ((lst)) <= ((a . rest)) rand-uint32 (nil) /= ((a . rest)) void (rest) lz-pack ((data (level 0))) rand (nil) nan? ((x)) rand-float (nil) cons? ((value)) vm-stats (nil) * ((number…)) rand-double (nil) cdr ((lst)) + ((number…)) > ((a . rest))) *doc* #table(>= "Return #t if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)." void? "Return #t if x is #<void> and #f otherwise." length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates." car "Returns the first element of a list or nil if not available." *builtins* "VM instructions as closures." <= "Return #t if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)." void "Return the constant #<void> while ignoring any arguments.\n#<void> is mainly used when a function has side effects but does not\nproduce any meaningful value to return, so even though #t or nil could\nbe returned instead, in case of #<void> alone, REPL will not print\nit." rand "Return a random non-negative fixnum on its maximum range." nan? "Return #t if the argument is NaN, regardless of the sign." Instructions "VM instructions mapped to their encoded byte representation." rand-double "Return a random double on [0.0, 1.0] interval." > "Return #t if the arguments are in strictly decreasing order (previous\none is greater than the next one)." cdr "Returns the tail of a list or nil if not available." + "Return sum of the numbers or 0 with no arguments." lz-unpack "Return decompressed data previously compressed using lz-pack.\nEither destination for the decompressed data or the expected size of\nthe decompressed data must be specified. In the latter case a new\narray is allocated." rand-uint64 "Return a random integer on [0, 2⁶⁴-1] interval." help "Display documentation for the specified term, if available." = "Return #t if the arguments are equal." rand-uint32 "Return a random integer on [0, 2³²-1] interval." /= "Return #t if not all arguments are equal. Shorthand for (not (= …))." lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10. With level 0 a simple LZSS\nusing hashing will be performed. Levels between 1 and 9 offer a\ntrade-off between time/space and ratio. Level 10 is optimal but very\nslow." rand-float "Return a random float on [0.0, 1.0] interval." arg-counts "VM instructions mapped to their expected arguments count." *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"." cons? "Returns #t if the value is a cons cell." vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc." * "Ret\ No newline at end of file
+(*builtins* #(nil nil nil nil nil nil nil nil nil nil nil nil #fn("5000n10<:" #()) #fn("5000n10=:" #()) nil nil nil nil #fn("5000n10B:" #()) nil nil nil nil nil #fn("5000n10H:" #()) nil nil nil #fn("8000z0700}2:" #(<)) nil #fn("6000n201N:" #()) nil #fn("6000n201P:" #()) #fn("6000n201Q:" #()) #fn("5000n10R:" #()) #fn("5000n10S:" #()) #fn("5000n10T:" #()) nil #fn("5000n10V:" #()) nil #fn("5000n10X:" #()) #fn("5000n10Y:" #()) #fn("5000n10Z:" #()) #fn("5000n10[:" #()) #fn("5000n10\\:" #()) #fn("5000n10]:" #()) nil #fn("6000n201_:" #()) nil nil nil #fn("6000n201c:" #()) #fn("6000n201d:" #()) #fn("7000z00:" #()) #fn("8000z0700}2:" #(apply)) #fn("8000z0700}2:" #(+)) #fn("8000z0700}2:" #(-)) #fn("8000z0700}2:" #(*)) #fn("8000z0700}2:" #(/)) #fn("8000z0700}2:" #(div0)) #fn("8000z0700}2:" #(=)) #fn("6000n201m:" #()) nil #fn("8000z0700}2:" #(vector)) #fn("8000z0700}2:" #(aset!)) nil nil nil nil nil nil nil nil nil nil nil #fn("9000n3012082>1|:" #(#fn("6000n1A061:" #()))) nil nil nil nil nil nil nil nil #fn("8000z0700}2:" #(aref)) nil nil nil) *properties* #table(*funvars* #table(*prompt* (nil) lz-unpack (#t #t) void? ((x)) >= ((a . rest)) rand-uint64 (#t) help ((term)) length= ((lst n)) = (#t) car (#t) <= ((a . rest)) rand-uint32 (#t) /= ((a . rest)) void (rest) lz-pack (#t) rand (#t) nan? (#t) rand-float (#t) cons? (#t) vm-stats (#t) * (#t) rand-double (#t) cdr (#t) + (#t) > ((a . rest))) *doc* #table(>= "Return #t if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)." void? "Return #t if x is #<void> and nil otherwise." length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates." car "Returns the first element of a list or nil if not available." *builtins* "VM instructions as closures." <= "Return #t if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)." void "Return the constant #<void> while ignoring any arguments.\n#<void> is mainly used when a function has side effects but does not\nproduce any meaningful value to return, so even though #t or nil could\nbe returned instead, in case of #<void> alone, REPL will not print\nit." rand "Return a random non-negative fixnum on its maximum range." nan? "Return #t if the argument is NaN, regardless of the sign." Instructions "VM instructions mapped to their encoded byte representation." rand-double "Return a random double on [0.0, 1.0] interval." > "Return #t if the arguments are in strictly decreasing order (previous\none is greater than the next one)." cdr "Returns the tail of a list or nil if not available." + "Return sum of the numbers or 0 with no arguments." lz-unpack "Return decompressed data previously compressed using lz-pack.\nEither destination for the decompressed data or the expected size of\nthe decompressed data must be specified. In the latter case a new\narray is allocated." rand-uint64 "Return a random integer on [0, 2⁶⁴-1] interval." help "Display documentation for the specified term, if available." = "Return #t if the arguments are equal." rand-uint32 "Return a random integer on [0, 2³²-1] interval." /= "Return #t if not all arguments are equal. Shorthand for (not (= …))." lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10. With level 0 a simple LZSS\nusing hashing will be performed. Levels between 1 and 9 offer a\ntrade-off between time/space and ratio. Level 10 is optimal but very\nslow." rand-float "Return a random float on [0.0, 1.0] interval." arg-counts "VM instructions mapped to their expected arguments count." *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"." cons? "Returns #t if the value is a cons cell." vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc." * "Return product of the numbers or 1 with no arguments.\ No newline at end of file
binary files a/boot/flisp.boot.builtin b/boot/flisp.boot.builtin differ
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -65,7 +65,7 @@
return bind;
v = cdr_(v);
}
- return FL_f;
+ return FL_nil;
}
fl_purefn
@@ -79,7 +79,7 @@
if((c = ptr(v))->car == args[0])
return v;
}
- return FL_f;
+ return FL_nil;
}
BUILTIN("length", length)@@ -158,7 +158,7 @@
BUILTIN("keyword?", keywordp) {argcount(nargs, 1);
- return (issymbol(args[0]) && iskeyword((symbol_t*)ptr(args[0]))) ? FL_t : FL_f;
+ return (issymbol(args[0]) && iskeyword((symbol_t*)ptr(args[0]))) ? FL_t : FL_nil;
}
fl_purefn
@@ -210,11 +210,11 @@
{argcount(nargs, 1);
if(issymbol(args[0]))
- return isconstant((symbol_t*)ptr(args[0])) ? FL_t : FL_f;
+ return isconstant((symbol_t*)ptr(args[0])) ? FL_t : FL_nil;
if(iscons(args[0])){if(car_(args[0]) == FL_quote)
return FL_t;
- return FL_f;
+ return FL_nil;
}
return FL_t;
}
@@ -246,7 +246,7 @@
return FL_t;
}
}
- return FL_f;
+ return FL_nil;
}
fl_purefn
@@ -256,7 +256,7 @@
value_t v = args[0];
return (isfixnum(v) || ismpint(v) ||
(iscprim(v) && cp_numtype(ptr(v)) < T_FLOAT)) ?
- FL_t : FL_f;
+ FL_t : FL_nil;
}
fl_purefn
@@ -263,7 +263,7 @@
BUILTIN("bignum?", bignump) {argcount(nargs, 1);
- return ismpint(args[0]) ? FL_t : FL_f;
+ return ismpint(args[0]) ? FL_t : FL_nil;
}
BUILTIN("fixnum", fixnum)@@ -402,7 +402,7 @@
{argcount(nargs, 1);
const char *path = tostring(args[0]);
- return access(path, F_OK) == 0 ? FL_t : FL_f;
+ return access(path, F_OK) == 0 ? FL_t : FL_nil;
}
BUILTIN("delete-file", delete_file)@@ -420,7 +420,7 @@
char *name = tostring(args[0]);
char *val = getenv(name);
if(val == nil)
- return FL_f;
+ return FL_nil;
return cvalue_static_cstring(val);
}
@@ -429,7 +429,7 @@
argcount(nargs, 2);
char *name = tostring(args[0]);
int result;
- if(args[1] == FL_f)
+ if(args[1] == FL_nil)
result = unsetenv(name);
else{char *val = tostring(args[1]);
--- a/src/compiler.lsp
+++ b/src/compiler.lsp
@@ -24,7 +24,7 @@
(def (load? i)
(member i '(load0 load1 loadt loadf loadnil loadvoid))) ; FIXME no load immediate here yet
(let ((bc (aref e 0)))
- (if (null? args)
+ (if (not args)
(if (and (eq? inst 'car)
(eq? (car bc) 'cdr))
(set-car! bc 'cadr)
@@ -61,19 +61,12 @@
(set! args ()))))
(let ((lasti (car bc)))
- (cond ((and (eq? inst 'brf)
- (cond ((and (eq? lasti 'not)
- (eq? (cadr bc) 'null?))
- (aset! e 0 (cons (car args) (cons 'brn (cddr bc)))))
- ((eq? lasti 'not)
- (aset! e 0 (cons (car args) (cons 'brt (cdr bc)))))
+ (cond ((and (eq? inst 'brn)
+ (cond ((eq? lasti 'not)
+ (aset! e 0 (cons (car args) (cons 'brnn (cdr bc)))))
((eq? lasti 'eq?)
(aset! e 0 (cons (car args) (cons 'brne (cdr bc)))))
- ((eq? lasti 'null?)
- (aset! e 0 (cons (car args) (cons 'brnn (cdr bc)))))
- (else #f))))
- ((and (eq? inst 'brt) (eq? lasti 'null?))
- (aset! e 0 (cons (car args) (cons 'brn (cdr bc)))))
+ (else nil))))
(else
(aset! e 0 (nreconc (cons inst args) bc)))))))
e))
@@ -96,8 +89,8 @@
(label-to-loc (table))
(fixup-to-label (table))
(bcode (buffer))
- (vi #f)
- (nxt #f))
+ (vi nil)
+ (nxt nil))
(io-write bcode #int32(0))
(while (< i n)
(begin
@@ -112,8 +105,6 @@
(if long?
(case vi
(jmp 'jmp.l)
- (brt 'brt.l)
- (brf 'brf.l)
(brne 'brne.l)
(brnn 'brnn.l)
(brn 'brn.l)
@@ -120,8 +111,8 @@
(else vi))
vi))))
(set! i (+ i 1))
- (set! nxt (if (< i n) (aref v i) #f))
- (cond ((memq vi '(jmp brf brt brne brnn brn))
+ (set! nxt (and (< i n) (aref v i)))
+ (cond ((memq vi '(jmp brne brnn brn))
(put! fixup-to-label (sizeof bcode) nxt)
(io-write bcode ((if long? int32 int16) 0))
(set! i (+ i 1)))
@@ -148,7 +139,7 @@
; other number arguments are always uint8
(io-write bcode (uint8 nxt))
(set! i (+ i 1)))))
- (else #f))))))
+ (else nil))))))
(for-each
(λ (addr labl)
@@ -182,7 +173,7 @@
(aset! g 3 (nconc ce (list sym))))))))
(def (index-of item lst start)
- (cond ((null? lst) #f)
+ (cond ((not lst) nil)
((eq? item (car lst)) start)
(else (index-of item (cdr lst) (+ start 1)))))
@@ -192,7 +183,7 @@
(in-env? s (cdr env)))))
(def (lookup-sym s env lev)
- (if (null? env)
+ (if (not env)
'global
(let* ((curr (car env))
(vi (assq s curr)))
@@ -227,9 +218,9 @@
(def (compile-aset! g env args)
(let ((nref (- (length args) 2)))
(cond ((= nref 1)
- (compile-app g env #f (cons 'aset! args)))
+ (compile-app g env nil (cons 'aset! args)))
((> nref 1)
- (compile-app g env #f (cons 'aref (list-head args nref)))
+ (compile-app g env nil (cons 'aref (list-head args nref)))
(let ((nargs (compile-arglist g env (list-tail args nref))))
(bcode:stack g (- nargs))
(emit g 'aset!)))
@@ -238,7 +229,7 @@
(def (compile-set! g env s rhs)
(let ((loc (lookup-sym s env 0)))
(if (eq? loc 'global)
- (begin (compile-in g env #f rhs)
+ (begin (compile-in g env nil rhs)
(emit g 'setg s))
(let ((arg? (= (car loc) 0)))
(let ((h? (vinfo:heap? (cdr loc)))
@@ -248,11 +239,11 @@
(if h?
(begin (emit g (if arg? 'loada 'loadc) idx)
(bcode:stack g 1)
- (compile-in g env #f rhs)
+ (compile-in g env nil rhs)
(bcode:stack g -1)
(emit g 'set-car!))
- (begin (compile-in g env #f rhs)
+ (begin (compile-in g env nil rhs)
(if (not arg?) (error (string "internal error: misallocated var " s)))
(emit g 'seta idx))))))))
@@ -273,14 +264,14 @@
(then (caddr x))
(else (if (cons? (cdddr x))
(cadddr x)
- #f)))
+ nil)))
(cond ((eq? test #t)
(compile-in g env tail? then))
- ((eq? test #f)
+ ((eq? test nil)
(compile-in g env tail? else))
(else
- (compile-in g env #f test elsel)
- (emit g 'brf elsel)
+ (compile-in g env nil test elsel)
+ (emit g 'brn elsel)
(mark-label g thenl)
(compile-in g env tail? then)
(if tail?
@@ -295,15 +286,15 @@
((atom? (cdr forms))
(compile-in g env tail? (car forms)))
(else
- (compile-in g env #f (car forms))
+ (compile-in g env nil (car forms))
(emit g 'pop)
(compile-begin g env tail? (cdr forms)))))
(def (compile-prog1 g env x)
- (compile-in g env #f (cadr x))
+ (compile-in g env nil (cadr x))
(if (cons? (cddr x))
(begin (bcode:stack g 1)
- (compile-begin g env #f (cddr x))
+ (compile-begin g env nil (cddr x))
(emit g 'pop)
(bcode:stack g -1))))
@@ -310,14 +301,14 @@
(def (compile-while g env cond body)
(let ((top (make-label g))
(end (make-label g)))
- (compile-in g env #f (void))
+ (compile-in g env nil (void))
(bcode:stack g 1)
(mark-label g top)
- (compile-in g env #f cond)
- (emit g 'brf end)
+ (compile-in g env nil cond)
+ (emit g 'brn end)
(emit g 'pop)
(bcode:stack g -1)
- (compile-in g env #f body)
+ (compile-in g env nil body)
(emit g 'jmp top)
(mark-label g end)))
@@ -335,7 +326,7 @@
((atom? (cdr forms)) (compile-in g env tail? (car forms) outl))
(else
(let ((end (or outl (make-label g))))
- (compile-in g env #f (car forms) outl)
+ (compile-in g env nil (car forms) outl)
(bcode:stack g 1)
(unless outl (emit g 'dup))
(emit g branch end)
@@ -345,15 +336,15 @@
(unless outl (mark-label g end))))))
(def (compile-and g env tail? forms outl)
- (compile-short-circuit g env tail? forms #t 'brf outl))
+ (compile-short-circuit g env tail? forms #t 'brn outl))
(def (compile-or g env tail? forms)
- (compile-short-circuit g env tail? forms #f 'brt #f))
+ (compile-short-circuit g env tail? forms nil 'brnn nil))
;; calls
(def (compile-arglist g env lst)
(for-each (λ (a)
- (compile-in g env #f a)
+ (compile-in g env nil a)
(bcode:stack g 1))
lst)
(length lst))
@@ -369,17 +360,17 @@
fixnum? 'fixnum? equal? 'equal?
eq? 'eq? symbol? 'symbol?
div0 'div0 builtin? 'builtin?
- aset! 'aset! - '- boolean? 'boolean? not 'not
+ aset! 'aset! - '- not 'not
apply 'apply atom? 'atom? nan? 'nan?
set-cdr! 'set-cdr! / '/
function? 'function? vector 'vector
list 'list bound? 'bound?
- < '< * '* cdr 'cdr cadr 'cadr null? 'null?
+ < '< * '* cdr 'cdr cadr 'cadr
+ '+ eqv? 'eqv? compare 'compare aref 'aref
set-car! 'set-car! car 'car for 'for
cons? 'cons? = '= vector? 'vector?)))
(λ (b)
- (get b2i b #f))))
+ (get b2i b nil))))
(def (compile-builtin-call g env tail? x head b nargs)
(def (num-compare)
@@ -386,7 +377,7 @@
(if (= nargs 0)
(argc-error b 1)
(emit g b nargs)))
- (let ((count (get arg-counts b #f)))
+ (let ((count (get arg-counts b nil)))
(if (and count
(not (length= (cdr x) count)))
(argc-error b count))
@@ -458,7 +449,7 @@
head)))
(if (length> (cdr x) 255)
;; more than 255 arguments, need long versions of instructions
- (begin (compile-in g env #f head)
+ (begin (compile-in g env nil head)
(bcode:stack g 1)
(let ((nargs (compile-arglist g env (cdr x))))
(bcode:stack g (- nargs))
@@ -469,7 +460,7 @@
(not (in-env? head env))
(equal? (top-level-value 'cadr) cadr)
(length= x 2))
- (begin (compile-in g env #f (cadr x))
+ (begin (compile-in g env nil (cadr x))
(emit g 'cadr))
(if (and (cons? head)
(is-lambda? (car head))
@@ -477,7 +468,7 @@
(compile-let g env tail? x)
(begin
(unless b
- (compile-in g env #f head)
+ (compile-in g env nil head)
(bcode:stack g 1))
(let ((nargs (compile-arglist g env (cdr x))))
(bcode:stack g (- nargs))
@@ -490,13 +481,12 @@
(def (fits-i8 x) (and (fixnum? x) (>= 127 x -128)))
-(def (compile-in g env tail? x (outl #f))
+(def (compile-in g env tail? x (outl nil))
(cond ((symbol? x) (compile-sym g env x #t))
((atom? x)
(cond ((eq? x 0) (emit g 'load0))
((eq? x 1) (emit g 'load1))
((eq? x #t) (emit g 'loadt))
- ((eq? x #f) (emit g 'loadf))
((eq? x nil) (emit g 'loadnil))
((void? x) (emit g 'loadvoid))
((fits-i8 x) (emit g 'loadi8 x))
@@ -515,10 +505,10 @@
(prog1 (compile-prog1 g env x))
(λ (receive (the-f cenv) (compile-f- env x)
(begin (emit g 'loadv the-f)
- (if (not (null? cenv))
+ (if cenv
(begin
(for-each (λ (var)
- (compile-sym g env var #f))
+ (compile-sym g env var nil))
cenv)
(emit g 'closure (length cenv)))))))
(and (compile-and g env tail? (cdr x) outl))
@@ -537,10 +527,10 @@
(is-lambda? (car (car value)))
(lambda:vars (car value)))))
(compile-set! g env name (car value))))
- (trycatch (compile-in g env #f `(λ () ,(cadr x)))
+ (trycatch (compile-in g env nil `(λ () ,(cadr x)))
(unless (1arg-lambda? (caddr x))
(error "trycatch: second form must be a 1-argument lambda"))
- (compile-in g env #f (caddr x))
+ (compile-in g env nil (caddr x))
(emit g 'trycatch))
(else (compile-app g env tail? x))))))
@@ -555,7 +545,7 @@
(def (lambda-vars l)
(def (check-formals l o opt kw)
- (cond ((or (null? l) (symbol? l)) #t)
+ (cond ((or (not l) (symbol? l)) #t)
((and (cons? l) (symbol? (car l)))
(if (or opt kw)
(error "compile error: invalid argument list "
@@ -580,7 +570,7 @@
(error "compile error: invalid argument list " o)
(error "compile error: invalid formal argument " l
" in list " o)))))
- (check-formals l l #f #f)
+ (check-formals l l nil nil)
(map (λ (s) (if (cons? s) (keyword->symbol (car s)) s))
(to-proper l)))
@@ -589,8 +579,8 @@
(if (cons? opta)
(let ((nxt (make-label g)))
(emit g 'brbound i)
- (emit g 'brt nxt)
- (compile-in g (extend-env env (list-head vars i) '()) #f (cadar opta))
+ (emit g 'brnn nxt)
+ (compile-in g (extend-env env (list-head vars i) '()) nil (cadar opta))
(emit g 'seta i)
(emit g 'pop)
(mark-label g nxt)
@@ -638,10 +628,10 @@
(void)))
(V (get-defined-vars B))
(new-B (lower-define B)))
- (if (null? V)
- new-B
+ (if V
(cons `(λ ,V ,new-B)
- (map void V)))))
+ (map void V))
+ new-B)))
(cond ((or (atom? e) (quoted? e))
e)
((eq? (car e) 'def)
@@ -657,38 +647,38 @@
(def (lambda:vars e) (lambda-vars (cadr e)))
(def (diff s1 s2)
- (cond ((null? s1) '())
+ (cond ((not s1) nil)
((memq (car s1) s2) (diff (cdr s1) s2))
(else (cons (car s1) (diff (cdr s1) s2)))))
;; bindings that are both captured and set!'d
(def (complex-bindings- e vars head nested capt setd)
- (cond ((null? vars) #f)
+ (cond ((not vars) nil)
((symbol? e)
(if (and nested (memq e vars))
(put! capt e #t)))
- ((or (atom? e) (quoted? e)) #f)
+ ((or (atom? e) (quoted? e)) nil)
((eq? (car e) 'set!)
(if (memq (cadr e) vars)
(begin (put! setd (cadr e) #t)
(if nested (put! capt (cadr e) #t))))
- (complex-bindings- (caddr e) vars #f nested capt setd))
+ (complex-bindings- (caddr e) vars nil nested capt setd))
((is-lambda? (car e))
(complex-bindings- (lambda:body e)
(diff vars (lambda:vars e))
- #f
+ nil
(or (not head) nested)
capt setd))
(else
(cons (complex-bindings- (car e) vars (inlineable? e) nested capt setd)
(map (λ (x)
- (complex-bindings- x vars #f nested capt setd))
+ (complex-bindings- x vars nil nested capt setd))
(cdr e))))))
(def (complex-bindings e vars)
(let ((capt (table))
(setd (table)))
- (complex-bindings- e vars #f #f capt setd)
+ (complex-bindings- e vars nil nil capt setd)
(filter (λ (x) (has? capt x))
(table-keys setd))))
@@ -721,31 +711,28 @@
(vars (lambda:vars f))
(opta (filter cons? (cadr f)))
(last (lastcdr f)))
- (let* ((name (if (null? last) 'λ last))
+ (let* ((name (if (not last) 'λ last))
(nargs (if (atom? args) 0 (length args)))
(nreq (- nargs (length opta)))
(kwa (filter keyword-arg? opta)))
;; emit argument checking prologue
- (if (not (null? opta))
- (begin
- (if (null? kwa)
- (emit g 'optargs nreq
- (if (null? atail) nargs (- nargs)))
- (begin
- (bcode:indexfor g (make-perfect-hash-table
- (map cons
- (map car kwa)
- (iota (length kwa)))))
- (emit g 'keyargs nreq (length kwa)
- (if (null? atail) nargs (- nargs)))))
- (emit-optional-arg-inits g env opta vars nreq)))
+ (when opta
+ (if (not kwa)
+ (emit g 'optargs nreq
+ (if atail (- nargs) nargs))
+ (begin
+ (bcode:indexfor g (make-perfect-hash-table
+ (map cons
+ (map car kwa)
+ (iota (length kwa)))))
+ (emit g 'keyargs nreq (length kwa)
+ (if atail (- nargs) nargs))))
+ (emit-optional-arg-inits g env opta vars nreq))
- (cond ((> nargs 255) (emit g (if (null? atail)
- 'largc 'lvargc)
- nargs))
- ((not (null? atail)) (emit g 'vargc nargs))
- ((null? opta) (emit g 'argc nargs)))
+ (cond ((> nargs 255) (emit g (if atail 'lvargc 'largc) nargs))
+ (atail (emit g 'vargc nargs))
+ ((not opta) (emit g 'argc nargs)))
(let ((newenv (extend-env env vars (complex-bindings (lambda:body f) vars))))
(box-vars g (car newenv))
@@ -773,11 +760,11 @@
(def (hex5 n)
(string-lpad (number->string n 16) 5 #\0))
-(def (disassemble f (ip #f) . lev?)
- (if (null? lev?)
- (begin (disassemble f ip 0)
- (newline)
- (return (void))))
+(def (disassemble f (ip nil) . lev?)
+ (when (not lev?)
+ (disassemble f ip 0)
+ (newline)
+ (return (void)))
(let ((lev (car lev?))
(code (function:code f))
(vals (function:vals f)))
@@ -784,7 +771,7 @@
(def (print-val v)
(if (and (function? v) (not (builtin? v)))
(begin (newline)
- (disassemble v #f (+ lev 1)))
+ (disassemble v nil (+ lev 1)))
(print v)))
(def (print-inst inst s sz) (princ (if (and ip (= lev 0) (>= ip (1- s)) (< ip (+ s sz)))
" >"
@@ -798,7 +785,7 @@
(let ((inst (table-foldl (λ (k v z)
(or z (and (eq? v (aref code i))
k)))
- #f Instructions)))
+ nil Instructions)))
(if (> i 4) (newline))
(dotimes (xx lev) (princ "\t"))
(set! i (+ i 1))
@@ -841,12 +828,12 @@
(princ (number->string (ref-int32-LE code i)) " ")
(set! i (+ i 4)))
- ((jmp brf brt brne brnn brn)
+ ((jmp brne brnn brn)
(print-inst inst i 2)
(princ "@" (hex5 (+ i -4 (ref-int16-LE code i))))
(set! i (+ i 2)))
- ((jmp.l brf.l brt.l brne.l brnn.l brn.l)
+ ((jmp.l brne.l brnn.l brn.l)
(print-inst inst i 4)
(princ "@" (hex5 (+ i -4 (ref-int32-LE code i))))
(set! i (+ i 4)))
@@ -867,7 +854,7 @@
(def (make-perfect-hash-table alist)
(def ($hash-keyword key n) (mod0 (abs (hash key)) n))
(let loop1 ((n (length alist)))
- (let ((v (vector-alloc (* 2 n) #f)))
+ (let ((v (vector-alloc (* 2 n) nil)))
(let loop2 ((lst alist))
(if (cons? lst)
(let ((key (caar lst)))
--- a/src/cvalues.c
+++ b/src/cvalues.c
@@ -570,7 +570,7 @@
case TAG_SYM: return FL_symbolsym;
case TAG_VECTOR: return FL_vectorsym;
case TAG_FUNCTION:
- if(args[0] == FL_t || args[0] == FL_f)
+ if(args[0] == FL_t)
return FL_booleansym;
if(args[0] == FL_nil)
return FL_nullsym;
@@ -651,7 +651,7 @@
argcount(nargs, 1);
return (iscprim(args[0]) ||
(iscvalue(args[0]) && cv_isPOD(ptr(args[0])))) ?
- FL_t : FL_f;
+ FL_t : FL_nil;
}
static void
--- a/src/docs_extra.lsp
+++ b/src/docs_extra.lsp
@@ -1,7 +1,7 @@
-(defmacro (doc-for term (doc #f))
+(defmacro (doc-for term (doc nil))
(let* ((sym (or (and (cons? term) (car term)) term))
(val (top-level-value sym))
- (funvars (and (cons? term) (cdr term))))
+ (funvars (cons? term)))
(if (not funvars)
(when (function? val)
(error "docs: " sym ": no funvars specified"))
--- a/src/flisp.c
+++ b/src/flisp.c
@@ -22,7 +22,7 @@
value_t FL_commadot, FL_trycatch, FL_backquote;
value_t FL_conssym, FL_symbolsym, FL_fixnumsym, FL_vectorsym, FL_builtinsym, FL_vu8sym;
value_t FL_definesym, FL_defmacrosym, FL_forsym, FL_setqsym;
-value_t FL_tsym, FL_Tsym, FL_fsym, FL_Fsym, FL_booleansym, FL_nullsym, FL_evalsym, FL_fnsym;
+value_t FL_tsym, FL_Tsym, FL_booleansym, FL_nullsym, FL_evalsym, FL_fnsym;
value_t FL_nulsym, FL_alarmsym, FL_backspacesym, FL_tabsym, FL_linefeedsym, FL_newlinesym;
value_t FL_vtabsym, FL_pagesym, FL_returnsym, FL_escsym, FL_spacesym, FL_deletesym;
value_t FL_IOError, FL_ParseError, FL_TypeError, FL_ArgError, FL_MemoryError;
@@ -249,7 +249,7 @@
BUILTIN("gensym?", gensymp) {argcount(nargs, 1);
- return isgensym(args[0]) ? FL_t : FL_f;
+ return isgensym(args[0]) ? FL_t : FL_nil;
}
char *
@@ -1105,7 +1105,7 @@
if(iscbuiltin(v)){v = (value_t)ptrhash_get(&FL(reverse_dlsym_lookup_table), ptr(v));
if(v == (value_t)HT_NOTFOUND)
- return FL_f;
+ return FL_nil;
return v;
}
type_error("function", v);@@ -1370,15 +1370,13 @@
FL_newlinesym = csymbol("newline"); FL_tsym = csymbol("t"); FL_Tsym = csymbol("T");- FL_fsym = csymbol("f");- FL_Fsym = csymbol("F"); FL_builtins_table_sym = csymbol("*builtins*"); set(FL_printprettysym = csymbol("*print-pretty*"), FL_t); set(FL_printreadablysym = csymbol("*print-readably*"), FL_t); set(FL_printwidthsym = csymbol("*print-width*"), fixnum(FL(scr_width)));- set(FL_printlengthsym = csymbol("*print-length*"), FL_f);- set(FL_printlevelsym = csymbol("*print-level*"), FL_f);+ set(FL_printlengthsym = csymbol("*print-length*"), FL_nil);+ set(FL_printlevelsym = csymbol("*print-level*"), FL_nil);FL(lasterror) = FL_nil;
for(i = 0; i < nelem(builtins); i++){--- a/src/flisp.h
+++ b/src/flisp.h
@@ -347,7 +347,6 @@
enum {FL_nil = builtin(OP_LOADNIL),
FL_t = builtin(OP_LOADT),
- FL_f = builtin(OP_LOADF),
FL_void = builtin(OP_LOADVOID),
FL_eof = builtin(OP_EOF_OBJECT),
};
@@ -435,7 +434,7 @@
extern value_t FL_commadot, FL_trycatch, FL_backquote;
extern value_t FL_conssym, FL_symbolsym, FL_fixnumsym, FL_vectorsym, FL_builtinsym, FL_vu8sym;
extern value_t FL_definesym, FL_defmacrosym, FL_forsym, FL_setqsym;
-extern value_t FL_tsym, FL_Tsym, FL_fsym, FL_Fsym, FL_booleansym, FL_nullsym, FL_evalsym, FL_fnsym;
+extern value_t FL_tsym, FL_Tsym, FL_booleansym, FL_nullsym, FL_evalsym, FL_fnsym;
extern value_t FL_nulsym, FL_alarmsym, FL_backspacesym, FL_tabsym, FL_linefeedsym, FL_newlinesym;
extern value_t FL_vtabsym, FL_pagesym, FL_returnsym, FL_escsym, FL_spacesym, FL_deletesym;
extern value_t FL_IOError, FL_ParseError, FL_TypeError, FL_ArgError, FL_MemoryError;
--- a/src/iostream.c
+++ b/src/iostream.c
@@ -51,7 +51,7 @@
BUILTIN("iostream?", iostreamp) {argcount(nargs, 1);
- return isiostream(args[0]) ? FL_t : FL_f;
+ return isiostream(args[0]) ? FL_t : FL_nil;
}
fl_purefn
@@ -58,7 +58,7 @@
BUILTIN("eof-object?", eof_objectp) {argcount(nargs, 1);
- return args[0] == FL_eof ? FL_t : FL_f;
+ return args[0] == FL_eof ? FL_t : FL_nil;
}
fl_purefn
@@ -143,7 +143,7 @@
ios_t *s = toiostream(args[0]);
int r = ios_wait(s, nargs > 1 ? todouble(args[1]) : -1);
if(r >= 0)
- return r ? FL_t : FL_f;
+ return r ? FL_t : FL_nil;
if(r == IOS_EOF)
return FL_eof;
lerrorf(FL_IOError, "i/o error");
@@ -167,7 +167,7 @@
off_t off = tooffset(args[1]);
off_t res = ios_skip(s, off);
if(res < 0)
- return FL_f;
+ return FL_nil;
return sizeof(res) == sizeof(int64_t) ? mk_int64(res) : mk_int32(res);
}
@@ -174,7 +174,7 @@
BUILTIN("io-flush", io_flush) {argcount(nargs, 1);
- return ios_flush(toiostream(args[0])) == 0 ? FL_t : FL_f;
+ return ios_flush(toiostream(args[0])) == 0 ? FL_t : FL_nil;
}
BUILTIN("io-close", io_close)@@ -204,7 +204,7 @@
BUILTIN("io-eof?", io_eofp) {argcount(nargs, 1);
- return ios_eof(toiostream(args[0])) ? FL_t : FL_f;
+ return ios_eof(toiostream(args[0])) ? FL_t : FL_nil;
}
BUILTIN("io-seek", io_seek)@@ -214,7 +214,7 @@
size_t pos = tosize(args[1]);
off_t res = ios_seek(s, (off_t)pos);
if(res < 0)
- return FL_f;
+ return FL_nil;
return FL_t;
}
@@ -224,7 +224,7 @@
ios_t *s = toiostream(args[0]);
off_t res = ios_pos(s);
if(res < 0)
- return FL_f;
+ return FL_nil;
return size_wrap((size_t)res);
}
--- a/src/maxstack.inc
+++ b/src/maxstack.inc
@@ -13,7 +13,7 @@
case OP_LOADA: case OP_LOADI8: case OP_LOADV: case OP_LOADG:
ip++; // fallthrough
case OP_LOADA0: case OP_LOADA1:
- case OP_DUP: case OP_LOADT: case OP_LOADF: case OP_LOADNIL: case OP_LOADVOID:
+ case OP_DUP: case OP_LOADT: case OP_LOADNIL: case OP_LOADVOID:
case OP_LOAD0:
case OP_LOAD1: case OP_LOADC0:
case OP_LOADC1:
@@ -20,12 +20,6 @@
sp++;
break;
- case OP_BRF: case OP_BRT:
- SWAP_INT16(ip);
- ip += 2;
- sp--;
- break;
-
case OP_POP: case OP_RET:
case OP_CONS: case OP_SETCAR: case OP_SETCDR:
case OP_EQ: case OP_EQV: case OP_EQUAL: case OP_ADD2: case OP_SUB2:
@@ -103,11 +97,6 @@
SWAP_INT32(ip);
ip += 4;
continue;
- case OP_BRFL: case OP_BRTL:
- SWAP_INT32(ip);
- ip += 4;
- sp--;
- break;
case OP_BRNE:
SWAP_INT16(ip);
ip += 2;
@@ -147,9 +136,8 @@
break;
case OP_CAR: case OP_CDR: case OP_CADR:
- case OP_NOT: case OP_NEG:
+ case OP_NOT: case OP_NEG: case OP_NUMBERP:
case OP_CONSP: case OP_ATOMP: case OP_SYMBOLP:
- case OP_NULLP: case OP_BOOLEANP: case OP_NUMBERP:
case OP_FIXNUMP: case OP_BOUNDP: case OP_BUILTINP:
case OP_FUNCTIONP: case OP_VECTORP: case OP_NANP:
continue;
--- a/src/opcodes.c
+++ b/src/opcodes.c
@@ -1,19 +1,17 @@
#include "flisp.h"
const Builtin builtins[N_OPCODES] = {- [OP_SETCAR] = {"set-car!", 2}, [OP_NANP] = {"nan?", 1},+ [OP_SETCAR] = {"set-car!", 2}, [OP_CDR] = {"cdr", 1},- [OP_BOOLEANP] = {"boolean?", 1}, [OP_FUNCTIONP] = {"function?", 1}, [OP_CADR] = {"cadr", 1}, [OP_SETCDR] = {"set-cdr!", 2}, [OP_EQ] = {"eq?", 2}, [OP_APPLY] = {"apply", -2},- [OP_NULLP] = {"null?", 1},+ [OP_ASET] = {"aset!", -3}, [OP_CONSP] = {"cons?", 1}, [OP_ATOMP] = {"atom?", 1},- [OP_ASET] = {"aset!", -3}, [OP_NOT] = {"not", 1}, [OP_LIST] = {"list", ANYARGS}, [OP_CONS] = {"cons", 2},@@ -26,8 +24,8 @@
[OP_IDIV] = {"div0", 2}, [OP_FIXNUMP] = {"fixnum?", 1}, [OP_NUMEQ] = {"=", -1},- [OP_SYMBOLP] = {"symbol?", 1}, [OP_BUILTINP] = {"builtin?", 1},+ [OP_SYMBOLP] = {"symbol?", 1}, [OP_SUB] = {"-", -1}, [OP_COMPARE] = {"compare", 2}, [OP_FOR] = {"for", 3},--- a/src/opcodes.h
+++ b/src/opcodes.h
@@ -2,7 +2,7 @@
OP_LOADA0,
OP_LOADA1,
OP_LOADV,
- OP_BRF,
+ OP_BRN,
OP_POP,
OP_CALL,
OP_TCALL,
@@ -24,13 +24,13 @@
OP_LOADC1,
OP_AREF2,
OP_ATOMP,
- OP_BRT,
+ OP_LOADVOID,
OP_BRNN,
OP_LOAD1,
OP_LT,
OP_ADD2,
OP_SETCDR,
- OP_LOADF,
+ OP_KEYARGS,
OP_CONS,
OP_EQ,
OP_SYMBOLP,
@@ -37,8 +37,8 @@
OP_NOT,
OP_CADR,
OP_NEG,
- OP_NULLP,
- OP_BOOLEANP,
+ OP_NANP,
+ OP_BRBOUND,
OP_NUMBERP,
OP_FIXNUMP,
OP_BOUNDP,
@@ -48,8 +48,8 @@
OP_SHIFT,
OP_SETCAR,
OP_JMPL,
- OP_BRFL,
- OP_BRTL,
+ OP_BRNL,
+ OP_BOX,
OP_EQV,
OP_EQUAL,
OP_LIST,
@@ -84,16 +84,9 @@
OP_TCALLL,
OP_BRNEL,
OP_BRNNL,
- OP_BRN,
- OP_BRNL,
- OP_OPTARGS,
- OP_BRBOUND,
- OP_KEYARGS,
- OP_BOX,
- OP_BOXL,
OP_AREF,
- OP_LOADVOID,
- OP_NANP,
+ OP_BOXL,
+ OP_OPTARGS,
OP_EOF_OBJECT,
N_OPCODES
}opcode_t;
--- a/src/print.c
+++ b/src/print.c
@@ -177,8 +177,7 @@
return cv_len(ptr(v)) < SMALL_STR_LEN;
return (
isfixnum(v) || isbuiltin(v) || iscprim(v) ||
- v == FL_f || v == FL_t ||
- v == FL_nil || v == FL_eof || v == FL_void
+ v == FL_t || v == FL_nil || v == FL_eof || v == FL_void
);
}
@@ -420,8 +419,6 @@
case TAG_FUNCTION:
if(v == FL_t)
outsn(f, "#t", 2);
- else if(v == FL_f)
- outsn(f, "#f", 2);
else if(v == FL_nil)
outsn(f, "nil", 3);
else if(v == FL_eof)
@@ -854,10 +851,10 @@
void
fl_print(ios_t *f, value_t v)
{- FL(print_pretty) = symbol_value(FL_printprettysym) != FL_f;
+ FL(print_pretty) = symbol_value(FL_printprettysym) != FL_nil;
if(FL(print_pretty))
set_print_width();
- FL(print_princ) = symbol_value(FL_printreadablysym) == FL_f;
+ FL(print_princ) = symbol_value(FL_printreadablysym) == FL_nil;
value_t pl = symbol_value(FL_printlengthsym);
FL(print_length) = isfixnum(pl) ? numval(pl) : -1;
pl = symbol_value(FL_printlevelsym);
@@ -875,6 +872,6 @@
memset(FL(consflags), 0, 4*bitvector_nwords(FL(heapsize)/sizeof(cons_t)));
if((iscons(v) || isvector(v) || isfunction(v) || iscvalue(v)) &&
- !fl_isstring(v) && v != FL_t && v != FL_f && v != FL_nil && v != FL_void)
+ !fl_isstring(v) && v != FL_t && v != FL_nil && v != FL_void)
htable_reset(&FL(printconses), 32);
}
--- a/src/read.c
+++ b/src/read.c
@@ -647,8 +647,6 @@
sym = ctx->tokval;
if(sym == FL_tsym || sym == FL_Tsym)
return FL_t;
- if(sym == FL_fsym || sym == FL_Fsym)
- return FL_f;
// constructor notation
c = nextchar();
ctx->loc = RS->loc;
--- a/src/string.c
+++ b/src/string.c
@@ -13,7 +13,7 @@
BUILTIN("string?", stringp) {argcount(nargs, 1);
- return fl_isstring(args[0]) ? FL_t : FL_f;
+ return fl_isstring(args[0]) ? FL_t : FL_nil;
}
BUILTIN("string-length", string_length)@@ -48,7 +48,7 @@
cprim_t *cp = ptr(args[0]);
if(cp_class(cp) == FL(runetype)){int w = fl_wcwidth(*(Rune*)cp_data(cp));
- return w < 0 ? FL_f : fixnum(w);
+ return w < 0 ? FL_nil : fixnum(w);
}
}
if(!fl_isstring(args[0]))
@@ -56,7 +56,7 @@
char *str = tostring(args[0]);
size_t len = cv_len(ptr(args[0]));
ssize_t w = u8_strwidth(str, len);
- return w < 0 ? FL_f : size_wrap(w);
+ return w < 0 ? FL_nil : size_wrap(w);
}
BUILTIN("string-reverse", string_reverse)@@ -94,7 +94,7 @@
{bool term = false;
if(nargs == 2)
- term = args[1] != FL_f;
+ term = args[1] != FL_nil;
else
argcount(nargs, 1);
if(!fl_isstring(args[0]))
@@ -125,8 +125,8 @@
ios_t *s = value2c(ios_t*, buf);
value_t oldpr = symbol_value(FL_printreadablysym);
value_t oldpp = symbol_value(FL_printprettysym);
- set(FL_printreadablysym, FL_f);
- set(FL_printprettysym, FL_f);
+ set(FL_printreadablysym, FL_nil);
+ set(FL_printprettysym, FL_nil);
uint32_t i;
FOR_ARGS(i, 0, arg, args){USED(arg);
@@ -256,7 +256,7 @@
cprim_t *cp = ptr(args[0]);
if(!iscprim(args[0]) || cp_class(cp) != FL(runetype))
type_error("rune", args[0]);- return isalpharune(*(Rune*)cp_data(cp)) ? FL_t : FL_f;
+ return isalpharune(*(Rune*)cp_data(cp)) ? FL_t : FL_nil;
}
fl_purefn
@@ -266,7 +266,7 @@
cprim_t *cp = ptr(args[0]);
if(!iscprim(args[0]) || cp_class(cp) != FL(runetype))
type_error("rune", args[0]);- return islowerrune(*(Rune*)cp_data(cp)) ? FL_t : FL_f;
+ return islowerrune(*(Rune*)cp_data(cp)) ? FL_t : FL_nil;
}
fl_purefn
@@ -276,7 +276,7 @@
cprim_t *cp = ptr(args[0]);
if(!iscprim(args[0]) || cp_class(cp) != FL(runetype))
type_error("rune", args[0]);- return isupperrune(*(Rune*)cp_data(cp)) ? FL_t : FL_f;
+ return isupperrune(*(Rune*)cp_data(cp)) ? FL_t : FL_nil;
}
fl_purefn
@@ -286,7 +286,7 @@
cprim_t *cp = ptr(args[0]);
if(!iscprim(args[0]) || cp_class(cp) != FL(runetype))
type_error("rune", args[0]);- return istitlerune(*(Rune*)cp_data(cp)) ? FL_t : FL_f;
+ return istitlerune(*(Rune*)cp_data(cp)) ? FL_t : FL_nil;
}
fl_purefn
@@ -296,7 +296,7 @@
cprim_t *cp = ptr(args[0]);
if(!iscprim(args[0]) || cp_class(cp) != FL(runetype))
type_error("rune", args[0]);- return isdigitrune(*(Rune*)cp_data(cp)) ? FL_t : FL_f;
+ return isdigitrune(*(Rune*)cp_data(cp)) ? FL_t : FL_nil;
}
fl_purefn
@@ -306,7 +306,7 @@
cprim_t *cp = ptr(args[0]);
if(!iscprim(args[0]) || cp_class(cp) != FL(runetype))
type_error("rune", args[0]);- return isspacerune(*(Rune*)cp_data(cp)) ? FL_t : FL_f;
+ return isspacerune(*(Rune*)cp_data(cp)) ? FL_t : FL_nil;
}
BUILTIN("string-find", string_find)@@ -343,7 +343,7 @@
type_error("string", args[1]);}
if(needlesz > len-start)
- return FL_f;
+ return FL_nil;
if(needlesz == 0)
return size_wrap(start);
size_t i;
@@ -351,7 +351,7 @@
if(s[i] == needle[0] && memcmp(&s[i+1], needle+1, needlesz-1) == 0)
return size_wrap(i);
}
- return FL_f;
+ return FL_nil;
}
static unsigned long
@@ -419,7 +419,7 @@
if(nargs == 2)
radix = get_radix_arg(args[1]);
if(!fl_read_numtok(str, &n, (int)radix))
- return FL_f;
+ return FL_nil;
return n;
}
@@ -429,5 +429,5 @@
argcount(nargs, 1);
char *s = tostring(args[0]);
size_t len = cv_len(ptr(args[0]));
- return u8_isvalid(s, len) ? FL_t : FL_f;
+ return u8_isvalid(s, len) ? FL_t : FL_nil;
}
--- a/src/system.lsp
+++ b/src/system.lsp
@@ -14,7 +14,7 @@
#.(void))
(def (void? x)
- "Return #t if x is #<void> and #f otherwise."
+ "Return #t if x is #<void> and nil otherwise."
(eq? x #.(void)))
;;; syntax environment
@@ -23,7 +23,7 @@
(def *syntax-environment* (table)))
(def (set-syntax! s v) (put! *syntax-environment* s v))
-(def (symbol-syntax s) (get *syntax-environment* s #f))
+(def (symbol-syntax s) (get *syntax-environment* s nil))
(defmacro (defmacro form . body)
(let ((doc (value-get-doc body)))
@@ -40,7 +40,7 @@
,.(map void binds)))
(defmacro (let binds . body)
- (let ((lname #f))
+ (let ((lname nil))
(when (symbol? binds)
(set! lname binds)
(set! binds (car body))
@@ -59,14 +59,14 @@
(defmacro (cond . clauses)
(def (cond-clauses->if lst)
(if (atom? lst)
- #f
+ nil
(let ((clause (car lst)))
(if (or (eq? (car clause) 'else)
(eq? (car clause) #t))
- (if (null? (cdr clause))
+ (if (not (cdr clause))
(car clause)
(cons 'begin (cdr clause)))
- (if (null? (cdr clause))
+ (if (not (cdr clause))
; test by itself
(list 'or
(car clause)
@@ -102,7 +102,7 @@
(def *properties* (table)))
(def (putprop sym key val)
- (let ((kt (get *properties* key #f)))
+ (let ((kt (get *properties* key nil)))
(unless kt
(let ((t (table)))
(put! *properties* key t)
@@ -110,12 +110,12 @@
(put! kt sym val)
val))
-(def (getprop sym key (def #f))
- (let ((kt (get *properties* key #f)))
+(def (getprop sym key (def nil))
+ (let ((kt (get *properties* key nil)))
(or (and kt (get kt sym def)) def)))
(def (remprop sym key)
- (let ((kt (get *properties* key #f)))
+ (let ((kt (get *properties* key nil)))
(and kt (has? kt sym) (del! kt sym))))
;;; documentation
@@ -155,28 +155,24 @@
;;; standard procedures
(def (member item lst)
- (cond ((null? lst) #f)
- ((equal? (car lst) item) lst)
- (#t (member item (cdr lst)))))
+ (cond ((equal? (car lst) item) lst)
+ (lst (member item (cdr lst)))))
(def (memv item lst)
- (cond ((null? lst) #f)
- ((eqv? (car lst) item) lst)
- (#t (memv item (cdr lst)))))
+ (cond ((eqv? (car lst) item) lst)
+ (lst (memv item (cdr lst)))))
(def (assoc item lst)
- (cond ((null? lst) #f)
- ((equal? (caar lst) item) (car lst))
- (#t (assoc item (cdr lst)))))
+ (cond ((equal? (caar lst) item) (car lst))
+ (lst (assoc item (cdr lst)))))
(def (assv item lst)
- (cond ((null? lst) #f)
- ((eqv? (caar lst) item) (car lst))
- (#t (assv item (cdr lst)))))
+ (cond ((eqv? (caar lst) item) (car lst))
+ (lst (assv item (cdr lst)))))
(def (> a . rest)
"Return #t if the arguments are in strictly decreasing order (previous
one is greater than the next one)."
(let loop ((a a) (rest rest))
- (or (null? rest)
+ (or (not rest)
(and (< (car rest) a)
(loop (car rest) (cdr rest))))))
(defmacro (> a . rest)
@@ -186,7 +182,7 @@
"Return #t if the arguments are in non-decreasing order (previous
one is less than or equal to the next one)."
(let loop ((a a) (rest rest))
- (or (null? rest)
+ (or (not rest)
(unless (or (< (car rest) a)
(nan? a))
(loop (car rest) (cdr rest))))))
@@ -195,7 +191,7 @@
"Return #t if the arguments are in non-increasing order (previous
one is greater than or equal to the next one)."
(let loop ((a a) (rest rest))
- (or (null? rest)
+ (or (not rest)
(unless (or (< a (car rest))
(nan? a))
(loop (car rest) (cdr rest))))))
@@ -225,10 +221,10 @@
(* (rand-double) n)))
(def (abs x) (if (< x 0) (- x) x))
(def (max x0 . xs)
- (if (null? xs) x0
+ (if (not xs) x0
(foldl (λ (a b) (if (< a b) b a)) x0 xs)))
(def (min x0 . xs)
- (if (null? xs) x0
+ (if (not xs) x0
(foldl (λ (a b) (if (< a b) a b)) x0 xs)))
(def (char? x) (eq? (typeof x) 'rune))
(def (array? x) (or (vector? x)
@@ -267,7 +263,7 @@
(let ((*values* (list '*values*)))
(set! values
(λ vs
- (if (and (cons? vs) (null? (cdr vs)))
+ (if (and (cons? vs) (not (cdr vs)))
(car vs)
(cons *values* vs))))
(set! call-with-values
@@ -289,7 +285,7 @@
(or (pred (car lst))
(any pred (cdr lst)))))
-(def (list? a) (or (null? a) (and (cons? a) (list? (cdr a)))))
+(def (list? a) (or (not a) (and (cons? a) (list? (cdr a)))))
(def (list-tail lst n)
(if (<= n 0) lst
@@ -307,7 +303,7 @@
"Bounded length test.
Use this instead of (= (length lst) n), since it avoids unnecessary
work and always terminates."
- (cond ((< n 0) #f)
+ (cond ((< n 0) nil)
((= n 0) (atom? lst))
((atom? lst) (= n 0))
(else (length= (cdr lst) (- n 1)))))
@@ -329,7 +325,7 @@
(cdr (last-pair l))))
(def (to-proper l)
- (cond ((null? l) l)
+ (cond ((not l) l)
((atom? l) (list l))
(else (cons (car l) (to-proper (cdr l))))))
@@ -365,7 +361,7 @@
(def (count f l)
(def (count- f l n)
- (if (null? l)
+ (if (not l)
n
(count- f (cdr l) (if (f (car l))
(+ n 1)
@@ -377,15 +373,15 @@
(cons zero (nestlist f (f zero) (- n 1)))))
(def (foldr f zero lst)
- (if (null? lst) zero
+ (if (not lst) zero
(f (car lst) (foldr f zero (cdr lst)))))
(def (foldl f zero lst)
- (if (null? lst) zero
+ (if (not lst) zero
(foldl f (f (car lst) zero) (cdr lst))))
(def (reverse- zero lst)
- (if (null? lst) zero
+ (if (not lst) zero
(reverse- (cons (car lst) zero) (cdr lst))))
(def (reverse lst) (reverse- () lst))
@@ -491,14 +487,14 @@
((not (any splice-form? x))
(let ((lc (lastcdr x))
(forms (map (λ (x) (bq-bracket1 x d)) x)))
- (if (null? lc)
+ (if (not lc)
(cons list forms)
- (if (null? (cdr forms))
+ (if (not (cdr forms))
(list cons (car forms) (bq-process lc d))
(nconc (cons list* forms) (list (bq-process lc d)))))))
(else
(let loop ((p x) (q ()))
- (cond ((null? p) ;; proper list
+ (cond ((not p) ;; proper list
(cons 'nconc (reverse! q)))
((cons? p)
(cond ((eq? (car p) 'unquote)
@@ -531,16 +527,16 @@
body))
,(cadar binds))))
-(defmacro (when c . body) (list 'if c (cons 'begin body) #f))
-(defmacro (unless c . body) (list 'if c #f (cons 'begin body)))
+(defmacro (when c . body) (list 'if c (cons 'begin body) nil))
+(defmacro (unless c . body) (list 'if c nil (cons 'begin body)))
(defmacro (case key . clauses)
(def (vals->cond key v)
(cond ((eq? v 'else) 'else)
- ((null? v) #f)
+ ((not v) nil)
((symbol? v) `(eq? ,key ,(quote-value v)))
((atom? v) `(eqv? ,key ,(quote-value v)))
- ((null? (cdr v)) `(eqv? ,key ,(quote-value (car v))))
+ ((not (cdr v)) `(eqv? ,key ,(quote-value (car v))))
((every symbol? v)
`(memq ,key ',v))
(else `(memv ,key ',v))))
@@ -663,7 +659,7 @@
(def (print . args) (for-each write args))
(def (princ . args)
- (with-bindings ((*print-readably* #f))
+ (with-bindings ((*print-readably* nil))
(for-each write args)))
(def (newline (port *output-stream*))
@@ -781,7 +777,7 @@
(iostream->string b)))
(def (string-join strlist sep)
- (if (null? strlist) ""
+ (if (not strlist) ""
(let ((b (buffer)))
(io-write b (car strlist))
(for-each (λ (s) (io-write b sep)
@@ -871,8 +867,8 @@
. ,name))))
(def (expand-define e env)
- (if (or (null? (cdr e)) (atom? (cadr e)))
- (if (null? (cddr e))
+ (if (or (not (cdr e)) (atom? (cadr e)))
+ (if (not (cddr e))
e
(let ((name (cadr e))
(doc (value-get-doc (cddr e))))
@@ -997,7 +993,7 @@
(for-each (λ (topfun)
(find-in-f topfun f ()))
e)
- #f))))
+ nil))))
(if p
(string-join (map string (reverse! p)) "/")
"λ")))
@@ -1062,7 +1058,7 @@
(princ *linefeed*))
(def (simple-sort l)
- (if (or (null? l) (null? (cdr l))) l
+ (if (or (not l) (not (cdr l))) l
(let ((piv (car l)))
(receive (less grtr)
(partition (λ (x) (< x piv)) (cdr l))
@@ -1078,7 +1074,7 @@
*print-pretty* *print-width* *print-readably*
*print-level* *print-length* *os-name* *interactive*
*prompt* *os-version* procedure? top-level-bound?)))
- (with-bindings ((*print-pretty* #f)
+ (with-bindings ((*print-pretty* nil)
(*print-readably* #t))
(let* ((syms
(filter (λ (s)
@@ -1127,9 +1123,9 @@
(def (__rcscript)
(let* ((homevar (case *os-name*
- (("unknown") #f)+ (("unknown") nil) (("plan9") "home")- (("macos") (princ "\x1b]0;femtolisp v0.999\007") #f)+ (("macos") (princ "\x1b]0;femtolisp v0.999\007") nil)(else "HOME")))
(home (and homevar (os-getenv homevar)))
(fname (and home (string home *directory-separator* ".flisprc"))))
@@ -1139,7 +1135,7 @@
(__init_globals)
(if (cons? (cdr argv))
(begin (set! *argv* (cdr argv))
- (set! *interactive* #f)
+ (set! *interactive* nil)
(__script (cadr argv)))
(begin (set! *argv* argv)
(set! *interactive* #t)
--- a/src/table.c
+++ b/src/table.c
@@ -78,7 +78,7 @@
BUILTIN("table?", tablep) {argcount(nargs, 1);
- return ishashtable(args[0]) ? FL_t : FL_f;
+ return ishashtable(args[0]) ? FL_t : FL_nil;
}
htable_t *
@@ -159,7 +159,7 @@
{argcount(nargs, 2);
htable_t *h = totable(args[0]);
- return equalhash_has(h, (void*)args[1]) ? FL_t : FL_f;
+ return equalhash_has(h, (void*)args[1]) ? FL_t : FL_nil;
}
// (del! table key)
--- a/src/vm.inc
+++ b/src/vm.inc
@@ -12,8 +12,8 @@
PUSH(vector_elt(v, *ip++));
NEXT_OP;
-OP(OP_BRF)
- ip += POP() != FL_f ? 2 : GET_INT16(ip);
+OP(OP_BRN)
+ ip += POP() == FL_nil ? GET_INT16(ip) : 2;
NEXT_OP;
OP(OP_POP)
@@ -232,7 +232,7 @@
NEXT_OP;
OP(OP_CONSP)
- FL(stack)[FL(sp)-1] = iscons(FL(stack)[FL(sp)-1]) ? FL_t : FL_f;
+ FL(stack)[FL(sp)-1] = iscons(FL(stack)[FL(sp)-1]) ? FL_t : FL_nil;
NEXT_OP;
OP(OP_BRNE)
@@ -296,13 +296,9 @@
NEXT_OP;
OP(OP_ATOMP)
- FL(stack)[FL(sp)-1] = iscons(FL(stack)[FL(sp)-1]) ? FL_f : FL_t;
+ FL(stack)[FL(sp)-1] = iscons(FL(stack)[FL(sp)-1]) ? FL_nil : FL_t;
NEXT_OP;
-OP(OP_BRT)
- ip += POP() != FL_f ? GET_INT16(ip) : 2;
- NEXT_OP;
-
OP(OP_BRNN)
ip += POP() != FL_nil ? GET_INT16(ip) : 2;
NEXT_OP;
@@ -322,7 +318,7 @@
b = FL(stack)[FL(sp)-i];
if(bothfixnums(a, b)){ if((fixnum_t)a >= (fixnum_t)b){- v = FL_f;
+ v = FL_nil;
break;
}
}else{@@ -330,7 +326,7 @@
if(x > 1)
x = numval(fl_compare(a, b, false));
if(x >= 0){- v = FL_f;
+ v = FL_nil;
break;
}
}
@@ -373,10 +369,6 @@
POPN(1);
NEXT_OP;
-OP(OP_LOADF)
- PUSH(FL_f);
- NEXT_OP;
-
OP(OP_CONS)
if(FL(curheap) > FL(lim))
fl_gc(0);
@@ -389,16 +381,17 @@
NEXT_OP;
OP(OP_EQ)
- FL(stack)[FL(sp)-2] = FL(stack)[FL(sp)-2] == FL(stack)[FL(sp)-1] ? FL_t : FL_f;
+ FL(stack)[FL(sp)-2] = FL(stack)[FL(sp)-2] == FL(stack)[FL(sp)-1] ? FL_t : FL_nil;
POPN(1);
NEXT_OP;
OP(OP_SYMBOLP)
- FL(stack)[FL(sp)-1] = issymbol(FL(stack)[FL(sp)-1]) ? FL_t : FL_f;
+ FL(stack)[FL(sp)-1] = issymbol(FL(stack)[FL(sp)-1]) ? FL_t : FL_nil;
NEXT_OP;
OP(OP_NOT)
- FL(stack)[FL(sp)-1] = FL(stack)[FL(sp)-1] == FL_f ? FL_t : FL_f;
+ v = FL(stack)[FL(sp)-1];
+ FL(stack)[FL(sp)-1] = v == FL_nil ? FL_t : FL_nil;
NEXT_OP;
OP(OP_CADR)
@@ -428,7 +421,7 @@
OP(OP_NANP)
{value_t q = FL(stack)[FL(sp)-1];
- v = FL_f;
+ v = FL_nil;
if(iscprim(q)){void *data = cp_data(ptr(q));
switch(cp_numtype(ptr(q))){@@ -448,33 +441,24 @@
}
NEXT_OP;
-OP(OP_NULLP)
- FL(stack)[FL(sp)-1] = FL(stack)[FL(sp)-1] == FL_nil ? FL_t : FL_f;
- NEXT_OP;
-
-OP(OP_BOOLEANP)
- v = FL(stack)[FL(sp)-1];
- FL(stack)[FL(sp)-1] = (v == FL_t || v == FL_f) ? FL_t : FL_f;
- NEXT_OP;
-
OP(OP_NUMBERP)
v = FL(stack)[FL(sp)-1];
- FL(stack)[FL(sp)-1] = fl_isnumber(v) ? FL_t : FL_f;
+ FL(stack)[FL(sp)-1] = fl_isnumber(v) ? FL_t : FL_nil;
NEXT_OP;
OP(OP_FIXNUMP)
- FL(stack)[FL(sp)-1] = isfixnum(FL(stack)[FL(sp)-1]) ? FL_t : FL_f;
+ FL(stack)[FL(sp)-1] = isfixnum(FL(stack)[FL(sp)-1]) ? FL_t : FL_nil;
NEXT_OP;
OP(OP_BOUNDP)
FL(stack)[ipd] = (uintptr_t)ip;
sym = tosymbol(FL(stack)[FL(sp)-1]);
- FL(stack)[FL(sp)-1] = sym->binding == UNBOUND ? FL_f : FL_t;
+ FL(stack)[FL(sp)-1] = sym->binding == UNBOUND ? FL_nil : FL_t;
NEXT_OP;
OP(OP_BUILTINP)
v = FL(stack)[FL(sp)-1];
- FL(stack)[FL(sp)-1] = (isbuiltin(v) || iscbuiltin(v)) ? FL_t : FL_f;
+ FL(stack)[FL(sp)-1] = (isbuiltin(v) || iscbuiltin(v)) ? FL_t : FL_nil;
NEXT_OP;
OP(OP_FUNCTIONP)
@@ -482,11 +466,11 @@
FL(stack)[FL(sp)-1] =
((tag(v) == TAG_FUNCTION &&
(isbuiltin(v) || v>(N_BUILTINS<<3))) ||
- iscbuiltin(v)) ? FL_t : FL_f;
+ iscbuiltin(v)) ? FL_t : FL_nil;
NEXT_OP;
OP(OP_VECTORP)
- FL(stack)[FL(sp)-1] = isvector(FL(stack)[FL(sp)-1]) ? FL_t : FL_f;
+ FL(stack)[FL(sp)-1] = isvector(FL(stack)[FL(sp)-1]) ? FL_t : FL_nil;
NEXT_OP;
OP(OP_JMPL)
@@ -493,14 +477,6 @@
ip += GET_INT32(ip);
NEXT_OP;
-OP(OP_BRFL)
- ip += POP() == FL_f ? GET_INT32(ip) : 4;
- NEXT_OP;
-
-OP(OP_BRTL)
- ip += POP() != FL_f ? GET_INT32(ip) : 4;
- NEXT_OP;
-
OP(OP_BRNEL)
ip += FL(stack)[FL(sp)-2] != FL(stack)[FL(sp)-1] ? GET_INT32(ip) : 4;
POPN(2);
@@ -510,10 +486,6 @@
ip += POP() != FL_nil ? GET_INT32(ip) : 4;
NEXT_OP;
-OP(OP_BRN)
- ip += POP() == FL_nil ? GET_INT16(ip) : 2;
- NEXT_OP;
-
OP(OP_BRNL)
ip += POP() == FL_nil ? GET_INT32(ip) : 4;
NEXT_OP;
@@ -522,9 +494,9 @@
if(FL(stack)[FL(sp)-2] == FL(stack)[FL(sp)-1])
v = FL_t;
else if(!leafp(FL(stack)[FL(sp)-2]) || !leafp(FL(stack)[FL(sp)-1]))
- v = FL_f;
+ v = FL_nil;
else
- v = fl_compare(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1], true) == 0 ? FL_t : FL_f;
+ v = fl_compare(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1], true) == 0 ? FL_t : FL_nil;//FL_nil
FL(stack)[FL(sp)-2] = v;
POPN(1);
NEXT_OP;
@@ -533,7 +505,7 @@
if(FL(stack)[FL(sp)-2] == FL(stack)[FL(sp)-1])
v = FL_t;
else
- v = fl_compare(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1], true) == 0 ? FL_t : FL_f;
+ v = fl_compare(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1], true) == 0 ? FL_t : FL_nil;//FL_nil
FL(stack)[FL(sp)-2] = v;
POPN(1);
NEXT_OP;
@@ -671,11 +643,11 @@
b = FL(stack)[FL(sp)-i];
if(bothfixnums(a, b)){ if(a != b){- v = FL_f;
+ v = FL_nil;
break;
}
}else if(numeric_compare(a, b, true, false, true) != 0){- v = FL_f;
+ v = FL_nil;
break;
}
}
@@ -920,7 +892,7 @@
i = GET_INT32(ip);
ip += 4;
v = FL(stack)[bp+i];
- PUSH(v != UNBOUND ? FL_t : FL_f);
+ PUSH(v != UNBOUND ? FL_t : FL_nil);
NEXT_OP;
OP(OP_KEYARGS)
--- a/test/ast/asttools.lsp
+++ b/test/ast/asttools.lsp
@@ -10,12 +10,12 @@
(cons item lst)))
(def (index-of item lst start)
- (cond ((null? lst) #f)
+ (cond ((not lst) nil)
((eq? item (car lst)) start)
(#t (index-of item (cdr lst) (+ start 1)))))
(def (each f l)
- (if (null? l) l
+ (if (not l) l
(begin (f (car l))
(each f (cdr l)))))
@@ -69,7 +69,7 @@
; convert to proper list, i.e. remove "dots", and append
(def (append.2 l tail)
- (cond ((null? l) tail)
+ (cond ((not l) tail)
((atom? l) (cons l tail))
(#t (cons (car l) (append.2 (cdr l) tail)))))
@@ -101,7 +101,7 @@
; name is just there for reference
; this assumes lambda is the only remaining naming form
(def (lookup-var v env lev)
- (if (null? env) v
+ (if (not env) v
(let ((i (index-of v (car env) 0)))
(if i (list 'lexref lev i v)
(lookup-var v (cdr env) (+ lev 1))))))
@@ -166,6 +166,6 @@
(let ((m (match ',pat expr)))
(if m
; matches; perform expansion
- (apply ,expander (map (lambda (var) (cdr (or (assq var m) '(0 . #f))))
+ (apply ,expander (map (lambda (var) (cdr (or (assq var m) '(0 . nil))))
',args))
- #f)))))
+ nil)))))
--- a/test/ast/match.lsp
+++ b/test/ast/match.lsp
@@ -3,7 +3,7 @@
; by Jeff Bezanson
(def (unique lst)
- (if (null? lst)
+ (if (not lst)
()
(cons (car lst)
(filter (lambda (x) (not (eq? x (car lst))))
@@ -14,7 +14,7 @@
; expression tree pattern matching
; matches expr against pattern p and returns an assoc list ((var . expr) (var . expr) ...)
-; mapping variables to captured subexpressions, or #f if no match.
+; mapping variables to captured subexpressions, or nil if no match.
; when a match succeeds, __ is always bound to the whole matched expression.
;
; p is an expression in the following pattern language:
@@ -57,7 +57,7 @@
(and (match- (caddr p) expr state)
(cons (cons (cadr p) expr) state)))
((eq? (car p) '-$) ; greedy alternation for toplevel pattern
- (match-alt (cdr p) () (list expr) state #f 1))
+ (match-alt (cdr p) () (list expr) state nil 1))
(#t
(and (cons? expr)
(equal? (car p) (car expr))
@@ -68,7 +68,8 @@
; match an alternation
(def (match-alt alt prest expr state var L)
- (if (null? alt) #f ; no alternatives left
+ (if (not alt)
+ nil ; no alternatives left
(let ((subma (match- (car alt) (car expr) state)))
(or (and subma
(match-seq prest (cdr expr)
@@ -82,7 +83,7 @@
; match generalized kleene star (try consuming min to max)
(def (match-star- p prest expr state var min max L sofar)
(cond ; case 0: impossible to match
- ((> min max) #f)
+ ((> min max) nil)
; case 1: only allowed to match 0 subexpressions
((= max 0) (match-seq prest expr
(if var (cons (cons var (reverse sofar)) state)
@@ -102,16 +103,16 @@
; match sequences of expressions
(def (match-seq p expr state L)
- (cond ((not state) #f)
- ((null? p) (if (null? expr) state #f))
+ (cond ((not state) nil)
+ ((not p) (if (not expr) state nil))
(#t
(let ((subp (car p))
- (var #f))
+ (var nil))
(if (and (cons? subp)
- (eq? (car subp) '--))
+ (eq? (car subp) '--))
(begin (set! var (cadr subp))
- (set! subp (caddr subp)))
- #f)
+ (set! subp (caddr subp)))
+ nil)
(let ((head (if (cons? subp) (car subp) ())))
(cond ((eq? subp '...)
(match-star '_ (cdr p) expr state var 0 L L))
@@ -149,7 +150,7 @@
; try to transform expr using a pattern-lambda from plist
; returns the new expression, or expr if no matches
(def (apply-patterns plist expr)
- (if (null? plist) expr
+ (if (not plist) expr
(if (procedure? plist)
(let ((enew (plist expr)))
(if (not enew)
--- a/test/color.lsp
+++ b/test/color.lsp
@@ -4,12 +4,12 @@
(def (dict-new) ())
(def (dict-extend dl key value)
- (cond ((null? dl) (list (cons key value)))
+ (cond ((not dl) (list (cons key value)))
((equal? key (caar dl)) (cons (cons key value) (cdr dl)))
(else (cons (car dl) (dict-extend (cdr dl) key value)))))
(def (dict-lookup dl key)
- (cond ((null? dl) ())
+ (cond ((not dl) nil)
((equal? key (caar dl)) (cdar dl))
(else (dict-lookup (cdr dl) key))))
@@ -33,11 +33,11 @@
(def (graph-add-node g n1) (dict-extend g n1 ()))
(def (graph-from-edges edge-list)
- (if (null? edge-list)
+ (if (not edge-list)
(graph-empty)
- (graph-connect (graph-from-edges (cdr edge-list))
- (caar edge-list)
- (cdar edge-list))))
+ (graph-connect (graph-from-edges (cdr edge-list))
+ (caar edge-list)
+ (cdar edge-list))))
; graph coloring --------------------------------------------------------------
(def (node-colorable? g coloring node-to-color color-of-node)
@@ -50,13 +50,13 @@
(graph-neighbors g node-to-color)))))
(def (try-each f lst)
- (if (null? lst) #f
+ (if (not lst) nil
(let ((ret (f (car lst))))
(if ret ret (try-each f (cdr lst))))))
(def (color-node g coloring colors uncolored-nodes color)
(cond
- ((null? uncolored-nodes) coloring)
+ ((not uncolored-nodes) coloring)
((node-colorable? g coloring (car uncolored-nodes) color)
(let ((new-coloring
(cons (cons (car uncolored-nodes) color) coloring)))
@@ -65,8 +65,8 @@
colors)))))
(def (color-graph g colors)
- (if (null? colors)
- (and (null? (graph-nodes g)) ())
+ (if (not colors)
+ (and (not (graph-nodes g)) nil)
(color-node g () colors (graph-nodes g) (car colors))))
(def (color-pairs pairs colors)
--- a/test/perf.lsp
+++ b/test/perf.lsp
@@ -16,10 +16,11 @@
(time (dotimes (n 5000) (expand '(dotimes (i 100) body1 body2))))
(def (my-append . lsts)
- (cond ((null? lsts) ())
- ((null? (cdr lsts)) (car lsts))
+ (cond ((not lsts) nil)
+ ((not (cdr lsts)) (car lsts))
(else (letrec ((append2 (λ (l d)
- (if (null? l) d
+ (if (not l)
+ d
(cons (car l)
(append2 (cdr l) d))))))
(append2 (car lsts) (apply my-append (cdr lsts)))))))
--- a/test/test.lsp
+++ b/test/test.lsp
@@ -9,7 +9,7 @@
;(def (reverse lst)
; ((label rev-help (λ (lst result)
-; (if (null? lst) result
+; (if (not lst) result
; (rev-help (cdr lst) (cons (car lst) result)))))
; lst ()))
@@ -16,10 +16,10 @@
(def (append- . lsts)
((label append-h
(λ (lsts)
- (cond ((null? lsts) ())
- ((null? (cdr lsts)) (car lsts))
+ (cond ((not lsts) ())
+ ((not (cdr lsts)) (car lsts))
(#t ((label append2 (λ (l d)
- (if (null? l) d
+ (if (not l) d
(cons (car l)
(append2 (cdr l) d)))))
(car lsts) (append-h (cdr lsts)))))))
@@ -77,7 +77,7 @@
(def (mapl f . lsts)
((label mapl-
(λ (lsts)
- (if (null? (car lsts)) ()
+ (if (not (car lsts)) ()
(begin (apply f lsts) (mapl- (map cdr lsts))))))
lsts))
@@ -251,7 +251,7 @@
(def (filt1 pred lst)
(def (filt1- pred lst accum)
- (if (null? lst) accum
+ (if (not lst) accum
(if (pred (car lst))
(filt1- pred (cdr lst) (cons (car lst) accum))
(filt1- pred (cdr lst) accum))))
@@ -265,7 +265,7 @@
; (pairwise? p a b c d) == (and (p a b) (p b c) (p c d))
(def (pairwise? pred . args)
- (or (null? args)
+ (or (not args)
(let f ((a (car args)) (d (cdr args)))
- (or (null? d)
+ (or (not d)
(and (pred a (car d)) (f (car d) (cdr d)))))))
--- a/test/torus.lsp
+++ b/test/torus.lsp
@@ -1,7 +1,8 @@
; -*- scheme -*-
(def (maplist f l)
- (if (null? l) ()
- (cons (f l) (maplist f (cdr l)))))
+ (if (not l)
+ nil
+ (cons (f l) (maplist f (cdr l)))))
; produce a beautiful, toroidal cons structure
; make m copies of a CDR-circular list of length n, and connect corresponding
--- a/test/unittest.lsp
+++ b/test/unittest.lsp
@@ -1,7 +1,7 @@
; -*- scheme -*-
(defmacro (assert-fail expr . what)
- `(assert (trycatch (begin ,expr #f)
- (λ (e) ,(if (null? what) #t
+ `(assert (trycatch (begin ,expr nil)
+ (λ (e) ,(if (not what) #t
`(eq? (car e) ',(car what)))))))
(def (every-int n)
@@ -197,15 +197,15 @@
; and, or
(assert (equal? #t (and)))
-(assert (equal? #f (or)))
-(assert (equal? 1 (and '() 'x 1)))
-(assert (equal? 1 (or #f #f #f #f #f 1 #f #f #f #f)))
-(assert (equal? 2 (if (and '() 'x 1) 2 0)))
-(assert (equal? 2 (if (or #f #f #f #f #f 1 #f #f #f #f) 2 0)))
-(assert (equal? #f (and '() 1 'x #f)))
-(assert (equal? #f (or #f #f #f #f #f #f #f #f #f #f)))
-(assert (equal? 0 (if (and '() 1 'x #f) 2 0)))
-(assert (equal? 0 (if (or #f #f #f #f #f #f #f #f #f #f) 2 0)))
+(assert (equal? nil (or)))
+(assert (equal? 1 (and '(1) 'x 1)))
+(assert (equal? 1 (or nil nil nil nil nil 1 nil nil nil nil)))
+(assert (equal? 2 (if (and '(1) 'x 1) 2 0)))
+(assert (equal? 2 (if (or nil nil nil nil nil 1 nil nil nil nil) 2 0)))
+(assert (equal? nil (and '(1) 1 'x nil)))
+(assert (equal? nil (or nil nil nil nil nil nil nil nil nil nil)))
+(assert (equal? 0 (if (and '(1) 1 'x nil) 2 0)))
+(assert (equal? 0 (if (or nil nil nil nil nil nil nil nil nil nil) 2 0)))
; failing applications
(assert-fail ((λ (x) x) 1 2))
@@ -380,7 +380,7 @@
(iostream->string b)))
(let ((c #\a))
- (assert (equal? (with-output-to-string #f (λ () (print (list c c))))
+ (assert (equal? (with-output-to-string nil (λ () (print (list c c))))
"(#\\a #\\a)")))
(assert-fail (eval '(set! (car (cons 1 2)) 3)))
@@ -407,16 +407,16 @@
(assert (equal? (bound? 'abc) #t))
(assert (equal? (eval '(+ abc 1)) 2))
(makunbound 'abc)
-(assert (equal? (bound? 'abc) #f))
+(assert (equal? (bound? 'abc) nil))
(assert-fail (eval '(+ abc 1)))
;; c***r of empty list
-(assert (null? (car '())))
-(assert (null? (cdr '())))
-(assert (null? (cadr '())))
-(assert (null? (cdar '())))
-(assert (null? (caaar '())))
-(assert (null? (cdddr '())))
+(assert (not (car '())))
+(assert (not (cdr '())))
+(assert (not (cadr '())))
+(assert (not (cdar '())))
+(assert (not (caaar '())))
+(assert (not (cdddr '())))
;; for-each with multiple lists
(def q '())
@@ -466,8 +466,8 @@
(for 1 100 (λ (i)
(table eq? 2 eqv? 2
equal? 2 atom? 1
- not 1 null? 1
- boolean? 1 symbol? 1
+ not 1 nan? 1
+ cons? 1 symbol? 1
number? 1 bound? 1
cons? 1 builtin? 1
vector? 1 fixnum? 1
--- a/tools/gen.lsp
+++ b/tools/gen.lsp
@@ -1,106 +1,99 @@
(def opcodes '(
; C opcode, lisp compiler opcode, arg count, builtin lambda, DOC (NEW)
- OP_LOADA0 loada0 #f 0 ()
- OP_LOADA1 loada1 #f 0 ()
- OP_LOADV loadv #f 0 ()
- OP_BRF brf #f 0 ()
- OP_POP pop #f 0 ()
- OP_CALL call #f 0 ()
- OP_TCALL tcall #f 0 ()
- OP_LOADG loadg #f 0 ()
- OP_LOADA loada #f 0 ()
- OP_LOADC loadc #f 0 ()
- OP_RET ret #f 0 ()
- OP_DUP dup #f 0 ()
+ OP_LOADA0 loada0 nil nil nil
+ OP_LOADA1 loada1 nil nil nil
+ OP_LOADV loadv nil nil nil
+ OP_BRN brn nil nil nil
+ OP_POP pop nil nil nil
+ OP_CALL call nil nil nil
+ OP_TCALL tcall nil nil nil
+ OP_LOADG loadg nil nil nil
+ OP_LOADA loada nil nil nil
+ OP_LOADC loadc nil nil nil
+ OP_RET ret nil nil nil
+ OP_DUP dup nil nil nil
OP_CAR car 1 (λ (x) (car x)) (
((lst) "Returns the first element of a list or nil if not available."))
OP_CDR cdr 1 (λ (x) (cdr x)) (
((lst) "Returns the tail of a list or nil if not available."))
- OP_CLOSURE closure #f 0 ()
- OP_SETA seta #f 0 ()
- OP_JMP jmp #f 0 ()
- OP_LOADC0 loadc0 #f 0 ()
+ OP_CLOSURE closure nil nil nil
+ OP_SETA seta nil nil nil
+ OP_JMP jmp nil nil nil
+ OP_LOADC0 loadc0 nil nil nil
OP_CONSP cons? 1 (λ (x) (cons? x)) (
((value) "Returns #t if the value is a cons cell."))
- OP_BRNE brne #f 0 ()
- OP_LOADT loadt #f 0 ()
- OP_LOAD0 load0 #f 0 ()
- OP_LOADC1 loadc1 #f 0 ()
- OP_AREF2 aref2 #f 0 ()
- OP_ATOMP atom? 1 (λ (x) (atom? x)) ()
- OP_BRT brt #f 0 ()
- OP_BRNN brnn #f 0 ()
- OP_LOAD1 load1 #f 0 ()
- OP_LT < -1 (λ rest (apply < rest)) ()
- OP_ADD2 add2 #f 0 ()
- OP_SETCDR set-cdr! 2 (λ (x y) (set-cdr! x y)) ()
- OP_LOADF loadf #f 0 ()
- OP_CONS cons 2 (λ (x y) (cons x y)) ()
- OP_EQ eq? 2 (λ (x y) (eq? x y)) ()
- OP_SYMBOLP symbol? 1 (λ (x) (symbol? x)) ()
- OP_NOT not 1 (λ (x) (not x)) ()
- OP_CADR cadr 1 (λ (x) (cadr x)) ()
- OP_NEG neg #f 0 ()
- OP_NULLP null? 1 (λ (x) (null? x)) ()
- OP_BOOLEANP boolean? 1 (λ (x) (boolean? x)) ()
- OP_NUMBERP number? 1 (λ (x) (number? x)) ()
- OP_FIXNUMP fixnum? 1 (λ (x) (fixnum? x)) ()
- OP_BOUNDP bound? 1 (λ (x) (bound? x)) ()
- OP_BUILTINP builtin? 1 (λ (x) (builtin? x)) ()
- OP_FUNCTIONP function? 1 (λ (x) (function? x)) ()
- OP_VECTORP vector? 1 (λ (x) (vector? x)) ()
- OP_SHIFT shift #f 0 ()
- OP_SETCAR set-car! 2 (λ (x y) (set-car! x y)) ()
- OP_JMPL jmp.l #f 0 ()
- OP_BRFL brf.l #f 0 ()
- OP_BRTL brt.l #f 0 ()
- OP_EQV eqv? 2 (λ (x y) (eqv? x y)) ()
- OP_EQUAL equal? 2 (λ (x y) (equal? x y)) ()
- OP_LIST list ANYARGS (λ rest rest) ()
- OP_APPLY apply -2 (λ rest (apply apply rest)) ()
+ OP_BRNE brne nil nil nil
+ OP_LOADT loadt nil nil nil
+ OP_LOAD0 load0 nil nil nil
+ OP_LOADC1 loadc1 nil nil nil
+ OP_AREF2 aref2 nil nil nil
+ OP_ATOMP atom? 1 (λ (x) (atom? x)) nil
+ OP_LOADVOID loadvoid nil nil nil
+ OP_BRNN brnn nil nil nil
+ OP_LOAD1 load1 nil nil nil
+ OP_LT < -1 (λ rest (apply < rest)) nil
+ OP_ADD2 add2 nil nil nil
+ OP_SETCDR set-cdr! 2 (λ (x y) (set-cdr! x y)) nil
+ OP_KEYARGS keyargs nil nil nil
+ OP_CONS cons 2 (λ (x y) (cons x y)) nil
+ OP_EQ eq? 2 (λ (x y) (eq? x y)) nil
+ OP_SYMBOLP symbol? 1 (λ (x) (symbol? x)) nil
+ OP_NOT not 1 (λ (x) (not x)) nil
+ OP_CADR cadr 1 (λ (x) (cadr x)) nil
+ OP_NEG neg nil nil nil
+ OP_NANP nan? 1 (λ (x) (nan? x)) nil
+ OP_BRBOUND brbound nil nil nil
+ OP_NUMBERP number? 1 (λ (x) (number? x)) nil
+ OP_FIXNUMP fixnum? 1 (λ (x) (fixnum? x)) nil
+ OP_BOUNDP bound? 1 (λ (x) (bound? x)) nil
+ OP_BUILTINP builtin? 1 (λ (x) (builtin? x)) nil
+ OP_FUNCTIONP function? 1 (λ (x) (function? x)) nil
+ OP_VECTORP vector? 1 (λ (x) (vector? x)) nil
+ OP_SHIFT shift nil nil nil
+ OP_SETCAR set-car! 2 (λ (x y) (set-car! x y)) nil
+ OP_JMPL jmp.l nil nil nil
+ OP_BRNL brn.l nil nil nil
+ OP_BOX box nil nil nil
+ OP_EQV eqv? 2 (λ (x y) (eqv? x y)) nil
+ OP_EQUAL equal? 2 (λ (x y) (equal? x y)) nil
+ OP_LIST list ANYARGS (λ rest rest) nil
+ OP_APPLY apply -2 (λ rest (apply apply rest)) nil
OP_ADD + ANYARGS (λ rest (apply + rest)) (
((number…) "Return sum of the numbers or 0 with no arguments."))
- OP_SUB - -1 (λ rest (apply - rest)) ()
+ OP_SUB - -1 (λ rest (apply - rest)) nil
OP_MUL * ANYARGS (λ rest (apply * rest)) (
((number…) "Return product of the numbers or 1 with no arguments."))
- OP_DIV / -1 (λ rest (apply / rest)) ()
- OP_IDIV div0 2 (λ rest (apply div0 rest)) ()
- OP_NUMEQ = -1 (λ rest (apply = rest)) ()
- OP_COMPARE compare 2 (λ (x y) (compare x y)) ()
- OP_ARGC argc #f 0 ()
- OP_VECTOR vector ANYARGS (λ rest (apply vector rest)) ()
- OP_ASET aset! -3 (λ rest (apply aset! rest)) ()
- OP_LOADNIL loadnil #f 0 ()
- OP_LOADI8 loadi8 #f 0 ()
- OP_LOADVL loadv.l #f 0 ()
- OP_LOADGL loadg.l #f 0 ()
- OP_LOADAL loada.l #f 0 ()
- OP_LOADCL loadc.l #f 0 ()
- OP_SETG setg #f 0 ()
- OP_SETGL setg.l #f 0 ()
- OP_SETAL seta.l #f 0 ()
- OP_VARGC vargc #f 0 ()
- OP_TRYCATCH trycatch #f 0 ()
- OP_FOR for 3 (λ (a b f) (for a b (λ (x) (f x)))) ()
- OP_TAPPLY tapply #f 0 ()
- OP_SUB2 sub2 #f 0 ()
- OP_LARGC largc #f 0 ()
- OP_LVARGC lvargc #f 0 ()
- OP_CALLL call.l #f 0 ()
- OP_TCALLL tcall.l #f 0 ()
- OP_BRNEL brne.l #f 0 ()
- OP_BRNNL brnn.l #f 0 ()
- OP_BRN brn #f 0 ()
- OP_BRNL brn.l #f 0 ()
- OP_OPTARGS optargs #f 0 ()
- OP_BRBOUND brbound #f 0 ()
- OP_KEYARGS keyargs #f 0 ()
- OP_BOX box #f 0 ()
- OP_BOXL box.l #f 0 ()
- OP_AREF aref -2 (λ rest (apply aref rest)) ()
- OP_LOADVOID loadvoid #f 0 ()
- OP_NANP nan? 1 (λ (x) (nan? x)) ()
- OP_EOF_OBJECT dummy_eof #f 0 ()
+ OP_DIV / -1 (λ rest (apply / rest)) nil
+ OP_IDIV div0 2 (λ rest (apply div0 rest)) nil
+ OP_NUMEQ = -1 (λ rest (apply = rest)) nil
+ OP_COMPARE compare 2 (λ (x y) (compare x y)) nil
+ OP_ARGC argc nil nil nil
+ OP_VECTOR vector ANYARGS (λ rest (apply vector rest)) nil
+ OP_ASET aset! -3 (λ rest (apply aset! rest)) nil
+ OP_LOADNIL loadnil nil nil nil
+ OP_LOADI8 loadi8 nil nil nil
+ OP_LOADVL loadv.l nil nil nil
+ OP_LOADGL loadg.l nil nil nil
+ OP_LOADAL loada.l nil nil nil
+ OP_LOADCL loadc.l nil nil nil
+ OP_SETG setg nil nil nil
+ OP_SETGL setg.l nil nil nil
+ OP_SETAL seta.l nil nil nil
+ OP_VARGC vargc nil nil nil
+ OP_TRYCATCH trycatch nil nil nil
+ OP_FOR for 3 (λ (a b f) (for a b (λ (x) (f x)))) nil
+ OP_TAPPLY tapply nil nil nil
+ OP_SUB2 sub2 nil nil nil
+ OP_LARGC largc nil nil nil
+ OP_LVARGC lvargc nil nil nil
+ OP_CALLL call.l nil nil nil
+ OP_TCALLL tcall.l nil nil nil
+ OP_BRNEL brne.l nil nil nil
+ OP_BRNNL brnn.l nil nil nil
+ OP_AREF aref -2 (λ rest (apply aref rest)) nil
+ OP_BOXL box.l nil nil nil
+ OP_OPTARGS optargs nil nil nil
+ OP_EOF_OBJECT dummy_eof nil nil nil
))
(def (for-each-n f lst n)