From 17d81eb4e67c178a93e7fcb3c55e81b05029820a Mon Sep 17 00:00:00 2001
From: JeffBezanson <jeff.bezanson@gmail.com>
Date: Sun, 1 Feb 2009 01:53:58 +0000
Subject: [PATCH] adding #b, #o, #d, #x numeric literals accepting r6rs IEEE
 literals +-nan.0 and +-inf.0 printing distinguished -0.0, indicating float
 with .0f instead of #float, double with .0 instead of #double

more renaming (? on predicates, ! on mutating operators)
changing T to #t :( all those #s are so ugly
---
 femtolisp/ast/asttools.lsp     |  42 +++---
 femtolisp/ast/match.lsp        | 113 ++++++++--------
 femtolisp/ast/rpasses.lsp      |  24 ++--
 femtolisp/{ => attic}/dict.lsp |   0
 femtolisp/color.lsp            |  30 ++---
 femtolisp/cps.lsp              |  64 ++++-----
 femtolisp/cvalues.c            |   2 +-
 femtolisp/flisp.c              |  10 +-
 femtolisp/print.c              |  14 +-
 femtolisp/read.c               |  92 ++++++++-----
 femtolisp/system.lsp           | 230 ++++++++++++++++-----------------
 femtolisp/table.c              |  18 +--
 femtolisp/test.lsp             |  40 +++---
 femtolisp/torus.lsp            |   2 +-
 femtolisp/unittest.lsp         |   8 +-
 15 files changed, 356 insertions(+), 333 deletions(-)
 rename femtolisp/{ => attic}/dict.lsp (100%)

diff --git a/femtolisp/ast/asttools.lsp b/femtolisp/ast/asttools.lsp
index 3e73a54..83aace2 100644
--- a/femtolisp/ast/asttools.lsp
+++ b/femtolisp/ast/asttools.lsp
@@ -10,23 +10,23 @@
     (cons item lst)))
 
 (define (index-of item lst start)
-  (cond ((null lst) #f)
+  (cond ((null? lst) #f)
 	((eq item (car lst)) start)
-	(T (index-of item (cdr lst) (+ start 1)))))
+	(#t (index-of item (cdr lst) (+ start 1)))))
 
 (define (each f l)
-  (if (null l) l
+  (if (null? l) l
     (begin (f (car l))
            (each f (cdr l)))))
 
 (define (maptree-pre f tr)
   (let ((new-t (f tr)))
-    (if (consp new-t)
+    (if (pair? new-t)
         (map (lambda (e) (maptree-pre f e)) new-t)
       new-t)))
 
 (define (maptree-post f tr)
-  (if (not (consp tr))
+  (if (not (pair? tr))
       (f tr)
     (let ((new-t (map (lambda (e) (maptree-post f e)) tr)))
       (f new-t))))
@@ -70,10 +70,10 @@
 ; collapse forms like (&& (&& (&& (&& a b) c) d) e) to (&& a b c d e)
 (define (flatten-left-op op e)
   (maptree-post (lambda (node)
-                  (if (and (consp node)
+                  (if (and (pair? node)
                            (eq (car node) op)
-                           (consp (cdr node))
-                           (consp (cadr node))
+                           (pair? (cdr node))
+                           (pair? (cadr node))
                            (eq (caadr node) op))
                       (cons op
                             (append (cdadr node) (cddr node)))
@@ -85,31 +85,31 @@
 ; name is just there for reference
 ; this assumes lambda is the only remaining naming form
 (define (lookup-var v env lev)
-  (if (null env) v
+  (if (null? env) v
     (let ((i (index-of v (car env) 0)))
       (if i (list 'lexref lev i v)
         (lookup-var v (cdr env) (+ lev 1))))))
 (define (lvc- e env)
-  (cond ((symbolp e) (lookup-var e env 0))
-        ((consp e)
+  (cond ((symbol? e) (lookup-var e env 0))
+        ((pair? e)
          (if (eq (car e) 'quote)
              e
-           (let* ((newvs (and (eq (car e) 'lambda) (cadr e)))
-                  (newenv (if newvs (cons newvs env) env)))
-             (if newvs
-                 (cons 'lambda
-                       (cons (cadr e)
-                             (map (lambda (se) (lvc- se newenv))
-                                  (cddr e))))
-               (map (lambda (se) (lvc- se env)) e)))))
-        (T e)))
+	     (let* ((newvs (and (eq (car e) 'lambda) (cadr e)))
+		    (newenv (if newvs (cons newvs env) env)))
+	       (if newvs
+		   (cons 'lambda
+			 (cons (cadr e)
+			       (map (lambda (se) (lvc- se newenv))
+				    (cddr e))))
+		   (map (lambda (se) (lvc- se env)) e)))))
+        (#t e)))
 (define (lexical-var-conversion e)
   (lvc- e ()))
 
 ; convert let to lambda
 (define (let-expand e)
   (maptree-post (lambda (n)
-		  (if (and (consp n) (eq (car n) 'let))
+		  (if (and (pair? n) (eq (car n) 'let))
 		      `((lambda ,(map car (cadr n)) ,@(cddr n))
 			,@(map cadr (cadr n)))
                     n))
diff --git a/femtolisp/ast/match.lsp b/femtolisp/ast/match.lsp
index 8091905..c242ccd 100644
--- a/femtolisp/ast/match.lsp
+++ b/femtolisp/ast/match.lsp
@@ -3,11 +3,11 @@
 ; by Jeff Bezanson
 
 (define (unique lst)
-  (if (null lst)
+  (if (null? lst)
       ()
-    (cons (car lst)
-          (filter (lambda (x) (not (eq x (car lst))))
-                  (unique (cdr lst))))))
+      (cons (car lst)
+	    (filter (lambda (x) (not (eq x (car lst))))
+		    (unique (cdr lst))))))
 
 ; list of special pattern symbols that cannot be variable names
 (define metasymbols '(_ ...))
@@ -39,18 +39,18 @@
 ; This is NP-complete. Be careful.
 ;
 (define (match- p expr state)
-  (cond ((symbolp p)
+  (cond ((symbol? p)
 	 (cond ((eq p '_) state)
-	       (T
+	       (#t
 		(let ((capt (assq p state)))
 		  (if capt
 		      (and (equal expr (cdr capt)) state)
-                    (cons (cons p expr) state))))))
+		      (cons (cons p expr) state))))))
 	
-	((function? p)
+	((procedure? p)
 	 (and (p expr) state))
 	
-	((consp p)
+	((pair? p)
 	 (cond ((eq (car p) '-/)  (and (equal (cadr p) expr)             state))
 	       ((eq (car p) '-^)  (and (not (match- (cadr p) expr state)) state))
 	       ((eq (car p) '--)
@@ -58,43 +58,43 @@
 		     (cons (cons (cadr p) expr) state)))
 	       ((eq (car p) '-$)  ; greedy alternation for toplevel pattern
 		(match-alt (cdr p) () (list expr) state #f 1))
-	       (T
-		(and (consp expr)
+	       (#t
+		(and (pair? expr)
 		     (equal (car p) (car expr))
 		     (match-seq (cdr p) (cdr expr) state (length (cdr expr)))))))
 	
-	(T
+	(#t
 	 (and (equal p expr) state))))
 
 ; match an alternation
 (define (match-alt alt prest expr state var L)
-  (if (null alt) #f  ; no alternatives left
-    (let ((subma (match- (car alt) (car expr) state)))
-      (or (and subma
-               (match-seq prest (cdr expr)
-                          (if var
-                              (cons (cons var (car expr))
-                                    subma)
-                            subma)
-                          (- L 1)))
-          (match-alt (cdr alt) prest expr state var L)))))
+  (if (null? alt) #f  ; no alternatives left
+      (let ((subma (match- (car alt) (car expr) state)))
+	(or (and subma
+		 (match-seq prest (cdr expr)
+			    (if var
+				(cons (cons var (car expr))
+				      subma)
+				subma)
+			    (- L 1)))
+	    (match-alt (cdr alt) prest expr state var L)))))
 
 ; match generalized kleene star (try consuming min to max)
 (define (match-star- p prest expr state var min max L sofar)
   (cond ; case 0: impossible to match
    ((> min max) #f)
-    ; case 1: only allowed to match 0 subexpressions
+   ; case 1: only allowed to match 0 subexpressions
    ((= max 0) (match-seq prest expr
                          (if var (cons (cons var (reverse sofar)) state)
-                           state)
+			     state)
                          L))
-    ; case 2: must match at least 1
+   ; case 2: must match at least 1
    ((> min 0)
     (and (match- p (car expr) state)
          (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
+   ; otherwise, must match either 0 or between 1 and max subexpressions
+   (#t
     (or (match-star- p prest expr state var 0 0   L sofar)
         (match-star- p prest expr state var 1 max L sofar)))))
 (define (match-star p prest expr state var min max L) 
@@ -103,16 +103,16 @@
 ; match sequences of expressions
 (define (match-seq p expr state L)
   (cond ((not state) #f)
-	((null p) (if (null expr) state #f))
-	(T
+	((null? p) (if (null? expr) state #f))
+	(#t
 	 (let ((subp (car p))
 	       (var  #f))
-	   (if (and (consp subp)
+	   (if (and (pair? subp)
 		    (eq (car subp) '--))
 	       (begin (set! var (cadr subp))
                       (set! subp (caddr subp)))
-             #f)
-	   (let ((head (if (consp subp) (car subp) ())))
+	       #f)
+	   (let ((head (if (pair? subp) (car subp) ())))
 	     (cond ((eq subp '...)
 		    (match-star '_ (cdr p) expr state var 0 L L))
 		   ((eq head '-*)
@@ -123,8 +123,8 @@
 		    (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
-		    (and (consp expr)
+		   (#t
+		    (and (pair? expr)
 			 (match-seq (cdr p) (cdr expr)
 				    (match- (car p) (car expr) state)
 				    (- L 1))))))))))
@@ -133,32 +133,32 @@
 
 ; given a pattern p, return the list of capturing variables it uses
 (define (patargs- p)
-  (cond ((and (symbolp p)
+  (cond ((and (symbol? p)
               (not (member p metasymbols)))
          (list p))
         
-        ((consp p)
+        ((pair? p)
          (if (eq (car p) '-/)
              ()
-           (unique (apply append (map patargs- (cdr p))))))
+	     (unique (apply append (map patargs- (cdr p))))))
         
-        (T ())))
+        (#t ())))
 (define (patargs p)
   (cons '__ (patargs- p)))
 
 ; try to transform expr using a pattern-lambda from plist
 ; returns the new expression, or expr if no matches
 (define (apply-patterns plist expr)
-  (if (null plist) expr
-    (if (function? plist)
-        (let ((enew (plist expr)))
-          (if (not enew)
-              expr
-            enew))
-      (let ((enew ((car plist) expr)))
-        (if (not enew)
-            (apply-patterns (cdr plist) expr)
-          enew)))))
+  (if (null? plist) expr
+      (if (procedure? plist)
+	  (let ((enew (plist expr)))
+	    (if (not enew)
+		expr
+		enew))
+	  (let ((enew ((car plist) expr)))
+	    (if (not enew)
+		(apply-patterns (cdr plist) expr)
+		enew)))))
 
 ; top-down fixed-point macroexpansion. this is a typical algorithm,
 ; but it may leave some structure that matches a pattern unexpanded.
@@ -170,13 +170,12 @@
 ; (pattern-lambda (/ 2 3) '(/ 3 2)), (pattern-lambda (/ 3 2) '(/ 2 3))
 ; TODO: ignore quoted expressions
 (define (pattern-expand plist expr)
-  (if (not (consp expr))
+  (if (not (pair? expr))
       expr
-    (let ((enew (apply-patterns plist expr)))
-      (if (eq enew expr)
-	  ; expr didn't change; move to subexpressions
-          (cons (car expr)
-                (map (lambda (subex) (pattern-expand plist subex)) (cdr expr)))
-	  ; expr changed; iterate
-
-        (pattern-expand plist enew)))))
+      (let ((enew (apply-patterns plist expr)))
+	(if (eq enew expr)
+            ; expr didn't change; move to subexpressions
+	    (cons (car expr)
+		  (map (lambda (subex) (pattern-expand plist subex)) (cdr expr)))
+	    ; expr changed; iterate
+	    (pattern-expand plist enew)))))
diff --git a/femtolisp/ast/rpasses.lsp b/femtolisp/ast/rpasses.lsp
index ae46993..2f1dbb4 100644
--- a/femtolisp/ast/rpasses.lsp
+++ b/femtolisp/ast/rpasses.lsp
@@ -7,9 +7,9 @@
 ; tree inspection utils
 
 (define (assigned-var e)
-  (and (consp e)
+  (and (pair? e)
        (or (eq (car e) '<-) (eq (car e) 'ref=))
-       (symbolp (cadr e))
+       (symbol? (cadr e))
        (cadr e)))
 
 (define (func-argnames f)
@@ -26,13 +26,13 @@
 (define (dollarsign-transform e)
   (pattern-expand
    (pattern-lambda ($ lhs name)
-		   (let* ((g (if (not (consp lhs)) lhs (r-gensym)))
-			  (n (if (symbolp name)
+		   (let* ((g (if (not (pair? lhs)) lhs (r-gensym)))
+			  (n (if (symbol? name)
 				 name ;(symbol->string name)
                                name))
 			  (expr `(r-call
 				  r-aref ,g (index-in-strlist ,n (r-call attr ,g "names")))))
-		     (if (not (consp lhs))
+		     (if (not (pair? lhs))
 			 expr
                        `(r-block (ref= ,g ,lhs) ,expr))))
    e))
@@ -46,9 +46,9 @@
   (pattern-expand
    (pattern-lambda (-$ (<-  (r-call f lhs ...) rhs)
                        (<<- (r-call f lhs ...) rhs))
-		   (let ((g  (if (consp rhs) (r-gensym) rhs))
+		   (let ((g  (if (pair? rhs) (r-gensym) rhs))
                          (op (car __)))
-		     `(r-block ,@(if (consp rhs) `((ref= ,g ,rhs)) ())
+		     `(r-block ,@(if (pair? rhs) `((ref= ,g ,rhs)) ())
                                (,op ,lhs (r-call ,(symconcat f '<-) ,@(cddr (cadr __)) ,g))
                                ,g)))
    e))
@@ -68,10 +68,10 @@
 ; convert r function expressions to lambda
 (define (normalize-r-functions e)
   (maptree-post (lambda (n)
-		  (if (and (consp n) (eq (car n) 'function))
+		  (if (and (pair? n) (eq (car n) 'function))
 		      `(lambda ,(func-argnames n)
 			 (r-block ,@(gen-default-inits (cadr n))
-				  ,@(if (and (consp (caddr n))
+				  ,@(if (and (pair? (caddr n))
 					     (eq (car (caddr n)) 'r-block))
 					(cdr (caddr n))
                                       (list (caddr n)))))
@@ -81,19 +81,19 @@
 (define (find-assigned-vars n)
   (let ((vars ()))
     (maptree-pre (lambda (s)
-		   (if (not (consp s)) s
+		   (if (not (pair? s)) s
                      (cond ((eq (car s) 'lambda) ())
                            ((eq (car s) '<-)
                             (set! vars (list-adjoin (cadr s) vars))
                             (cddr s))
-                           (T s))))
+                           (#t s))))
 		 n)
     vars))
 
 ; introduce let based on assignment statements
 (define (letbind-locals e)
   (maptree-post (lambda (n)
-                  (if (and (consp n) (eq (car n) 'lambda))
+                  (if (and (pair? n) (eq (car n) 'lambda))
                       (let ((vars (find-assigned-vars (cddr n))))
                         `(lambda ,(cadr n) (let ,(map (lambda (v) (list v ()))
                                                       vars)
diff --git a/femtolisp/dict.lsp b/femtolisp/attic/dict.lsp
similarity index 100%
rename from femtolisp/dict.lsp
rename to femtolisp/attic/dict.lsp
diff --git a/femtolisp/color.lsp b/femtolisp/color.lsp
index f1b9a50..0d79728 100644
--- a/femtolisp/color.lsp
+++ b/femtolisp/color.lsp
@@ -1,23 +1,17 @@
 ; -*- scheme -*-
-; uncomment for compatibility with CL
-;(defun mapp (f l) (mapcar f l))
-;(defmacro define (name &rest body)
-;  (if (symbolp name)
-;      (list 'setq name (car body))
-;    (list 'defun (car name) (cdr name) (cons 'progn body))))
 
 ; dictionaries ----------------------------------------------------------------
 (define (dict-new) ())
 
 (define (dict-extend dl key value)
-  (cond ((null dl)              (list (cons key value)))
-        ((equal key (caar dl))  (cons (cons key value) (cdr dl)))
-        (T (cons (car dl) (dict-extend (cdr dl) key value)))))
+  (cond ((null? 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)))))
 
 (define (dict-lookup dl key)
-  (cond ((null dl)              ())
-        ((equal key (caar dl))  (cdar dl))
-        (T (dict-lookup (cdr dl) key))))
+  (cond ((null? dl)              ())
+        ((equal? key (caar dl))  (cdar dl))
+        (else (dict-lookup (cdr dl) key))))
 
 (define (dict-keys dl) (map car dl))
 
@@ -39,7 +33,7 @@
 (define (graph-add-node g n1) (dict-extend g n1 ()))
 
 (define (graph-from-edges edge-list)
-  (if (null edge-list)
+  (if (null? edge-list)
       (graph-empty)
     (graph-connect (graph-from-edges (cdr edge-list))
                    (caar edge-list)
@@ -52,17 +46,17 @@
         (map
          (lambda (n)
            (let ((color-pair (assq n coloring)))
-             (if (consp color-pair) (cdr color-pair) ())))
+             (if (pair? color-pair) (cdr color-pair) ())))
          (graph-neighbors g node-to-color)))))
 
 (define (try-each f lst)
-  (if (null lst) #f
+  (if (null? lst) #f
       (let ((ret (f (car lst))))
 	(if ret ret (try-each f (cdr lst))))))
 
 (define (color-node g coloring colors uncolored-nodes color)
   (cond
-   ((null uncolored-nodes) coloring)
+   ((null? uncolored-nodes) coloring)
    ((node-colorable? g coloring (car uncolored-nodes) color)
     (let ((new-coloring
            (cons (cons (car uncolored-nodes) color) coloring)))
@@ -71,8 +65,8 @@
                 colors)))))
 
 (define (color-graph g colors)
-  (if (null colors)
-      (and (null (graph-nodes g)) ())
+  (if (null? colors)
+      (and (null? (graph-nodes g)) ())
       (color-node g () colors (graph-nodes g) (car colors))))
 
 (define (color-pairs pairs colors)
diff --git a/femtolisp/cps.lsp b/femtolisp/cps.lsp
index fb015e2..cd0873d 100644
--- a/femtolisp/cps.lsp
+++ b/femtolisp/cps.lsp
@@ -2,7 +2,7 @@
 (define (cond->if form)
   (cond-clauses->if (cdr form)))
 (define (cond-clauses->if lst)
-  (if (atom lst)
+  (if (atom? lst)
       lst
     (let ((clause (car lst)))
       `(if ,(car clause)
@@ -10,11 +10,11 @@
          ,(cond-clauses->if (cdr lst))))))
 
 (define (begin->cps forms k)
-  (cond ((atom forms)       `(,k ,forms))
-        ((null (cdr forms)) (cps- (car forms) k))
-        (T (let ((_ (gensym)))   ; var to bind ignored value
-             (cps- (car forms) `(lambda (,_)
-                                  ,(begin->cps (cdr forms) k)))))))
+  (cond ((atom? forms)       `(,k ,forms))
+        ((null? (cdr forms))  (cps- (car forms) k))
+        (#t (let ((_ (gensym)))   ; var to bind ignored value
+	      (cps- (car forms) `(lambda (,_)
+				   ,(begin->cps (cdr forms) k)))))))
 
 (define-macro (lambda/cc args body)
   `(rplaca (lambda ,args ,body) 'lambda/cc))
@@ -44,7 +44,7 @@
 
 (define (rest->cps xformer form k argsyms)
   (let ((el (car form)))
-    (if (or (atom el) (constant? el))
+    (if (or (atom? el) (constant? el))
         (xformer (cdr form) k (cons el argsyms))
       (let ((g (gensym)))
         (cps- el `(lambda (,g)
@@ -58,17 +58,17 @@
 
 ; (f x) => (cps- f `(lambda (F) ,(cps- x `(lambda (X) (F ,k X)))))
 (define (app->cps form k argsyms)
-  (cond ((atom form)
+  (cond ((atom? form)
          (let ((r (reverse argsyms)))
            (make-funcall/cc (car r) k (cdr r))))
-        (T (rest->cps app->cps form k argsyms))))
+        (#t (rest->cps app->cps form k argsyms))))
 
 ; (+ x) => (cps- x `(lambda (X) (,k (+ X))))
 (define (builtincall->cps form k)
   (prim->cps (cdr form) k (list (car form))))
 (define (prim->cps form k argsyms)
-  (cond ((atom form) `(,k ,(reverse argsyms)))
-        (T           (rest->cps prim->cps form k argsyms))))
+  (cond ((atom? form) `(,k ,(reverse argsyms)))
+        (#t           (rest->cps prim->cps form k argsyms))))
 
 (define *top-k* (gensym))
 (set *top-k* identity)
@@ -80,7 +80,7 @@
      (cps- (macroexpand form) *top-k*)))))
 (define (cps- form k)
   (let ((g (gensym)))
-    (cond ((or (atom form) (constant? form))
+    (cond ((or (atom? form) (constant? form))
            `(,k ,form))
 
           ((eq (car form) 'lambda)
@@ -96,7 +96,7 @@
            (let ((test (cadr form))
                  (then (caddr form))
                  (else (cadddr form)))
-             (if (atom k)
+             (if (atom? k)
                  (cps- test `(lambda (,g)
                                (if ,g
                                    ,(cps- then k)
@@ -105,9 +105,9 @@
                   ,(cps- form g)))))
 
           ((eq (car form) 'and)
-           (cond ((atom (cdr  form)) `(,k T))
-                 ((atom (cddr form)) (cps- (cadr form) k))
-                 (T
+           (cond ((atom? (cdr  form)) `(,k #t))
+                 ((atom? (cddr form)) (cps- (cadr form) k))
+                 (#t
                   (if (atom k)
                       (cps- (cadr form)
                             `(lambda (,g)
@@ -117,10 +117,10 @@
                        ,(cps- form g))))))
 
           ((eq (car form) 'or)
-           (cond ((atom (cdr  form)) `(,k #f))
-                 ((atom (cddr form)) (cps- (cadr form) k))
-                 (T
-                  (if (atom k)
+           (cond ((atom? (cdr  form)) `(,k #f))
+                 ((atom? (cddr form)) (cps- (cadr form) k))
+                 (#t
+                  (if (atom? k)
                       (cps- (cadr form)
                             `(lambda (,g)
                                (if ,g (,k ,g)
@@ -168,23 +168,23 @@
                 (eq (caar form) 'lambda))
            (let ((largs (cadr (car form)))
                  (lbody (caddr (car form))))
-             (cond ((null largs)    ; ((lambda () body))
+             (cond ((null? largs)   ; ((lambda () body))
                     (cps- lbody k))
-                   ((symbolp largs) ; ((lambda x body) args...)
+                   ((symbol? largs) ; ((lambda x body) args...)
                     (cps- `((lambda (,largs) ,lbody) (list ,@(cdr form))) k))
-                   (T
+                   (#t
                     (cps- (cadr form) `(lambda (,(car largs))
                                          ,(cps- `((lambda ,(cdr largs) ,lbody)
                                                   ,@(cddr form))
                                                 k)))))))
 
-          (T
+          (#t
            (app->cps form k ())))))
 
 ; (lambda (args...) (f args...)) => f
 ; but only for constant, builtin f
 (define (η-reduce form)
-  (cond ((or (atom form) (constant? form)) form)
+  (cond ((or (atom? form) (constant? form)) form)
         ((and (eq (car form) 'lambda)
               (let ((body (caddr form))
                     (args (cadr form)))
@@ -192,16 +192,16 @@
                      (equal (cdr body) args)
                      (constant? (car (caddr form))))))
          (car (caddr form)))
-        (T (map η-reduce form))))
+        (#t (map η-reduce form))))
 
 (define (contains x form)
   (or (eq form x)
       (any (lambda (p) (contains x p)) form)))
 
 (define (β-reduce form)
-  (if (or (atom form) (constant? form))
+  (if (or (atom? form) (constant? form))
       form
-    (β-reduce- (map β-reduce form))))
+      (β-reduce- (map β-reduce form))))
 
 (define (β-reduce- form)
         ; ((lambda (f) (f arg)) X) => (X arg)
@@ -215,7 +215,7 @@
                      (= (length args) 1)
                      (eq (car body) (car args))
                      (not (eq (cadr body) (car args)))
-                     (symbolp (cadr body)))))
+                     (symbol? (cadr body)))))
          `(,(cadr form)
            ,(cadr (caddr (car form)))))
 
@@ -230,7 +230,7 @@
         ((and (= (length form) 2)
               (pair? (car form))
               (eq (caar form) 'lambda)
-              (or (atom (cadr form)) (constant? (cadr form)))
+              (or (atom? (cadr form)) (constant? (cadr form)))
               (let ((args (cadr (car form)))
                     (s (cadr form))
                     (body (caddr (car form))))
@@ -247,7 +247,7 @@
                               ,s
                               ,@params)))))))
 
-        (T form)))
+        (#t form)))
 
 (define-macro (with-delimited-continuations . code)
   (cps (f-body code)))
@@ -287,7 +287,7 @@
           (cons 'a (reset (cons 'b (shift f (cons 1 (f (f (cons 'c ())))))))))
          '(a 1 b b c)))
 
-T
+#t
 
 #|
 todo:
diff --git a/femtolisp/cvalues.c b/femtolisp/cvalues.c
index 803383c..1100853 100644
--- a/femtolisp/cvalues.c
+++ b/femtolisp/cvalues.c
@@ -791,7 +791,7 @@ static value_t cvalue_array_aset(value_t *args)
 {
     char *data; ulong_t index;
     fltype_t *eltype = cv_class((cvalue_t*)ptr(args[0]))->eltype;
-    check_addr_args("aset", args[0], args[1], &data, &index);
+    check_addr_args("aset!", args[0], args[1], &data, &index);
     char *dest = data + index*eltype->size;
     cvalue_init(eltype, args[2], dest);
     return args[2];
diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c
index 23902d0..34bf6ee 100644
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -60,7 +60,7 @@ static char *builtin_names[] =
       "cons", "list", "car", "cdr", "set-car!", "set-cdr!",
       "eval", "eval*", "apply", "prog1", "raise",
       "+", "-", "*", "/", "<", "~", "&", "!", "$",
-      "vector", "aref", "aset", "length", "assq", "compare", "for",
+      "vector", "aref", "aset!", "length", "assq", "compare", "for",
       "", "", "" };
 
 #define N_STACK 98304
@@ -1004,19 +1004,19 @@ static value_t eval_sexpr(value_t e, uint32_t penv, int tail)
             }
             break;
         case F_ASET:
-            argcount("aset", nargs, 3);
+            argcount("aset!", nargs, 3);
             e = Stack[SP-3];
             if (isvector(e)) {
-                i = tofixnum(Stack[SP-2], "aset");
+                i = tofixnum(Stack[SP-2], "aset!");
                 if (__unlikely((unsigned)i >= vector_size(e)))
-                    bounds_error("aref", v, Stack[SP-1]);
+                    bounds_error("aset!", v, Stack[SP-1]);
                 vector_elt(e, i) = (v=Stack[SP-1]);
             }
             else if (isarray(e)) {
                 v = cvalue_array_aset(&Stack[SP-3]);
             }
             else {
-                type_error("aset", "sequence", e);
+                type_error("aset!", "sequence", e);
             }
             break;
         case F_ATOM:
diff --git a/femtolisp/print.c b/femtolisp/print.c
index acdd455..5f036b3 100644
--- a/femtolisp/print.c
+++ b/femtolisp/print.c
@@ -520,14 +520,22 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
             else
                 HPOS+=ios_printf(f, "%s", rep);
         }
+        else if (d == 0) {
+            if (1/d < 0)
+                HPOS+=ios_printf(f, "-0.0%s", type==floatsym?"f":"");
+            else
+                HPOS+=ios_printf(f, "0.0%s",  type==floatsym?"f":"");
+        }
         else {
             snprint_real(buf, sizeof(buf), d, 0, ndec, 3, 10);
-            if (weak || princ || strpbrk(buf, ".eE")) {
-                outs(buf, f);
+            int hasdec = (strpbrk(buf, ".eE") != NULL);
+            outs(buf, f);
+            if (weak || princ || hasdec) {
                 if (type == floatsym) outc('f', f);
             }
             else {
-                HPOS+=ios_printf(f, "#%s(%s)", symbol_name(type), buf);
+                if (!hasdec) outs(".0", f);
+                if (type==floatsym) outc('f', f);
             }
         }
     }
diff --git a/femtolisp/read.c b/femtolisp/read.c
index 6c06c3c..55730cc 100644
--- a/femtolisp/read.c
+++ b/femtolisp/read.c
@@ -16,7 +16,16 @@ static int symchar(char c)
     return (!isspace(c) && !strchr(special, c));
 }
 
-static int isnumtok(char *tok, value_t *pval)
+static int isdigit_base(char c, int base)
+{
+    if (base < 11)
+        return (c >= '0' && c < '0'+base);
+    return ((c >= '0' && c <= '9') ||
+            (c >= 'a' && c < 'a'+base-10) ||
+            (c >= 'A' && c < 'A'+base-10));
+}
+
+static int isnumtok_base(char *tok, value_t *pval, int base)
 {
     char *end;
     int64_t i64;
@@ -24,50 +33,63 @@ static int isnumtok(char *tok, value_t *pval)
     double d;
     if (*tok == '\0')
         return 0;
-    if (!(tok[0]=='0' && isdigit(tok[1])) &&
-        strpbrk(tok, ".eEpP")) {
+    if (strpbrk(tok, ".eEpP")) {
         d = strtod(tok, &end);
         if (*end == '\0') {
             if (pval) *pval = mk_double(d);
             return 1;
         }
-        if (end > tok && end[0] == 'f' && end[1] == '\0') {
+        // floats can end in f or f0
+        if (end > tok && end[0] == 'f' &&
+            (end[1] == '\0' ||
+             (end[1] == '0' && end[2] == '\0'))) {
             if (pval) *pval = mk_float((float)d);
             return 1;
         }
     }
 
     if (tok[0] == '+') {
-        if (!strcmp(tok,"+NaN")) {
+        if (!strcmp(tok,"+NaN") || !strcasecmp(tok,"+nan.0")) {
             if (pval) *pval = mk_double(D_PNAN);
             return 1;
         }
-        if (!strcmp(tok,"+Inf")) {
+        if (!strcmp(tok,"+Inf") || !strcasecmp(tok,"+inf.0")) {
             if (pval) *pval = mk_double(D_PINF);
             return 1;
         }
     }
     else if (tok[0] == '-') {
-        if (!strcmp(tok,"-NaN")) {
+        if (!strcmp(tok,"-NaN") || !strcasecmp(tok,"-nan.0")) {
             if (pval) *pval = mk_double(D_NNAN);
             return 1;
         }
-        if (!strcmp(tok,"-Inf")) {
+        if (!strcmp(tok,"-Inf") || !strcasecmp(tok,"-inf.0")) {
             if (pval) *pval = mk_double(D_NINF);
             return 1;
         }
-        i64 = strtoll(tok, &end, 0);
+        i64 = strtoll(tok, &end, base);
         if (pval) *pval = return_from_int64(i64);
         return (*end == '\0');
     }
-    else if (!isdigit(tok[0])) {
-        return 0;
-    }
-    ui64 = strtoull(tok, &end, 0);
+    ui64 = strtoull(tok, &end, base);
     if (pval) *pval = return_from_uint64(ui64);
     return (*end == '\0');
 }
 
+static int isnumtok(char *tok, value_t *pval)
+{
+    return isnumtok_base(tok, pval, 0);
+}
+
+static int read_numtok(char *tok, value_t *pval, int base)
+{
+    int result;
+    errno = 0;
+    result = isnumtok_base(tok, pval, base);
+    if (errno) lerror(ParseError, "read: overflow in numeric constant");
+    return result;
+}
+
 static u_int32_t toktype = TOK_NONE;
 static value_t tokval;
 static char buf[256];
@@ -148,7 +170,7 @@ static u_int32_t peek(ios_t *f)
 {
     char c, *end;
     fixnum_t x;
-    int ch;
+    int ch, base;
 
     if (toktype != TOK_NONE)
         return toktype;
@@ -176,30 +198,30 @@ static u_int32_t peek(ios_t *f)
         toktype = TOK_DOUBLEQUOTE;
     }
     else if (c == '#') {
-        ch = ios_getc(f);
+        ch = ios_getc(f); c = (char)ch;
         if (ch == IOS_EOF)
             lerror(ParseError, "read: invalid read macro");
-        if ((char)ch == '.') {
+        if (c == '.') {
             toktype = TOK_SHARPDOT;
         }
-        else if ((char)ch == '\'') {
+        else if (c == '\'') {
             toktype = TOK_SHARPQUOTE;
         }
-        else if ((char)ch == '\\') {
+        else if (c == '\\') {
             uint32_t cval;
             if (ios_getutf8(f, &cval) == IOS_EOF)
                 lerror(ParseError, "read: end of input in character constant");
             toktype = TOK_NUM;
             tokval = mk_wchar(cval);
         }
-        else if ((char)ch == '(') {
+        else if (c == '(') {
             toktype = TOK_SHARPOPEN;
         }
-        else if ((char)ch == '<') {
+        else if (c == '<') {
             lerror(ParseError, "read: unreadable object");
         }
-        else if (isdigit((char)ch)) {
-            read_token(f, (char)ch, 1);
+        else if (isdigit(c)) {
+            read_token(f, c, 1);
             c = (char)ios_getc(f);
             if (c == '#')
                 toktype = TOK_BACKREF;
@@ -213,14 +235,14 @@ static u_int32_t peek(ios_t *f)
                 lerror(ParseError, "read: invalid label");
             tokval = fixnum(x);
         }
-        else if ((char)ch == '!') {
+        else if (c == '!') {
             // #! single line comment for shbang script support
             do {
                 ch = ios_getc(f);
             } while (ch != IOS_EOF && (char)ch != '\n');
             return peek(f);
         }
-        else if ((char)ch == '|') {
+        else if (c == '|') {
             // multiline comment
             int commentlevel=1;
             while (1) {
@@ -250,10 +272,10 @@ static u_int32_t peek(ios_t *f)
             // this was whitespace, so keep peeking
             return peek(f);
         }
-        else if ((char)ch == ';') {
+        else if (c == ';') {
             toktype = TOK_SHARPSEMI;
         }
-        else if ((char)ch == ':') {
+        else if (c == ':') {
             // gensym
             ch = ios_getc(f);
             if ((char)ch == 'g')
@@ -266,8 +288,18 @@ static u_int32_t peek(ios_t *f)
             toktype = TOK_GENSYM;
             tokval = fixnum(x);
         }
-        else if (symchar((char)ch)) {
+        else if (symchar(c)) {
             read_token(f, ch, 0);
+
+            if (((c == 'b' && (base= 2)) ||
+                 (c == 'o' && (base= 8)) ||
+                 (c == 'd' && (base=10)) ||
+                 (c == 'x' && (base=16))) && isdigit_base(buf[1],base)) {
+                if (!read_numtok(&buf[1], &tokval, base))
+                    lerror(ParseError, "read: invalid base %d constant", base);
+                return (toktype=TOK_NUM);
+            }
+
             toktype = TOK_SHARPSYM;
             tokval = symbol(buf);
         }
@@ -293,12 +325,8 @@ static u_int32_t peek(ios_t *f)
                 return (toktype=TOK_DOT);
             }
             else {
-                errno = 0;
-                if (isnumtok(buf, &tokval)) {
-                    if (errno)
-                        lerror(ParseError,"read: overflow in numeric constant");
+                if (read_numtok(buf, &tokval, 0))
                     return (toktype=TOK_NUM);
-                }
             }
         }
         toktype = TOK_SYM;
diff --git a/femtolisp/system.lsp b/femtolisp/system.lsp
index c828e12..d1201e0 100644
--- a/femtolisp/system.lsp
+++ b/femtolisp/system.lsp
@@ -6,28 +6,17 @@
 (set-constant! 'eq       eq?)
 (set-constant! 'eqv      eqv?)
 (set-constant! 'equal    equal?)
-(set-constant! 'booleanp boolean?)
-(set-constant! 'consp    pair?)
-(set-constant! 'null     null?)
-(set-constant! 'atom     atom?)
-(set-constant! 'symbolp  symbol?)
-(set-constant! 'numberp  number?)
-(set-constant! 'boundp   bound?)
-(set-constant! 'builtinp builtin?)
-(set-constant! 'vectorp  vector?)
-(set-constant! 'fixnump  fixnum?)
 (set-constant! 'rplaca   set-car!)
 (set-constant! 'rplacd   set-cdr!)
 (set-constant! 'char?    (lambda (x) (eq? (typeof x) 'wchar)))
-(set-constant! 'T        #t)
 
 ; convert a sequence of body statements to a single expression.
 ; this allows define, defun, defmacro, let, etc. to contain multiple
 ; body expressions as in Common Lisp.
 (set! f-body (lambda (e)
-               (cond ((atom e)        e)
+               (cond ((atom? e)       e)
                      ((eq (cdr e) ()) (car e))
-                     (T               (cons 'begin e)))))
+                     (#t              (cons 'begin e)))))
 
 (set-syntax! 'define-macro
              (lambda (form . body)
@@ -38,7 +27,7 @@
   (list (list 'lambda (list name) (list 'set! name fn)) #f))
 
 (define-macro (define form . body)
-  (if (symbolp form)
+  (if (symbol? form)
       (list 'set! form (car body))
       (list 'set! (car form) (list 'lambda (cdr form) (f-body body)))))
 
@@ -47,73 +36,73 @@
 (define (identity x) x)
 
 (define (map f lst)
-  (if (atom lst) lst
+  (if (atom? lst) lst
       (cons (f (car lst)) (map f (cdr lst)))))
 
 (define-macro (let binds . body)
   (cons (list 'lambda
-              (map (lambda (c) (if (consp c) (car c) c)) binds)
+              (map (lambda (c) (if (pair? c) (car c) c)) binds)
               (f-body body))
-        (map (lambda (c) (if (consp c) (cadr c) #f)) binds)))
+        (map (lambda (c) (if (pair? c) (cadr c) #f)) binds)))
 
 (define (nconc . lsts)
-  (cond ((null lsts) ())
-        ((null (cdr lsts)) (car lsts))
-        ((null (car lsts)) (apply nconc (cdr lsts)))
-        (T (prog1 (car lsts)
-		  (rplacd (last (car lsts))
-			  (apply nconc (cdr lsts)))))))
+  (cond ((null? lsts) ())
+        ((null? (cdr lsts)) (car lsts))
+        ((null? (car lsts)) (apply nconc (cdr lsts)))
+        (#t (prog1 (car lsts)
+		   (rplacd (last (car lsts))
+			   (apply nconc (cdr lsts)))))))
 
 (define (append . lsts)
-  (cond ((null lsts) ())
-        ((null (cdr lsts)) (car lsts))
-        (T ((label append2 (lambda (l d)
-                             (if (null l) d
-                               (cons (car l)
-                                     (append2 (cdr l) d)))))
-            (car lsts) (apply append (cdr lsts))))))
+  (cond ((null? lsts) ())
+        ((null? (cdr lsts)) (car lsts))
+        (#t ((label append2 (lambda (l d)
+			      (if (null? l) d
+				  (cons (car l)
+					(append2 (cdr l) d)))))
+	     (car lsts) (apply append (cdr lsts))))))
 
 (define (member item lst)
-  (cond ((atom lst) #f)
-        ((equal     (car lst) item) lst)
-        (T          (member item (cdr lst)))))
+  (cond ((atom? lst) #f)
+        ((equal      (car lst) item) lst)
+        (#t          (member item (cdr lst)))))
 (define (memq item lst)
-  (cond ((atom lst) #f)
-        ((eq        (car lst) item) lst)
-        (T          (memq item (cdr lst)))))
+  (cond ((atom? lst) #f)
+        ((eq         (car lst) item) lst)
+        (#t          (memq item (cdr lst)))))
 (define (memv item lst)
-  (cond ((atom lst) #f)
-        ((eqv       (car lst) item) lst)
-        (T          (memv item (cdr lst)))))
+  (cond ((atom? lst) #f)
+        ((eqv        (car lst) item) lst)
+        (#t          (memv item (cdr lst)))))
 
 (define (assoc item lst)
-  (cond ((atom lst) #f)
-	((equal     (caar lst) item) (car lst))
-	(T          (assoc item (cdr lst)))))
+  (cond ((atom? lst) #f)
+	((equal      (caar lst) item) (car lst))
+	(#t          (assoc item (cdr lst)))))
 (define (assv item lst)
-  (cond ((atom lst) #f)
-	((eqv       (caar lst) item) (car lst))
-	(T          (assv item (cdr lst)))))
+  (cond ((atom? lst) #f)
+	((eqv        (caar lst) item) (car lst))
+	(#t          (assv item (cdr lst)))))
 
-(define (macrocall? e) (and (symbolp (car e))
+(define (macrocall? e) (and (symbol? (car e))
 			    (symbol-syntax (car e))))
 
 (define (function? x)
-  (or (builtinp x)
-      (and (consp x) (eq (car x) 'lambda))))
+  (or (builtin? x)
+      (and (pair? x) (eq (car x) 'lambda))))
 (define procedure? function?)
 
 (define (macroexpand-1 e)
-  (if (atom e) e
+  (if (atom? e) e
       (let ((f (macrocall? e)))
 	(if f (apply f (cdr e))
 	    e))))
 
 ; convert to proper list, i.e. remove "dots", and append
 (define (append.2 l tail)
-  (cond ((null l)  tail)
-        ((atom l)  (cons l tail))
-        (T         (cons (car l) (append.2 (cdr l) tail)))))
+  (cond ((null? l)  tail)
+        ((atom? l)  (cons l tail))
+        (#t         (cons (car l) (append.2 (cdr l) tail)))))
 
 (define (cadr x) (car (cdr x)))
 
@@ -124,27 +113,27 @@
   ((label mexpand
           (lambda (e env f)
             (begin
-              (while (and (consp e)
+              (while (and (pair? e)
                           (not (member (car e) env))
                           (set! f (macrocall? e)))
                 (set! e (apply f (cdr e))))
-              (cond ((and (consp e)
+              (cond ((and (pair? e)
                           (not (eq (car e) 'quote)))
                      (let ((newenv
                             (if (and (eq (car e) 'lambda)
-                                     (consp (cdr e)))
+                                     (pair? (cdr e)))
                                 (append.2 (cadr e) env)
                               env)))
                        (map (lambda (x) (mexpand x newenv ())) e)))
-                    ;((and (symbolp e) (constant? e)) (eval e))
-                    ;((and (symbolp e)
+                    ;((and (symbol? e) (constant? e)) (eval e))
+                    ;((and (symbol? e)
                     ;      (not (member e *special-forms*))
                     ;      (not (member e env))) (cons '%top e))
-                    (T e)))))
+                    (#t e)))))
    e () ()))
 
 (define-macro (define form . body)
-  (if (symbolp form)
+  (if (symbol? form)
       (list 'set! form (car body))
       (list 'set! (car form)
 	    (macroexpand (list 'lambda (cdr form) (f-body body))))))
@@ -163,6 +152,7 @@
 (define (1+ n) (+ n 1))
 (define (1- n) (- n 1))
 (define (mod x y) (- x (* (/ x y) y)))
+(define remainder mod)
 (define (abs x)   (if (< x 0) (- x) x))
 (define K prog1)  ; K combinator ;)
 
@@ -180,99 +170,101 @@
 (define (cdddr x) (cdr (cdr (cdr x))))
 
 (define (every pred lst)
-  (or (atom lst)
+  (or (atom? lst)
       (and (pred (car lst))
            (every pred (cdr lst)))))
 
 (define (any pred lst)
-  (and (consp lst)
+  (and (pair? lst)
        (or (pred (car lst))
            (any pred (cdr lst)))))
 
-(define (listp a) (or (null a) (consp a)))
-(define (list? a) (or (null a) (and (pair? a) (list? (cdr a)))))
+(define (listp a) (or (null? a) (pair? a)))
+(define (list? a) (or (null? a) (and (pair? a) (list? (cdr a)))))
 
 (define (nthcdr lst n)
   (if (<= n 0) lst
       (nthcdr (cdr lst) (- n 1))))
+(define list-tail nthcdr)
 
 (define (list-ref lst n)
   (car (nthcdr lst n)))
 
 (define (list* . l)
-  (if (atom (cdr l))
+  (if (atom? (cdr l))
       (car l)
       (cons (car l) (apply list* (cdr l)))))
 
 (define (nlist* . l)
-  (if (atom (cdr l))
+  (if (atom? (cdr l))
       (car l)
       (rplacd l (apply nlist* (cdr l)))))
 
 (define (lastcdr l)
-  (if (atom l) l
+  (if (atom? l) l
       (lastcdr (cdr l))))
 
 (define (last l)
-  (cond ((atom l)        l)
-        ((atom (cdr l))  l)
-        (T               (last (cdr l)))))
+  (cond ((atom? l)        l)
+        ((atom? (cdr l))  l)
+        (#t               (last (cdr l)))))
+(define last-pair last)
 
 (define (map! f lst)
   (prog1 lst
-	 (while (consp lst)
+	 (while (pair? lst)
 		(rplaca lst (f (car lst)))
 		(set! lst (cdr lst)))))
 
 (define (mapcar f . lsts)
   ((label mapcar-
           (lambda (lsts)
-            (cond ((null lsts) (f))
-                  ((atom (car lsts)) (car lsts))
-                  (T (cons (apply f (map car lsts))
-                           (mapcar- (map cdr lsts)))))))
+            (cond ((null? lsts) (f))
+                  ((atom? (car lsts)) (car lsts))
+                  (#t (cons (apply f (map car lsts))
+			    (mapcar- (map cdr lsts)))))))
    lsts))
 
 (define (transpose M) (apply mapcar (cons list M)))
 
 (define (filter pred lst) (filter- pred lst ()))
 (define (filter- pred lst accum)
-  (cond ((null lst) accum)
+  (cond ((null? lst) accum)
         ((pred (car lst))
          (filter- pred (cdr lst) (cons (car lst) accum)))
-        (T
+        (#t
          (filter- pred (cdr lst) accum))))
 
 (define (separate pred lst) (separate- pred lst () ()))
 (define (separate- pred lst yes no)
-  (cond ((null lst) (cons yes no))
+  (cond ((null? lst) (cons yes no))
         ((pred (car lst))
          (separate- pred (cdr lst) (cons (car lst) yes) no))
-        (T
+        (#t
          (separate- pred (cdr lst) yes (cons (car lst) no)))))
 
 (define (foldr f zero lst)
-  (if (null lst) zero
+  (if (null? lst) zero
     (f (car lst) (foldr f zero (cdr lst)))))
 
 (define (foldl f zero lst)
-  (if (null lst) zero
+  (if (null? lst) zero
     (foldl f (f (car lst) zero) (cdr lst))))
 
 (define (reverse lst) (foldl cons () lst))
 
 (define (copy-list l)
-  (if (atom l) l
+  (if (atom? l) l
     (cons (car l)
           (copy-list (cdr l)))))
 (define (copy-tree l)
-  (if (atom l) l
+  (if (atom? l) l
     (cons (copy-tree (car l))
           (copy-tree (cdr l)))))
 
 (define (nreverse l)
   (let ((prev ()))
-    (while (consp l)
+    (while (pair? l)
 	   (set! l (prog1 (cdr l)
 			  (rplacd l (prog1 prev
 					   (set! prev l))))))
@@ -324,7 +316,7 @@
 (define-macro (catch tag expr)
   (let ((e (gensym)))
     `(trycatch ,expr
-               (lambda (,e) (if (and (consp ,e)
+               (lambda (,e) (if (and (pair? ,e)
                                      (eq (car  ,e) 'thrown-value)
                                      (eq (cadr ,e) ,tag))
                                 (caddr ,e)
@@ -354,15 +346,15 @@
                                                    extype))
                                        (todo     (cddr catc)))
                                   `(,(if specific
-                                         ; exception matching logic
+					 ; exception matching logic
                                          `(or (eq ,e ',extype)
-                                              (and (consp ,e)
+                                              (and (pair? ,e)
                                                    (eq (car ,e)
                                                        ',extype)))
-                                       T); (catch (e) ...), match anything
+					 #t); (catch (e) ...), match anything
                                     (let ((,var ,e)) (begin ,@todo)))))
                               catches)
-                       (T (raise ,e))))) ; no matches, reraise
+                       (#t (raise ,e))))) ; no matches, reraise
     (if final
         (if catches
             ; form with both catch and finally
@@ -400,15 +392,15 @@
         (cddar   rplacd   cdar)
         (cdddr   rplacd   cddr)
         (list-ref rplaca  nthcdr)
-        (get     put      identity)
-        (aref    aset     identity)
+        (get     put!     identity)
+        (aref    aset!    identity)
         (symbol-syntax    set-syntax!        identity)))
 
 (define (setf-place-mutator place val)
-  (if (symbolp place)
+  (if (symbol? place)
       (list 'set! place val)
     (let ((mutator (assq (car place) *setf-place-list*)))
-      (if (null mutator)
+      (if (null? mutator)
           (error "setf: unknown place " (car place))
 	  (if (eq (caddr mutator) 'identity)
 	      (cons (cadr mutator) (append (cdr place) (list val)))
@@ -420,7 +412,7 @@
   (f-body
    ((label setf-
            (lambda (args)
-             (if (null args)
+             (if (null? args)
                  ()
                (cons (setf-place-mutator (car args) (cadr args))
                      (setf- (cddr args))))))
@@ -439,8 +431,8 @@
     l))
 
 (define (self-evaluating? x)
-  (or (and (atom x)
-           (not (symbolp x)))
+  (or (and (atom? x)
+           (not (symbol? x)))
       (and (constant? x)
            (eq x (eval x)))))
 
@@ -448,54 +440,54 @@
 (define-macro (backquote x) (bq-process x))
 
 (define (splice-form? x)
-  (or (and (consp x) (or (eq (car x) '*comma-at*)
+  (or (and (pair? x) (or (eq (car x) '*comma-at*)
                          (eq (car x) '*comma-dot*)))
       (eq x '*comma*)))
 
 (define (bq-process x)
   (cond ((self-evaluating? x)
-         (if (vectorp x)
+         (if (vector? x)
              (let ((body (bq-process (vector-to-list x))))
                (if (eq (car body) 'list)
                    (cons vector (cdr body))
                  (list apply vector body)))
            x))
-        ((atom x)                     (list 'quote x))
+        ((atom? x)                    (list 'quote x))
         ((eq (car x) 'backquote)      (bq-process (bq-process (cadr x))))
         ((eq (car x) '*comma*)        (cadr x))
         ((not (any splice-form? x))
          (let ((lc    (lastcdr x))
                (forms (map bq-bracket1 x)))
-           (if (null lc)
+           (if (null? lc)
                (cons 'list forms)
              (nconc (cons 'nlist* forms) (list (bq-process lc))))))
-        (T (let ((p x) (q ()))
-             (while (and (consp p)
-                         (not (eq (car p) '*comma*)))
-               (set! q (cons (bq-bracket (car p)) q))
-               (set! p (cdr p)))
-             (let ((forms
-                    (cond ((consp p) (nreconc q (list (cadr p))))
-                          ((null p)  (nreverse q))
-                          (T         (nreconc q (list (bq-process p)))))))
-               (if (null (cdr forms))
-                   (car forms)
-                 (cons 'nconc forms)))))))
+        (#t (let ((p x) (q ()))
+	      (while (and (pair? p)
+			  (not (eq (car p) '*comma*)))
+		     (set! q (cons (bq-bracket (car p)) q))
+		     (set! p (cdr p)))
+	      (let ((forms
+		     (cond ((pair? p) (nreconc q (list (cadr p))))
+			   ((null? p)  (nreverse q))
+			   (#t        (nreconc q (list (bq-process p)))))))
+		(if (null? (cdr forms))
+		    (car forms)
+		    (cons 'nconc forms)))))))
 
 (define (bq-bracket x)
-  (cond ((atom x)                   (list list (bq-process x)))
+  (cond ((atom? x)                  (list list (bq-process x)))
         ((eq (car x) '*comma*)      (list list (cadr x)))
         ((eq (car x) '*comma-at*)   (list 'copy-list (cadr x)))
         ((eq (car x) '*comma-dot*)  (cadr x))
-        (T                          (list list (bq-process x)))))
+        (#t                         (list list (bq-process x)))))
 
 ; bracket without splicing
 (define (bq-bracket1 x)
-  (if (and (consp x) (eq (car x) '*comma*))
+  (if (and (pair? x) (eq (car x) '*comma*))
       (cadr x)
       (bq-process x)))
 
-(define-macro (assert expr) `(if ,expr T (raise '(assert-failed ,expr))))
+(define-macro (assert expr) `(if ,expr #t (raise '(assert-failed ,expr))))
 
 (define-macro (time expr)
   (let ((t0 (gensym)))
@@ -504,14 +496,16 @@
 	,expr
 	(princ "Elapsed time: " (- (time.now) ,t0) " seconds\n")))))
 
-(define (display x) (princ x) (princ "\n"))
+(define (display x) (princ x) #t)
+
+(define (vu8 . elts) (apply array (cons 'uint8 elts)))
 
 (define (vector.map f v)
   (let* ((n (length v))
          (nv (vector.alloc n)))
     (for 0 (- n 1)
          (lambda (i)
-           (aset nv i (f (aref v i)))))
+           (aset! nv i (f (aref v i)))))
     nv))
 
 (define (table.pairs t)
@@ -525,6 +519,6 @@
                () t))
 (define (table.clone t)
   (let ((nt (table)))
-    (table.foldl (lambda (k v z) (put nt k v))
+    (table.foldl (lambda (k v z) (put! nt k v))
                  () t)
     nt))
diff --git a/femtolisp/table.c b/femtolisp/table.c
index 751cca1..58f5375 100644
--- a/femtolisp/table.c
+++ b/femtolisp/table.c
@@ -103,11 +103,11 @@ value_t fl_table(value_t *args, uint32_t nargs)
     return nt;
 }
 
-// (put table key value)
+// (put! table key value)
 value_t fl_table_put(value_t *args, uint32_t nargs)
 {
-    argcount("put", nargs, 3);
-    htable_t *h = totable(args[0], "put");
+    argcount("put!", nargs, 3);
+    htable_t *h = totable(args[0], "put!");
     void **table0 = h->table;
     equalhash_put(h, (void*)args[1], (void*)args[2]);
     // register finalizer if we outgrew inline space
@@ -142,13 +142,13 @@ value_t fl_table_has(value_t *args, uint32_t nargs)
     return equalhash_has(h, (void*)args[1]) ? FL_T : FL_F;
 }
 
-// (del table key)
+// (del! table key)
 value_t fl_table_del(value_t *args, uint32_t nargs)
 {
-    argcount("del", nargs, 2);
-    htable_t *h = totable(args[0], "del");
+    argcount("del!", nargs, 2);
+    htable_t *h = totable(args[0], "del!");
     if (!equalhash_remove(h, (void*)args[1]))
-        lerror(KeyError, "del: key not found");
+        lerror(KeyError, "del!: key not found");
     return args[0];
 }
 
@@ -178,10 +178,10 @@ value_t fl_table_foldl(value_t *args, uint32_t nargs)
 static builtinspec_t tablefunc_info[] = {
     { "table", fl_table },
     { "table?", fl_tablep },
-    { "put", fl_table_put },
+    { "put!", fl_table_put },
     { "get", fl_table_get },
     { "has", fl_table_has },
-    { "del", fl_table_del },
+    { "del!", fl_table_del },
     { "table.foldl", fl_table_foldl },
     { NULL, NULL }
 };
diff --git a/femtolisp/test.lsp b/femtolisp/test.lsp
index bea51a5..18b6cd5 100644
--- a/femtolisp/test.lsp
+++ b/femtolisp/test.lsp
@@ -9,20 +9,20 @@
 
 ;(define (reverse lst)
 ;  ((label rev-help (lambda (lst result)
-;                     (if (null lst) result
+;                     (if (null? lst) result
 ;                       (rev-help (cdr lst) (cons (car lst) result)))))
 ;   lst ()))
 
 (define (append- . lsts)
   ((label append-h
           (lambda (lsts)
-            (cond ((null lsts) ())
-                  ((null (cdr lsts)) (car lsts))
-                  (T ((label append2 (lambda (l d)
-                                       (if (null l) d
-                                         (cons (car l)
-                                               (append2 (cdr l) d)))))
-                      (car lsts) (append-h (cdr lsts)))))))
+            (cond ((null? lsts) ())
+                  ((null? (cdr lsts)) (car lsts))
+                  (#t ((label append2 (lambda (l d)
+					(if (null? l) d
+					    (cons (car l)
+						  (append2 (cdr l) d)))))
+		       (car lsts) (append-h (cdr lsts)))))))
    lsts))
 
 ;(princ 'Hello '| | 'world! "\n")
@@ -38,13 +38,13 @@
 ; iterative filter
 (define (ifilter pred lst)
   ((label f (lambda (accum lst)
-              (cond ((null lst) (nreverse accum))
+              (cond ((null? lst) (nreverse accum))
                     ((not (pred (car lst))) (f accum (cdr lst)))
-                    (T (f (cons (car lst) accum) (cdr lst))))))
+                    (#t (f (cons (car lst) accum) (cdr lst))))))
    () lst))
 
 (define (sort l)
-  (if (or (null l) (null (cdr l))) l
+  (if (or (null? l) (null? (cdr l))) l
     (let* ((piv (car l))
            (halves (separate (lambda (x) (< x piv)) (cdr l))))
       (nconc (sort (car halves))
@@ -81,13 +81,13 @@
   (cond ((= p 0) 1)
         ((= b 0) 0)
         ((evenp p) (square (expt b (/ p 2))))
-        (T (* b (expt b (- p 1))))))
+        (#t (* b (expt b (- p 1))))))
 
 (define (gcd a b)
   (cond ((= a 0) b)
         ((= b 0) a)
         ((< a b)  (gcd a (- b a)))
-        (T        (gcd b (- a b)))))
+        (#t       (gcd b (- a b)))))
 
 ; like eval-when-compile
 (define-macro (literal expr)
@@ -95,7 +95,7 @@
     (if (self-evaluating? v) v (list quote v))))
 
 (define (cardepth l)
-  (if (atom l) 0
+  (if (atom? l) 0
       (+ 1 (cardepth (car l)))))
 
 (define (nestlist f zero n)
@@ -105,7 +105,7 @@
 (define (mapl f . lsts)
   ((label mapl-
           (lambda (lsts)
-            (if (null (car lsts)) ()
+            (if (null? (car lsts)) ()
 		(begin (apply f lsts) (mapl- (map cdr lsts))))))
    lsts))
 
@@ -115,7 +115,7 @@
 
 ; swap the cars and cdrs of every cons in a structure
 (define (swapad c)
-  (if (atom c) c
+  (if (atom? c) c
       (rplacd c (K (swapad (car c))
 		   (rplaca c (swapad (cdr c)))))))
 
@@ -123,7 +123,7 @@
   (filter (lambda (e) (not (eq e x))) l))
 
 (define (conscount c)
-  (if (consp c) (+ 1
+  (if (pair? c) (+ 1
                    (conscount (car c))
                    (conscount (cdr c)))
       0))
@@ -163,7 +163,7 @@
                        (todo   (f-body (cddr  catc))))
                    `(lambda (,var)
                       (if (or (eq ,var ',extype)
-                              (and (consp ,var)
+                              (and (pair? ,var)
                                    (eq (car ,var) ',extype)))
                           ,todo
                         (,next ,var)))))
@@ -220,8 +220,8 @@
        (cdr ,first))))
 
 (define (map-indexed f lst)
-  (if (atom lst) lst
+  (if (atom? lst) lst
     (let ((i 0))
-      (accumulate-while (consp lst) (f (car lst) i)
+      (accumulate-while (pair? lst) (f (car lst) i)
                         (begin (set! lst (cdr lst))
                                (set! i (1+ i)))))))
diff --git a/femtolisp/torus.lsp b/femtolisp/torus.lsp
index dd62299..64cdbc3 100644
--- a/femtolisp/torus.lsp
+++ b/femtolisp/torus.lsp
@@ -1,6 +1,6 @@
 ; -*- scheme -*-
 (define (maplist f l)
-  (if (null l) ()
+  (if (null? l) ()
     (cons (f l) (maplist f (cdr l)))))
 
 ; produce a beautiful, toroidal cons structure
diff --git a/femtolisp/unittest.lsp b/femtolisp/unittest.lsp
index 9518c2d..b6b98ad 100644
--- a/femtolisp/unittest.lsp
+++ b/femtolisp/unittest.lsp
@@ -7,9 +7,9 @@
   (list (fixnum n) (int8 n) (int16 n) (int32 n) (int64 n)))
 
 (define (each f l)
-  (if (atom l) ()
-    (begin (f (car l))
-           (each f (cdr l)))))
+  (if (atom? l) ()
+      (begin (f (car l))
+	     (each f (cdr l)))))
 
 (define (each^2 f l m)
   (each (lambda (o) (each (lambda (p) (f o p)) m)) l))
@@ -82,4 +82,4 @@
                  (3 . d) (2 . c) (0 . b) (1 . a))))
 
 (princ "all tests pass\n")
-T
+#t