ref: 5ab7fa99a02447d122675182ecebb8335fd82ceb
parent: 4d79d1ed7c483fc45687e94ffc5c6568d78e916c
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Sat Feb 8 02:21:24 EST 2025
#t: replace with just t (or T) Fixes: https://todo.sr.ht/~ft/femtolisp/22
--- a/README.md
+++ b/README.md
@@ -24,6 +24,7 @@
* `[` and `]`, `{` and `}` are synonyms to `(` and `)`* `define` → `def`, `define-macro` → `defmacro`
* `λ` as a shorthand for `lambda`
+ * `t`/`T` instead of `#t`/`#T` and `nil` instead of `#f`
* docstrings - `(def (f ...) "Docs here" ...)` and `(help ...)`
* automatic gensyms for macros (`blah#`) at read time
* proper `(void)` and `void?`
--- a/boot/flisp.boot
+++ b/boot/flisp.boot
@@ -1,1 +1,1 @@
-(*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
+(*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>, NIL otherwise." length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates." car "Return 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 "Return 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? "Return 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." *properties* "All properties\ No newline at end of file
binary files a/boot/flisp.boot.builtin b/boot/flisp.boot.builtin differ
--- a/src/compiler.lsp
+++ b/src/compiler.lsp
@@ -1,5 +1,3 @@
-; -*- scheme -*-
-
;; code generation state, constant tables, bytecode encoding
(def (make-code-emitter) (vector () (table) 0 () 0))
@@ -265,9 +263,9 @@
(else (if (cons? (cdddr x))
(cadddr x)
nil)))
- (cond ((eq? test #t)
+ (cond ((eq? test t)
(compile-in g env tail? then))
- ((eq? test nil)
+ ((not test)
(compile-in g env tail? else))
(else
(compile-in g env nil test elsel)
@@ -336,7 +334,7 @@
(unless outl (mark-label g end))))))
(def (compile-and g env tail? forms outl)
- (compile-short-circuit g env tail? forms #t 'brn 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 nil 'brnn nil))
@@ -482,12 +480,12 @@
(def (fits-i8 x) (and (fixnum? x) (>= 127 x -128)))
(def (compile-in g env tail? x (outl nil))
- (cond ((symbol? x) (compile-sym g env x #t))
+ (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 nil) (emit g 'loadnil))
+ ((eq? x t) (emit g 'loadt))
+ ((not x) (emit g 'loadnil))
((void? x) (emit g 'loadvoid))
((fits-i8 x) (emit g 'loadi8 x))
(else (emit g 'loadv x))))
@@ -514,7 +512,7 @@
(and (compile-and g env tail? (cdr x) outl))
(or (compile-or g env tail? (cdr x)))
(while (compile-while g env (cadr x) (cons 'begin (cddr x))))
- (return (compile-in g env #t (cadr x))
+ (return (compile-in g env t (cadr x))
(emit g 'ret))
(set! (let* ((name (cadr x))
(value (cddr x))
@@ -545,7 +543,7 @@
(def (lambda-vars l)
(def (check-formals l o opt kw)
- (cond ((or (not 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 "
@@ -557,11 +555,11 @@
(error "compile error: invalid optional argument " (car l)
" in list " o))
(if (keyword? (caar l))
- (check-formals (cdr l) o opt #t)
+ (check-formals (cdr l) o opt t)
(if kw
(error "compile error: invalid argument list "
o ": keyword arguments must come last.")
- (check-formals (cdr l) o #t kw))))
+ (check-formals (cdr l) o t kw))))
((cons? l)
(error "compile error: invalid formal argument " (car l)
" in list " o))
@@ -656,12 +654,12 @@
(cond ((not vars) nil)
((symbol? e)
(if (and nested (memq e vars))
- (put! capt e #t)))
+ (put! capt e t)))
((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))))
+ (begin (put! setd (cadr e) t)
+ (if nested (put! capt (cadr e) t))))
(complex-bindings- (caddr e) vars nil nested capt setd))
((is-lambda? (car e))
(complex-bindings- (lambda:body e)
@@ -739,7 +737,7 @@
;; set initial stack pointer
(aset! g 4 (+ (length vars) 4))
;; compile body and return
- (compile-in g newenv #t (lambda:body f))
+ (compile-in g newenv t (lambda:body f))
(emit g 'ret)
(values (function (encode-byte-code (bcode:code g))
(const-to-idx-vec g) name)
--- a/src/docs_extra.lsp
+++ b/src/docs_extra.lsp
@@ -10,10 +10,10 @@
`(symbol-set-doc ',sym ',doc ',funvars)))
(doc-for (= a . rest)
- "Return #t if the arguments are equal.")
+ "Return T if the arguments are equal.")
(doc-for (nan? x)
- "Return #t if the argument is NaN, regardless of the sign.")
+ "Return T if the argument is NaN, regardless of the sign.")
(doc-for (vm-stats)
"Print various VM-related information, such as the number of GC calls
--- 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_booleansym, FL_nullsym, FL_evalsym, FL_fnsym;
+value_t 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;
@@ -1368,8 +1368,6 @@
FL_spacesym = csymbol("space"); FL_deletesym = csymbol("delete"); FL_newlinesym = csymbol("newline");- FL_tsym = csymbol("t");- FL_Tsym = csymbol("T"); FL_builtins_table_sym = csymbol("*builtins*"); set(FL_printprettysym = csymbol("*print-pretty*"), FL_t);--- a/src/flisp.h
+++ b/src/flisp.h
@@ -434,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_booleansym, FL_nullsym, FL_evalsym, FL_fnsym;
+extern value_t 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/print.c
+++ b/src/print.c
@@ -418,9 +418,9 @@
break;
case TAG_FUNCTION:
if(v == FL_t)
- outsn(f, "#t", 2);
+ outc(f, 'T');
else if(v == FL_nil)
- outsn(f, "nil", 3);
+ outsn(f, "NIL", 3);
else if(v == FL_eof)
outsn(f, "#<eof>", 6);
else if(v == FL_void){--- a/src/read.c
+++ b/src/read.c
@@ -363,17 +363,26 @@
return ctx->toktype;
ios_getc(RS);
}else{- if(!read_token(ctx, c, 0)){- if(ctx->buf[0] == '.' && ctx->buf[1] == '\0')
+ bool ok = read_token(ctx, c, 0);
+ const char *s = ctx->buf;
+ if(!ok){+ if(s[0] == '.' && s[1] == '\0')
return (ctx->toktype = TOK_DOT);
- if(fl_read_numtok(ctx->buf, &ctx->tokval, 0))
+ if(fl_read_numtok(s, &ctx->tokval, 0))
return (ctx->toktype = TOK_NUM);
}
ctx->toktype = TOK_SYM;
- const char *name = (strcmp(ctx->buf, "lambda") == 0 || strcmp(ctx->buf, "λ") == 0) ? "λ" : ctx->buf;
- ctx->tokval = strcasecmp(name, "nil") == 0 ? FL_nil : symbol(name, name == ctx->buf);
- if(name[strlen(name)-1] == '#')
- ctx->toktype = TOK_GENSYM;
+ if(strcasecmp(s, "nil") == 0)
+ ctx->tokval = FL_nil;
+ else if(s[1] == 0 && (s[0] == 't' || s[0] == 'T'))
+ ctx->tokval = FL_t;
+ else if(strcmp(s, "λ") == 0 || strcmp(s, "lambda") == 0)
+ ctx->tokval = FL_lambda;
+ else{+ ctx->tokval = symbol(s, true);
+ if(s[strlen(s)-1] == '#')
+ ctx->toktype = TOK_GENSYM;
+ }
}
return ctx->toktype;
}
@@ -645,8 +654,6 @@
return do_read_sexpr(ctx, label);
case TOK_SHARPSYM:
sym = ctx->tokval;
- if(sym == FL_tsym || sym == FL_Tsym)
- return FL_t;
// constructor notation
c = nextchar();
ctx->loc = RS->loc;
--- a/src/system.lsp
+++ b/src/system.lsp
@@ -1,4 +1,3 @@
-; -*- scheme -*-
; femtoLisp standard library
; by Jeff Bezanson (C) 2009
; Distributed under the BSD License
@@ -8,13 +7,13 @@
(def (void . rest)
"Return the constant #<void> while ignoring any arguments.
#<void> is mainly used when a function has side effects but does not
-produce any meaningful value to return, so even though #t or nil could
+produce any meaningful value to return, so even though T or NIL could
be returned instead, in case of #<void> alone, REPL will not print
it."
#.(void))
(def (void? x)
- "Return #t if x is #<void> and nil otherwise."
+ "Return T if x is #<void>, NIL otherwise."
(eq? x #.(void)))
;;; syntax environment
@@ -62,7 +61,7 @@
nil
(let ((clause (car lst)))
(if (or (eq? (car clause) 'else)
- (eq? (car clause) #t))
+ (eq? (car clause) t))
(if (not (cdr clause))
(car clause)
(cons 'begin (cdr clause)))
@@ -104,9 +103,9 @@
(def (putprop sym key val)
(let ((kt (get *properties* key nil)))
(unless kt
- (let ((t (table)))
- (put! *properties* key t)
- (set! kt t)))
+ (let ((ta (table)))
+ (put! *properties* key ta)
+ (set! kt ta)))
(put! kt sym val)
val))
@@ -169,7 +168,7 @@
(lst (assv item (cdr lst)))))
(def (> a . rest)
- "Return #t if the arguments are in strictly decreasing order (previous
+ "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 (not rest)
@@ -179,7 +178,7 @@
`(< ,@(reverse! rest) ,a))
(def (<= a . rest)
- "Return #t if the arguments are in non-decreasing order (previous
+ "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 (not rest)
@@ -188,7 +187,7 @@
(loop (car rest) (cdr rest))))))
(def (>= a . rest)
- "Return #t if the arguments are in non-increasing order (previous
+ "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 (not rest)
@@ -197,7 +196,7 @@
(loop (car rest) (cdr rest))))))
(defmacro (/= a . rest)
- "Return #t if not all arguments are equal. Shorthand for (not (= …))."
+ "Return T if not all arguments are equal. Shorthand for (not (= …))."
`(not (= ,a ,@rest)))
(def (negative? x) (< x 0))
@@ -228,8 +227,8 @@
(foldl (λ (a b) (if (< a b) a b)) x0 xs)))
(def (char? x) (eq? (typeof x) 'rune))
(def (array? x) (or (vector? x)
- (let ((t (typeof x)))
- (and (cons? t) (eq? (car t) 'array)))))
+ (let ((tx (typeof x)))
+ (and (cons? tx) (eq? (car tx) 'array)))))
(def (closure? x) (and (function? x) (not (builtin? x))))
(def (caar x) (car (car x)))
@@ -402,14 +401,14 @@
(def (delete-duplicates lst)
(if (length> lst 20)
- (let ((t (table)))
+ (let ((ta (table)))
(let loop ((l lst) (acc '()))
(if (atom? l)
(reverse! acc)
- (if (has? t (car l))
+ (if (has? ta (car l))
(loop (cdr l) acc)
(begin
- (put! t (car l) #t)
+ (put! ta (car l) t)
(loop (cdr l) (cons (car l) acc)))))))
(if (atom? lst)
lst
@@ -620,7 +619,7 @@
;;; debugging utilities
-(defmacro (assert expr) `(if ,expr #t (raise '(assert-failed ,expr))))
+(defmacro (assert expr) `(if ,expr t (raise '(assert-failed ,expr))))
(def traced?
(letrec ((sample-traced-lambda (λ args (begin (write (cons 'x args))
@@ -712,24 +711,24 @@
;;; table functions
-(def (table-pairs t)
+(def (table-pairs ta)
(table-foldl (λ (k v z) (cons (cons k v) z))
- () t))
-(def (table-keys t)
+ nil ta))
+(def (table-keys ta)
(table-foldl (λ (k v z) (cons k z))
- () t))
-(def (table-values t)
+ nil ta))
+(def (table-values ta)
(table-foldl (λ (k v z) (cons v z))
- () t))
-(def (table-clone t)
+ nil ta))
+(def (table-clone ta)
(let ((nt (table)))
(table-foldl (λ (k v z) (put! nt k v))
- () t)
+ nil ta)
nt))
-(def (table-invert t)
+(def (table-invert ta)
(let ((nt (table)))
(table-foldl (λ (k v z) (put! nt v k))
- () t)
+ nil ta)
nt))
;;; string functions
@@ -968,7 +967,7 @@
(when (trycatch (prompt)
(λ (e)
(top-level-exception-handler e)
- #t))
+ t))
(reploop)))
(reploop)
(newline))
@@ -1075,7 +1074,7 @@
*print-level* *print-length* *os-name* *interactive*
*prompt* *os-version* procedure? top-level-bound?)))
(with-bindings ((*print-pretty* nil)
- (*print-readably* #t))
+ (*print-readably* t))
(let* ((syms
(filter (λ (s)
(and (bound? s)
@@ -1138,7 +1137,7 @@
(set! *interactive* nil)
(__script (cadr argv)))
(begin (set! *argv* argv)
- (set! *interactive* #t)
+ (set! *interactive* t)
(__rcscript)
(repl)))
(exit 0))
--- a/test/ast/asttools.lsp
+++ b/test/ast/asttools.lsp
@@ -12,7 +12,7 @@
(def (index-of item lst start)
(cond ((not lst) nil)
((eq? item (car lst)) start)
- (#t (index-of item (cdr lst) (+ start 1)))))
+ (else (index-of item (cdr lst) (+ start 1)))))
(def (each f l)
(if (not l) l
@@ -31,15 +31,15 @@
(let ((new-t (map (lambda (e) (maptree-post f e)) tr)))
(f new-t))))
-(def (foldtree-pre f t zero)
- (if (not (cons? t))
- (f t zero)
- (foldl t (lambda (e state) (foldtree-pre f e state)) (f t zero))))
+(def (foldtree-pre f tr zero)
+ (if (not (cons? tr))
+ (f tr zero)
+ (foldl tr (lambda (e state) (foldtree-pre f e state)) (f tr zero))))
-(def (foldtree-post f t zero)
- (if (not (cons? t))
- (f t zero)
- (f t (foldl t (lambda (e state) (foldtree-post f e state)) zero))))
+(def (foldtree-post f tr zero)
+ (if (not (cons? tr))
+ (f tr zero)
+ (f tr (foldl tr (lambda (e state) (foldtree-post f e state)) zero))))
; general tree transformer
; folds in preorder (foldtree-pre), maps in postorder (maptree-post)
@@ -48,39 +48,39 @@
; approach.
; (mapper tree state) - should return transformed tree given current state
; (folder tree state) - should return new state
-(def (map&fold t zero mapper folder)
- (let ((head (and (cons? t) (car t))))
- (cond ((eq? head 'quote)
- t)
+(def (map&fold tr zero mapper folder)
+ (let ((head (and (cons? tr) (car tr))))
+ (cond
+ ((eq? head 'quote) tr)
((or (eq? head 'the) (eq? head 'meta))
(list head
- (cadr t)
- (map&fold (caddr t) zero mapper folder)))
+ (cadr tr)
+ (map&fold (caddr tr) zero mapper folder)))
(else
- (let ((new-s (folder t zero)))
+ (let ((new-s (folder tr zero)))
(mapper
- (if (cons? t)
+ (if (cons? tr)
; head symbol is a tag; never transform it
- (cons (car t)
+ (cons (car tr)
(map (lambda (e) (map&fold e new-s mapper folder))
- (cdr t)))
- t)
+ (cdr tr)))
+ tr)
new-s))))))
; convert to proper list, i.e. remove "dots", and append
(def (append.2 l tail)
- (cond ((not l) tail)
+ (cond ((not l) tail)
((atom? l) (cons l tail))
- (#t (cons (car l) (append.2 (cdr l) tail)))))
+ (else (cons (car l) (append.2 (cdr l) tail)))))
; transform code by calling (f expr env) on each subexpr, where
; env is a list of lexical variables in effect at that point.
-(def (lexical-walk f t)
- (map&fold t () f
+(def (lexical-walk f tr)
+ (map&fold tr () f
(lambda (tree state)
- (if (and (eq? (car t) 'lambda)
- (cons? (cdr t)))
- (append.2 (cadr t) state)
+ (if (and (eq? (car tr) 'lambda)
+ (cons? (cdr tr)))
+ (append.2 (cadr tr) state)
state))))
; collapse forms like (&& (&& (&& (&& a b) c) d) e) to (&& a b c d e)
@@ -118,7 +118,7 @@
(map (lambda (se) (lvc- se newenv))
(cddr e))))
(map (lambda (se) (lvc- se env)) e)))))
- (#t e)))
+ (else e)))
(def (lexical-var-conversion e)
(lvc- e ()))
@@ -137,19 +137,19 @@
(map&fold e
()
; mapper: replace symbol if unbound
- (lambda (t env)
- (if (symbol? t)
- (let ((found (assq t transl)))
+ (lambda (te env)
+ (if (symbol? te)
+ (let ((found (assq te transl)))
(if (and found
- (not (memq t env)))
+ (not (memq te env)))
(cdr found)
- t))
- t))
+ te))
+ te))
; folder: add locals to environment if entering a new scope
- (lambda (t env)
- (if (and (cons? t) (or (eq? (car t) 'let)
- (eq? (car t) 'lambda)))
- (append (cadr t) env)
+ (lambda (te env)
+ (if (and (cons? te) (or (eq? (car te) 'let)
+ (eq? (car te) 'lambda)))
+ (append (cadr te) env)
env))))
; flatten op with any associativity
--- a/test/ast/match.lsp
+++ b/test/ast/match.lsp
@@ -4,7 +4,7 @@
(def (unique lst)
(if (not lst)
- ()
+ nil
(cons (car lst)
(filter (lambda (x) (not (eq? x (car lst))))
(unique (cdr lst))))))
@@ -20,7 +20,7 @@
; p is an expression in the following pattern language:
;
; _ match anything, not captured
-; <func> any scheme function; matches if (func expr) returns #t
+; <func> any scheme function; matches if (func expr) returns T
; <var> match anything and capture as <var>. future occurrences of <var> in the pattern
; must match the same thing.
; (head <p1> <p2> etc) match an s-expr with 'head' matched literally, and the rest of the
@@ -41,7 +41,7 @@
(def (match- p expr state)
(cond ((symbol? p)
(cond ((eq? p '_) state)
- (#t
+ (else
(let ((capt (assq p state)))
(if capt
(and (equal? expr (cdr capt)) state)
@@ -57,13 +57,13 @@
(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 nil 1))
- (#t
+ (match-alt (cdr p) nil (list expr) state nil 1))
+ (else
(and (cons? expr)
(equal? (car p) (car expr))
(match-seq (cdr p) (cdr expr) state (length (cdr expr)))))))
- (#t
+ (else
(and (equal? p expr) state))))
; match an alternation
@@ -95,17 +95,17 @@
(match-star- p prest (cdr expr) state var (- min 1) (- max 1) (- L 1)
(cons (car expr) sofar))))
; otherwise, must match either 0 or between 1 and max subexpressions
- (#t
+ (else
(or (match-star- p prest expr state var 0 0 L sofar)
(match-star- p prest expr state var 1 max L sofar)))))
(def (match-star p prest expr state var min max L)
- (match-star- p prest expr state var min max L ()))
+ (match-star- p prest expr state var min max L nil))
; match sequences of expressions
(def (match-seq p expr state L)
(cond ((not state) nil)
((not p) (if (not expr) state nil))
- (#t
+ (else
(let ((subp (car p))
(var nil))
(if (and (cons? subp)
@@ -113,7 +113,7 @@
(begin (set! var (cadr subp))
(set! subp (caddr subp)))
nil)
- (let ((head (if (cons? subp) (car subp) ())))
+ (let ((head (if (cons? subp) (car subp) nil)))
(cond ((eq? subp '...)
(match-star '_ (cdr p) expr state var 0 L L))
((eq? head '-*)
@@ -124,7 +124,7 @@
(match-star (cadr subp) (cdr p) expr state var 0 1 L))
((eq? head '-$)
(match-alt (cdr subp) (cdr p) expr state var L))
- (#t
+ (else
(and (cons? expr)
(match-seq (cdr p) (cdr expr)
(match- (car p) (car expr) state)
@@ -140,10 +140,10 @@
((cons? p)
(if (eq? (car p) '-/)
- ()
+ nil
(unique (apply append (map patargs- (cdr p))))))
- (#t ())))
+ (else nil)))
(def (patargs p)
(cons '__ (patargs- p)))
--- a/test/ast/rpasses.lsp
+++ b/test/ast/rpasses.lsp
@@ -14,7 +14,7 @@
(def (func-argnames f)
(let ((argl (cadr f)))
- (if (eq? argl '*r-null*) ()
+ (if (eq? argl '*r-null*) nil
(map cadr argl))))
; transformations
@@ -49,7 +49,7 @@
(<<- (r-call f lhs ...) rhs))
(let ((g (if (cons? rhs) (r-gensym) rhs))
(op (car __)))
- `(r-block ,@(if (cons? rhs) `((ref= ,g ,rhs)) ())
+ `(r-block ,@(if (cons? rhs) `((ref= ,g ,rhs)) nil)
(,op ,lhs (r-call ,(symconcat f '<-) ,@(cddr (cadr __)) ,g))
,g)))
e))
@@ -80,14 +80,14 @@
e))
(def (find-assigned-vars n)
- (let ((vars ()))
+ (let ((vars nil))
(maptree-pre (lambda (s)
(if (not (cons? s)) s
- (cond ((eq? (car s) 'lambda) ())
+ (cond ((eq? (car s) 'lambda) nil)
((eq? (car s) '<-)
(set! vars (list-adjoin (cadr s) vars))
(cddr s))
- (#t s))))
+ (else s))))
n)
vars))
@@ -96,7 +96,7 @@
(maptree-post (lambda (n)
(if (and (cons? n) (eq? (car n) 'lambda))
(let ((vars (find-assigned-vars (cddr n))))
- `(lambda ,(cadr n) (let ,(map (lambda (v) (list v ()))
+ `(lambda ,(cadr n) (let ,(map (lambda (v) (list v nil))
vars)
,@(cddr n))))
n))
--- a/test/hashtest.lsp
+++ b/test/hashtest.lsp
@@ -1,5 +1,3 @@
-; -*- scheme -*-
-
(def (hins1)
(let ((h (table)))
(dotimes (n 200000)
@@ -16,25 +14,3 @@
(time (dotimes (i 100000) (table :a 1 :b 2 :c 3 :d 4)))
(time (dotimes (i 100000) (table :a 1 :b 2)))
(time (dotimes (i 100000) (table)))
-
-#t
-
-#|
-
-with HT_N_INLINE==16
-Elapsed time: 0.0796329975128174 seconds
-Elapsed time: 0.0455679893493652 seconds
-Elapsed time: 0.0272290706634521 seconds
-Elapsed time: 0.0177979469299316 seconds
-Elapsed time: 0.0102229118347168 seconds
-
-
-with HT_N_INLINE==8
-
-Elapsed time: 0.1010119915008545 seconds
-Elapsed time: 0.174872875213623 seconds
-Elapsed time: 0.0322129726409912 seconds
-Elapsed time: 0.0195930004119873 seconds
-Elapsed time: 0.008836030960083 seconds
-
-|#
--- a/test/test.lsp
+++ b/test/test.lsp
@@ -1,5 +1,3 @@
-; -*- scheme -*-
-
; make label self-evaluating, but evaluating the lambda in the process
;(defmacro labl (name f)
; (list list ''labl (list 'quote name) f))
@@ -18,10 +16,10 @@
(λ (lsts)
(cond ((not lsts) ())
((not (cdr lsts)) (car lsts))
- (#t ((label append2 (λ (l d)
- (if (not l) d
- (cons (car l)
- (append2 (cdr l) d)))))
+ (t ((label append2 (λ (l d)
+ (if (not l) d
+ (cons (car l)
+ (append2 (cdr l) d)))))
(car lsts) (append-h (cdr lsts)))))))
lsts))
--- a/test/tme.lsp
+++ b/test/tme.lsp
@@ -1,3 +1,3 @@
-(let ((t (table)))
+(let ((ta (table)))
(time (dotimes (i 2000000)
- (put! t (rand) (rand)))))
+ (put! ta (rand) (rand)))))
--- a/test/unittest.lsp
+++ b/test/unittest.lsp
@@ -1,7 +1,7 @@
; -*- scheme -*-
(defmacro (assert-fail expr . what)
`(assert (trycatch (begin ,expr nil)
- (λ (e) ,(if (not what) #t
+ (λ (e) ,(if (not what) t
`(eq? (car e) ',(car what)))))))
(def (every-int n)
@@ -196,7 +196,7 @@
(for 1 10 (λ (i) 0))
; and, or
-(assert (equal? #t (and)))
+(assert (equal? t (and)))
(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)))
@@ -404,7 +404,7 @@
;; unbinding
(def abc 1)
-(assert (equal? (bound? 'abc) #t))
+(assert (equal? (bound? 'abc) t))
(assert (equal? (eval '(+ abc 1)) 2))
(makunbound 'abc)
(assert (equal? (bound? 'abc) nil))
@@ -514,7 +514,7 @@
(def s "привет\0пока")
(assert (equal? s (string-encode (string-decode s))))
-(assert (equal? (string s "\0") (string-encode (string-decode s #t))))
+(assert (equal? (string s "\0") (string-encode (string-decode s t))))
(assert (eq? 21 (sizeof s)))
(assert (eq? 21 (length s)))
@@ -716,24 +716,24 @@
(assert (= (length (table "hello" "goodbye" 123 456)) 2))
(assert-fail (table 1))
(assert-fail (table 1 2 3))
-(def t (table 1 2 "3" 4 'foo 'bar))
+(def ta (table 1 2 "3" 4 'foo 'bar))
(let ((b (buffer)))
- (write t b)
+ (write ta b)
(assert (equal? (iostream->string b) "#table(1 2 \"3\" 4 foo bar)")))
-(assert (table? t))
+(assert (table? ta))
(assert (not (table? "nope")))
-(assert-fail (get t 3))
-(assert-fail (get t "foo"))
-(assert-fail (get t 1+))
-(assert (= 2 (get t 1)))
-(assert (= 4 (get t "3")))
+(assert-fail (get ta 3))
+(assert-fail (get ta "foo"))
+(assert-fail (get ta 1+))
+(assert (= 2 (get ta 1)))
+(assert (= 4 (get ta "3")))
-(assert (has? t 'foo))
-(assert (eq? 'bar (get t 'foo)))
-(assert (eq? t (del! t 'foo)))
-(assert (not (has? t 'foo)))
-(assert-fail (get t 'foo))
-(assert-fail (del! t 'foo))
+(assert (has? ta 'foo))
+(assert (eq? 'bar (get ta 'foo)))
+(assert (eq? ta (del! ta 'foo)))
+(assert (not (has? ta 'foo)))
+(assert-fail (get ta 'foo))
+(assert-fail (del! ta 'foo))
(assert-fail (get "blah" 0))
(assert-fail (get (list 0 1) 0))
--- a/tools/gen.lsp
+++ b/tools/gen.lsp
@@ -13,15 +13,15 @@
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."))
+ ((lst) "Return 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."))
+ ((lst) "Return the tail of a list or NIL if not available."))
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."))
+ ((value) "Return T if the value is a cons cell."))
OP_BRNE brne nil nil nil
OP_LOADT loadt nil nil nil
OP_LOAD0 load0 nil nil nil