shithub: femtolisp

Info  •  Files  •  Log  •  Branches

pair? → cons?

--- a/aliases.scm

+++ b/aliases.scm

@@ -1,6 +1,9 @@

 ; definitions of standard scheme procedures in terms of femtolisp procedures

 ; sufficient to run the R5RS version of psyntax

+(unless (bound? 'pair?)

+        (define pair? cons?))

+

 (define top-level-bound? bound?)

 (define (eval-core x) (eval x))

 (define (symbol-value s) (top-level-value s))

--- a/compiler.lsp

+++ b/compiler.lsp

@@ -182,7 +182,7 @@

         (else (index-of item (cdr lst) (+ start 1)))))

 (define (in-env? s env)

-  (and (pair? env)

+  (and (cons? env)

        (or (assq s (car env))

            (in-env? s (cdr env)))))

@@ -252,7 +252,7 @@

 (define (box-vars g env)

   (let loop ((e env))

-    (if (pair? e)

+    (if (cons? e)

     (begin (if (cadr (car e))

                (emit g 'box (caddr (car e))))

                (loop (cdr e))))))

@@ -265,7 +265,7 @@

         (endl  (make-label g))

         (test  (cadr x))

         (then  (caddr x))

-        (else  (if (pair? (cdddr x))

+        (else  (if (cons? (cdddr x))

                    (cadddr x)

                    (void))))

     (cond ((eq? test #t)

@@ -295,7 +295,7 @@

 (define (compile-prog1 g env x)

   (compile-in g env #f (cadr x))

-  (if (pair? (cddr x))

+  (if (cons? (cddr x))

       (begin (bcode:stack g 1)

              (compile-begin g env #f (cddr x))

              (emit g 'pop)

@@ -320,7 +320,7 @@

       (eq? a 'lambda)))

 (define (1arg-lambda? func)

-  (and (pair? func)

+  (and (cons? func)

        (is-lambda? (car func))

        (length= (cadr func) 1)))

@@ -371,7 +371,7 @@

                     < '<  * '* cdr 'cdr cadr 'cadr null? 'null?

                     + '+  eqv? 'eqv? compare 'compare  aref 'aref

                     set-car! 'set-car!  car 'car for 'for

-                    pair? 'pair?  = '=  vector? 'vector?)))

+                    cons? 'cons?  = '=  vector? 'vector?)))

     (λ (b)

       (get b2i b #f))))

@@ -407,7 +407,7 @@

 (define (inlineable? form)

   (let ((lam (car form)))

-    (and (pair? lam)

+    (and (cons? lam)

          (is-lambda? (car lam))

          (list? (cadr lam))

          (every symbol? (cadr lam))

@@ -456,7 +456,7 @@

                      (length= x 2))

                 (begin (compile-in g env #f (cadr x))

                        (emit g 'cadr))

-                (if (and (pair? head)

+                (if (and (cons? head)

                          (is-lambda? (car head))

                          (inlineable? x))

                     (compile-let g env tail? x)

@@ -524,7 +524,7 @@

 ;; optional and keyword args

-(define (keyword-arg? x) (and (pair? x) (keyword? (car x))))

+(define (keyword-arg? x) (and (cons? x) (keyword? (car x))))

 (define (keyword->symbol k)

   (if (keyword? k)

       (symbol (let ((s (string k)))

@@ -534,12 +534,12 @@

 (define (lambda-vars l)

   (define (check-formals l o opt kw)

     (cond ((or (null? l) (symbol? l)) #t)

-          ((and (pair? l) (symbol? (car l)))

+          ((and (cons? l) (symbol? (car l)))

            (if (or opt kw)

                (error "compile error: invalid argument list "

                       o ". optional arguments must come after required.")

                (check-formals (cdr l) o opt kw)))

-          ((and (pair? l) (pair? (car l)))

+          ((and (cons? l) (cons? (car l)))

            (unless (and (length= (car l) 2)

                         (symbol? (caar l)))

                    (error "compile error: invalid optional argument " (car l)

@@ -550,7 +550,7 @@

                    (error "compile error: invalid argument list "

                           o ". keyword arguments must come last.")

                    (check-formals (cdr l) o #t kw))))

-          ((pair? l)

+          ((cons? l)

            (error "compile error: invalid formal argument " (car l)

                   " in list " o))

           (else

@@ -559,12 +559,12 @@

                (error "compile error: invalid formal argument " l

                       " in list " o)))))

   (check-formals l l #f #f)

-  (map (λ (s) (if (pair? s) (keyword->symbol (car s)) s))

+  (map (λ (s) (if (cons? s) (keyword->symbol (car s)) s))

         (to-proper l)))

 (define (emit-optional-arg-inits g env opta vars i)

   ; i is the lexical var index of the opt arg to process next

-  (if (pair? opta)

+  (if (cons? opta)

       (let ((nxt (make-label g)))

         (emit g 'brbound i)

         (emit g 'brt nxt)

@@ -579,7 +579,7 @@

 (define (expand-define x)

   ;; expand a single `define` expression to `set!`

   (let ((form (cadr x))

-    (body (if (pair? (cddr x))

+    (body (if (cons? (cddr x))

               (cddr x)

               (if (symbol? (cadr x))

                   `(,(void))

@@ -595,10 +595,10 @@

             (λ (expr)

               (cond ((atom? expr) ())

                     ((and (eq? (car expr) 'define)

-                          (pair? (cdr expr)))

+                          (cons? (cdr expr)))

                      (or (and (symbol? (cadr expr))

                               (list (cadr expr)))

-                         (and (pair? (cadr expr))

+                         (and (cons? (cadr expr))

                               (symbol? (caadr expr))

                               (list (caadr expr)))

                          ()))

@@ -610,8 +610,8 @@

 (define (lower-define e)

   ;; convert lambda to one body expression and process internal defines

   (define (λ-body e)

-    (let ((B (if (pair? (cddr e))

-                 (if (pair? (cdddr e))

+    (let ((B (if (cons? (cddr e))

+                 (if (cons? (cdddr e))

                      (cons 'begin (cddr e))

                      (caddr e))

                  (void))))

@@ -698,7 +698,7 @@

         (args  (cadr f))

         (atail (lastcdr (cadr f)))

         (vars  (lambda:vars f))

-        (opta  (filter pair? (cadr f)))

+        (opta  (filter cons? (cadr f)))

         (last  (lastcdr f)))

     (let* ((name  (if (null? last) 'λ last))

            (nargs (if (atom? args) 0 (length args)))

@@ -848,7 +848,7 @@

   (let loop1 ((n (length alist)))

     (let ((v (vector-alloc (* 2 n) #f)))

       (let loop2 ((lst alist))

-        (if (pair? lst)

+        (if (cons? lst)

             (let ((key (caar lst)))

               (let ((x (* 2 ($hash-keyword key n))))

                 (if (aref v x)

--- a/examples/bq.scm

+++ b/examples/bq.scm

@@ -1,6 +1,6 @@

 (define (bq-process2 x d)

   (define (splice-form? x)

-    (or (and (pair? x) (or (eq? (car x) 'unquote-splicing)

+    (or (and (cons? x) (or (eq? (car x) 'unquote-splicing)

 			   (eq? (car x) 'unquote-nsplicing)

 			   (and (eq? (car x) 'unquote)

 				(length> x 2))))

@@ -7,7 +7,7 @@

 	(eq? x 'unquote)))

   ;; bracket without splicing

   (define (bq-bracket1 x)

-    (if (and (pair? x) (eq? (car x) 'unquote))

+    (if (and (cons? x) (eq? (car x) 'unquote))

 	(if (= d 0)

 	    (cadr x)

 	    (list cons ''unquote

@@ -56,7 +56,7 @@

 	 (let loop ((p x) (q ()))

 	   (cond ((null? p) ;; proper list

 		  (cons 'nconc (reverse! q)))

-		 ((pair? p)

+		 ((cons? p)

 		  (cond ((eq? (car p) 'unquote)

 			 ;; (... . ,x)

 			 (cons 'nconc

@@ -97,12 +97,12 @@

 ;; minimal version with no optimizations, vectors, or dotted lists

 (define (bq-process0 x d)

   (define (bq-bracket x)

-    (cond ((and (pair? x) (eq? (car x) 'unquote))

+    (cond ((and (cons? x) (eq? (car x) 'unquote))

 	   (if (= d 0)

 	       (cons list (cdr x))

 	       (list list (list cons ''unquote

 				(bq-process0 (cdr x) (- d 1))))))

-	  ((and (pair? x) (eq? (car x) 'unquote-splicing))

+	  ((and (cons? x) (eq? (car x) 'unquote-splicing))

 	   (if (= d 0)

 	       (list 'copy-list (cadr x))

 	       (list list (list list ''unquote-splicing

--- a/examples/cps.lsp

+++ b/examples/cps.lsp

@@ -12,7 +12,7 @@

 ; a utility used at run time to dispatch a call with or without

 ; the continuation argument, depending on the function

 (define (funcall/cc f k . args)

-  (if (and (pair? f) (eq (car f) 'lambda/cc))

+  (if (and (cons? f) (eq (car f) 'lambda/cc))

       (apply (cdr f) (cons k args))

       (k (apply f args))))

 (define *funcall/cc-names*

@@ -22,7 +22,7 @@

 (define-macro (def-funcall/cc-n args)

   (let ((name (aref *funcall/cc-names* (length args))))

     `(define (,name f k ,@args)

-       (if (and (pair? f) (eq (car f) 'lambda/cc))

+       (if (and (cons? f) (eq (car f) 'lambda/cc))

            ((cdr f) k ,@args)

 	   (k (f ,@args))))))

 (def-funcall/cc-n ())

@@ -151,7 +151,7 @@

            (builtincall->cps form k))

           ; ((lambda (...) body) ...)

-          ((and (pair? (car form))

+          ((and (cons? (car form))

                 (eq (caar form) 'lambda))

            (let ((largs (cadr (car form)))

                  (lbody (caddr (car form))))

@@ -175,7 +175,7 @@

         ((and (eq (car form) 'lambda)

               (let ((body (caddr form))

                     (args (cadr form)))

-                (and (pair? body)

+                (and (cons? body)

                      (equal? (cdr body) args)

                      (constant? (car (caddr form))))))

          (car (caddr form)))

@@ -193,11 +193,11 @@

 (define (β-reduce- form)

         ; ((lambda (f) (f arg)) X) => (X arg)

   (cond ((and (length= form 2)

-              (pair? (car form))

+              (cons? (car form))

               (eq (caar form) 'lambda)

               (let ((args (cadr (car form)))

                     (body (caddr (car form))))

-                (and (pair? body) (pair? args)

+                (and (cons? body) (cons? args)

                      (length= body 2)

                      (length= args 1)

                      (eq (car body) (car args))

@@ -215,15 +215,15 @@

         ; ((lambda (p1 args...) body) s exprs...)

         ; where exprs... doesn't contain p1

         ((and (length= form 2)

-              (pair? (car form))

+              (cons? (car form))

               (eq (caar form) 'lambda)

               (or (atom? (cadr form)) (constant? (cadr form)))

               (let ((args (cadr (car form)))

                     (s (cadr form))

                     (body (caddr (car form))))

-                (and (pair? args) (length= args 1)

-                     (pair? body)

-                     (pair? (car body))

+                (and (cons? args) (length= args 1)

+                     (cons? body)

+                     (cons? (car body))

                      (eq (caar body) 'lambda)

                      (let ((innerargs (cadr (car body)))

                            (innerbody (caddr (car body)))

--- a/flisp.boot

+++ b/flisp.boot

@@ -19,7 +19,7 @@

   byte)

 	    *syntax-environment* #table(when #fn(";000z1200211POe4:" #(if begin))  with-output-to #fn("<000z12021e1220e2e1e12315163:" #(#fn(nconc)

   with-bindings *output-stream* #fn(copy-list)))  catch #fn("@000n220502112286e123242586e2262786e22829e2e3262:86e20e3e42;86e22<86e2e4e3e3:" #(#fn(gensym)

-  trycatch λ if and pair? eq? car quote thrown-value cadr caddr raise))  let* #fn("@000z10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc)

+  trycatch λ if and cons? eq? car quote thrown-value cadr caddr raise))  let* #fn("@000z10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc)

   λ #fn(copy-list) caar let* cadar))  with-input-from #fn("<000z12021e1220e2e1e12315163:" #(#fn(nconc)

   with-bindings *input-stream* #fn(copy-list)))  unless #fn("<000z1200O211Pe4:" #(if

   begin))  letrec #fn(">000z1202021e12273052e122240522515154e1222605262:" #(#fn(nconc)

@@ -48,7 +48,7 @@

   length=) 1arg-lambda?)

 	    <= #fn("6000n210L;IB0470051;380470151S:" #(nan?) <=) >

 	    #fn("6000n210L:" #() >) >= #fn("6000n201L;IB0470051;380470151S:" #(nan?) >=)

-	    Instructions #table(call.l 81  trycatch 75  largc 79  loadg.l 68  aref2 23  box 90  cadr 36  argc 62  setg 71  load0 21  vector? 45  fixnum? 41  loadc0 17  loada0 0  div0 59  keyargs 89  call 5  loada.l 69  brt.l 50  pair? 18  sub2 78  add2 29  loadc.l 70  loadc 9  builtin? 43  set-car! 47  brt 25  ret 10  loadi8 66  tapply 77  loada1 1  shift 46  boolean? 39  atom? 24  cdr 13  brne.l 83  / 58  loadf 31  equal? 52  apply 54  dup 11  loadt 20  jmp.l 48  null? 38  not 35  = 60  set-cdr! 30  eq? 33  * 57  load1 27  bound? 42  brf 3  function? 44  box.l 91  < 28  brnn.l 84  jmp 16  loadv 2  for 76  lvargc 80  dummy_eof 93  + 55  brne 19  compare 61  neg 37  loadv.l 67  number? 40  vargc 74  brn 85  brbound 88  vector 63  loadc1 22  setg.l 72  brf.l 49  aref 92  symbol? 34  aset! 64  car 12  cons 32  tcall.l 82  - 56  brn.l 86  optargs 87  closure 14  pop 4  eqv? 51  list 53  seta 15  seta.l 73  brnn 26  loadnil 65  loadg 7  loada 8  tcall 6)

+	    Instructions #table(call.l 81  trycatch 75  largc 79  loadg.l 68  aref2 23  box 90  cadr 36  argc 62  setg 71  load0 21  vector? 45  fixnum? 41  loadc0 17  loada0 0  div0 59  keyargs 89  call 5  loada.l 69  brt.l 50  sub2 78  add2 29  loadc.l 70  loadc 9  builtin? 43  set-car! 47  brt 25  ret 10  loadi8 66  tapply 77  loada1 1  shift 46  boolean? 39  atom? 24  cdr 13  brne.l 83  / 58  loadf 31  equal? 52  apply 54  dup 11  loadt 20  jmp.l 48  null? 38  not 35  = 60  set-cdr! 30  eq? 33  * 57  load1 27  bound? 42  brf 3  function? 44  box.l 91  < 28  brnn.l 84  jmp 16  loadv 2  for 76  lvargc 80  dummy_eof 93  + 55  brne 19  compare 61  neg 37  loadv.l 67  number? 40  vargc 74  brn 85  brbound 88  vector 63  loadc1 22  setg.l 72  cons? 18  brf.l 49  aref 92  symbol? 34  aset! 64  car 12  cons 32  tcall.l 82  - 56  brn.l 86  optargs 87  closure 14  pop 4  eqv? 51  list 53  seta 15  seta.l 73  brnn 26  loadnil 65  loadg 7  loada 8  tcall 6)

 	    __init_globals #fn("5000n020w1422w3474w5476w7478w9:" #("/"

 								   *directory-separator*

 								   "\n"

@@ -68,7 +68,7 @@

 	    __start #fn("7000n1705040=B3D00=w14Ow24730T51@C00w14Dw24745047550426E61:" #(__init_globals

   *argv* *interactive* __script __rcscript repl #fn(exit)) __start)

 	    abs #fn("6000n10EL3500U:0:" #() abs) any

-	    #fn("7000n21B;3D0401<51;I:047001=62:" #(any) any) arg-counts #table(bound? 1  function? 1  symbol? 1  car 1  cons 2  < 2  cadr 1  for 3  vector? 1  fixnum? 1  boolean? 1  cdr 1  atom? 1  div0 2  equal? 2  eqv? 2  pair? 1  compare 2  null? 1  not 1  number? 1  = 2  set-cdr! 2  eq? 2  builtin? 1  set-car! 2)

+	    #fn("7000n21B;3D0401<51;I:047001=62:" #(any) any) arg-counts #table(bound? 1  function? 1  symbol? 1  car 1  cons 2  < 2  cadr 1  for 3  boolean? 1  fixnum? 1  vector? 1  cdr 1  atom? 1  div0 2  equal? 2  eqv? 2  compare 2  null? 1  not 1  number? 1  = 2  set-cdr! 2  eq? 2  builtin? 1  cons? 1  set-car! 2)

 	    argc-error #fn(";000n2702102211Kl37023@402465:" #(error "compile error: "

 							      " expects " " argument."

 							      " arguments.") argc-error)

@@ -93,7 +93,7 @@

   length= cons 'unquote any splice-form? lastcdr #fn(map)

   #fn("7000n1700A62:" #(bq-bracket1)) #fn(nconc) list* #fn("=000n20J;02071151P:0B3n00<22CW020731AEl3700=@C07425e2760=AK~52e252P:F<0=770<A521P62:2071760A521P51P:" #(nconc

   reverse! unquote nreconc list 'unquote bq-process bq-bracket))) bq-process)

-	    builtin->instruction #fn("8000n120A0O63:" #(#fn(get)) #(#table(#.cadr cadr  #.aset! aset!  #.+ +  #.- -  #.equal? equal?  #.eq? eq?  #.builtin? builtin?  #.not not  #.pair? pair?  #.cdr cdr  #./ /  #.div0 div0  #.set-car! set-car!  #.vector vector  #.set-cdr! set-cdr!  #.< <  #.for for  #.cons cons  #.apply apply  #.eqv? eqv?  #.vector? vector?  #.list list  #.aref aref  #.car car  #.bound? bound?  #.function? function?  #.null? null?  #.symbol? symbol?  #.compare compare  #.boolean? boolean?  #.fixnum? fixnum?  #.atom? atom?  #.= =  #.number? number?  #.* *)))

+	    builtin->instruction #fn("8000n120A0O63:" #(#fn(get)) #(#table(#.cadr cadr  #.aset! aset!  #.+ +  #.- -  #.equal? equal?  #.eq? eq?  #.builtin? builtin?  #.not not  #.cons? cons?  #.cdr cdr  #./ /  #.div0 div0  #.set-car! set-car!  #.vector vector  #.set-cdr! set-cdr!  #.< <  #.for for  #.cons cons  #.apply apply  #.eqv? eqv?  #.vector? vector?  #.list list  #.aref aref  #.car car  #.bound? bound?  #.function? function?  #.null? null?  #.symbol? symbol?  #.compare compare  #.boolean? boolean?  #.fixnum? fixnum?  #.atom? atom?  #.= =  #.number? number?  #.* *)))

 	    caaaar #fn("5000n10<<<<:" #() caaaar) caaadr

 	    #fn("5000n10T<<:" #() caaadr) caaar #fn("5000n10<<<:" #() caaar)

 	    caadar #fn("5000n10<T<:" #() caadar) caaddr

@@ -139,7 +139,7 @@

 	    compile-f #fn("8000n2702101>22262:" #(call-with-values #fn("7000n070AF62:" #(compile-f-))

 						  #fn("5000n20:" #())) compile-f)

 	    compile-f- #fn("O000n270501T711T517215173741T52711518;J7025@408;87H360E@802687518=268:51~73778:528:\x85\xa208?JL07886298>88J708=@508=U54@r07:867;2<7=2<7>8?527?268?5151535152478862@8>268?5188J708=@508=U5547A8608:898>55@30D47B8=2C523I0788688J702D@402E8=53@W088\x85?078862F8=53@E08:J?078862G8=53@30O47H0897I7J1518952537K868@<52486r4268951r4Mp47L868@D7J15154478862M5247N2O7P7Q8651517R86518<537S865162:" #(make-code-emitter

-  lastcdr lambda:vars filter pair? λ #fn(length) keyword-arg? emit optargs

+  lastcdr lambda:vars filter cons? λ #fn(length) keyword-arg? emit optargs

   bcode:indexfor make-perfect-hash-table #fn(map) cons car iota keyargs

   emit-optional-arg-inits > 255 largc lvargc vargc argc extend-env

   complex-bindings lambda:body box-vars compile-in ret values #fn(function)

--- a/flisp.c

+++ b/flisp.c

@@ -917,7 +917,7 @@

 		GOTO_OP_OFFSET(OP_SETA),

 		GOTO_OP_OFFSET(OP_JMP),

 		GOTO_OP_OFFSET(OP_LOADC0),

-		GOTO_OP_OFFSET(OP_PAIRP),

+		GOTO_OP_OFFSET(OP_CONSP),

 		GOTO_OP_OFFSET(OP_BRNE),

 		GOTO_OP_OFFSET(OP_LOADT),

 		GOTO_OP_OFFSET(OP_LOAD0),

@@ -1233,7 +1233,7 @@

 			PUSH(vector_elt(FL(stack)[bp+nargs], 0));

 			NEXT_OP;

-		OP(OP_PAIRP)

+		OP(OP_CONSP)

 			FL(stack)[FL(sp)-1] = iscons(FL(stack)[FL(sp)-1]) ? FL_t : FL_f;

 			NEXT_OP;

--- a/gen.lsp

+++ b/gen.lsp

@@ -18,7 +18,7 @@

     OP_SETA           seta      #f      0

     OP_JMP            jmp       #f      0

     OP_LOADC0         loadc0    #f      0

-    OP_PAIRP          pair?     1       (λ (x) (pair? x))

+    OP_CONSP          cons?     1       (λ (x) (cons? x))

     OP_BRNE           brne      #f      0

     OP_LOADT          loadt     #f      0

     OP_LOAD0          load0     #f      0

@@ -97,7 +97,7 @@

 ))

 (define (for-each-n f lst n)

-  (when (and (> n 0) (pair? lst)) (begin (apply f (list-head lst n))

+  (when (and (> n 0) (cons? lst)) (begin (apply f (list-head lst n))

                                          (for-each-n f (list-tail lst n) n))))

 (let ((c-header     (file "opcodes.h"        :write :create :truncate))

--- a/opcodes.c

+++ b/opcodes.c

@@ -10,8 +10,9 @@

 	[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},

@@ -28,9 +29,8 @@

 	[OP_BUILTINP] = {"builtin?", 1},

 	[OP_SUB] = {"-", -1},

 	[OP_COMPARE] = {"compare", 2},

-	[OP_PAIRP] = {"pair?", 1},

-	[OP_MUL] = {"*", ANYARGS},

 	[OP_FOR] = {"for", 3},

+	[OP_MUL] = {"*", ANYARGS},

 	[OP_ADD] = {"+", ANYARGS},

 	[OP_AREF] = {"aref", -2},

 	[OP_DIV] = {"/", -1},

--- a/opcodes.h

+++ b/opcodes.h

@@ -17,7 +17,7 @@

 	OP_SETA,

 	OP_JMP,

 	OP_LOADC0,

-	OP_PAIRP,

+	OP_CONSP,

 	OP_BRNE,

 	OP_LOADT,

 	OP_LOAD0,

--- a/system.lsp

+++ b/system.lsp

@@ -28,11 +28,11 @@

                (set! binds (car body))

                (set! body (cdr body))))

     (let ((thelambda

-           `(λ ,(map (λ (c) (if (pair? c) (car c) c))

+           `(λ ,(map (λ (c) (if (cons? c) (car c) c))

                           binds)

               ,@body))

           (theargs

-           (map (λ (c) (if (pair? c) (cadr c) (void))) binds)))

+           (map (λ (c) (if (cons? c) (cadr c) (void))) binds)))

       (cons (if lname

                 `(letrec ((,lname ,thelambda)) ,lname)

                 thelambda)

@@ -128,7 +128,7 @@

 (define (char? x) (eq? (typeof x) 'rune))

 (define (array? x) (or (vector? x)

                        (let ((t (typeof x)))

-                         (and (pair? t) (eq? (car t) 'array)))))

+                         (and (cons? t) (eq? (car t) 'array)))))

 (define (closure? x) (and (function? x) (not (builtin? x))))

 (define (caar x) (car (car x)))

@@ -162,13 +162,13 @@

 (let ((*values* (list '*values*)))

   (set! values

         (λ vs

-          (if (and (pair? vs) (null? (cdr vs)))

+          (if (and (cons? vs) (null? (cdr vs)))

               (car vs)

               (cons *values* vs))))

   (set! call-with-values

         (λ (producer consumer)

           (let ((res (producer)))

-            (if (and (pair? res) (eq? *values* (car res)))

+            (if (and (cons? res) (eq? *values* (car res)))

                 (apply consumer (cdr res))

                 (consumer res))))))

@@ -180,11 +180,11 @@

            (every pred (cdr lst)))))

 (define (any pred lst)

-  (and (pair? lst)

+  (and (cons? lst)

        (or (pred (car lst))

            (any pred (cdr lst)))))

-(define (list? a) (or (null? a) (and (pair? a) (list? (cdr a)))))

+(define (list? a) (or (null? a) (and (cons? a) (list? (cdr a)))))

 (define (list-tail lst n)

   (if (<= n 0) lst

@@ -209,7 +209,7 @@

 (define (length> lst n)

   (cond ((< n 0)     lst)

-        ((= n 0)     (and (pair? lst) lst))

+        ((= n 0)     (and (cons? lst) lst))

         ((atom? lst) (< n 0))

         (else        (length> (cdr lst) (- n 1)))))

@@ -230,7 +230,7 @@

 (define (map! f lst)

   (prog1 lst

-         (while (pair? lst)

+         (while (cons? lst)

                 (set-car! lst (f (car lst)))

                 (set! lst (cdr lst)))))

@@ -238,7 +238,7 @@

   (define (filter- f lst acc)

     (cdr

      (prog1 acc

-      (while (pair? lst)

+      (while (cons? lst)

              (begin (if (pred (car lst))

                         (set! acc

                               (cdr (set-cdr! acc (cons (car lst) ())))))

@@ -250,7 +250,7 @@

     (let ((vals

            (prog1

             (cons yes no)

-            (while (pair? lst)

+            (while (cons? lst)

                    (begin (if (pred (car lst))

                               (set! yes

                                     (cdr (set-cdr! yes (cons (car lst) ()))))

@@ -288,7 +288,7 @@

 (define (reverse lst) (reverse- () lst))

 (define (reverse!- prev l)

-  (while (pair? l)

+  (while (cons? l)

          (set! l (prog1 (cdr l)

                         (set-cdr! l (prog1 prev

                                            (set! prev l))))))

@@ -336,7 +336,7 @@

 (define-macro (quasiquote x) (bq-process x 0))

 (define (splice-form? x)

-  (or (and (pair? x) (or (eq? (car x) 'unquote-splicing)

+  (or (and (cons? x) (or (eq? (car x) 'unquote-splicing)

                          (eq? (car x) 'unquote-nsplicing)

                          (and (eq? (car x) 'unquote)

                               (length> x 2))))

@@ -344,7 +344,7 @@

 ;; bracket without splicing

 (define (bq-bracket1 x d)

-  (if (and (pair? x) (eq? (car x) 'unquote))

+  (if (and (cons? x) (eq? (car x) 'unquote))

       (if (= d 0)

           (cadr x)

           (list cons ''unquote

@@ -396,7 +396,7 @@

          (let loop ((p x) (q ()))

            (cond ((null? p) ;; proper list

                   (cons 'nconc (reverse! q)))

-                 ((pair? p)

+                 ((cons? p)

                   (cond ((eq? (car p) 'unquote)

                          ;; (... . ,x)

                          (cons 'nconc

@@ -422,7 +422,7 @@

 (define-macro (let* binds . body)

   (if (atom? binds) `((λ () ,@body))

       `((λ (,(caar binds))

-          ,@(if (pair? (cdr binds))

+          ,@(if (cons? (cdr binds))

                 `((let* ,(cdr binds) ,@body))

                 body))

         ,(cadar binds))))

@@ -453,7 +453,7 @@

         (vars  (map car  vars))

         (inits (map cadr vars))

         (steps (map (λ (x)

-                      (if (pair? (cddr x))

+                      (if (cons? (cddr x))

                           (caddr x)

                           (car x)))

                     vars)))

@@ -509,7 +509,7 @@

 (define-macro (catch tag expr)

   (let ((e (gensym)))

     `(trycatch ,expr

-               (λ (,e) (if (and (pair? ,e)

+               (λ (,e) (if (and (cons? ,e)

                                 (eq? (car  ,e) 'thrown-value)

                                 (eq? (cadr ,e) ,tag))

                            (caddr ,e)

@@ -713,7 +713,7 @@

     (cond ((atom? body) body)

           ((equal? body '((begin)))

            body)

-          ((and (pair? (car body))

+          ((and (cons? (car body))

                 (eq? (caar body) 'begin))

            (append (splice-begin (cdar body)) (splice-begin (cdr body))))

           (else

@@ -734,7 +734,7 @@

               (let* ((ex-nondefs    ; expand non-definitions

                       (let loop ((body body))

                         (cond ((atom? body) body)

-                              ((and (pair? (car body))

+                              ((and (cons? (car body))

                                     (eq? 'define (caar body)))

                                (cons (car body) (loop (cdr body))))

                               (else

@@ -746,7 +746,7 @@

                                   (cons *expanded* form)

                                   (loop (cdr body))))))))

                      (body ex-nondefs))

-                (while (pair? body) ; now expand deferred definitions

+                (while (cons? body) ; now expand deferred definitions

                        (if (not (eq? *expanded* (caar body)))

                            (set-car! body (expand-in (car body) env))

                            (set-car! body (cdar body)))

@@ -755,7 +755,7 @@

   (define (expand-lambda-list l env)

     (if (atom? l) l

-        (cons (if (and (pair? (car l)) (pair? (cdr (car l))))

+        (cons (if (and (cons? (car l)) (cons? (cdr (car l))))

                   (list (caar l) (expand-in (cadar l) env))

                   (car l))

               (expand-lambda-list (cdr l) env))))

@@ -762,7 +762,7 @@

   (define (l-vars l)

     (cond ((atom? l)       (list l))

-          ((pair? (car l)) (cons (caar l) (l-vars (cdr l))))

+          ((cons? (car l)) (cons (caar l) (l-vars (cdr l))))

           (else            (cons (car l)  (l-vars (cdr l))))))

   (define (expand-lambda e env)

@@ -817,7 +817,7 @@

                                           (car e)

                                           (expand-in (car e) env))

                                       (loop (cdr e))))))))

-          (cond ((and bnd (pair? (cdr bnd)))  ; local macro

+          (cond ((and bnd (cons? (cdr bnd)))  ; local macro

                  (expand-in (apply (cadr bnd) (cdr e))

                             (local-expansion-env (caddr bnd) env)))

                 ((or bnd                      ; bound lexical or toplevel var

@@ -916,29 +916,29 @@

      st)))

 (define (print-exception e)

-  (cond ((and (pair? e)

+  (cond ((and (cons? e)

               (eq? (car e) 'type-error)

               (length= e 3))

          (princ "type error: expected " (cadr e) ", got " (typeof (caddr e)) ": ")

          (print (caddr e)))

-        ((and (pair? e)

+        ((and (cons? e)

               (eq? (car e) 'bounds-error)

               (length= e 3))

          (princ "index " (caddr e) " out of bounds for ")

          (print (cadr e)))

-        ((and (pair? e)

+        ((and (cons? e)

               (eq? (car e) 'unbound-error)

               (length= e 2))

          (princ "eval: variable " (cadr e) " has no value"))

-        ((and (pair? e)

+        ((and (cons? e)

               (eq? (car e) 'error))

          (princ "error: ")

          (apply princ (cdr e)))

-        ((and (pair? e)

+        ((and (cons? e)

               (eq? (car e) 'load-error))

          (print-exception (caddr e))

          (princ "in file " (cadr e)))

@@ -1009,7 +1009,7 @@

 (define (__start argv)

   (__init_globals)

-  (if (pair? (cdr argv))

+  (if (cons? (cdr argv))

       (begin (set! *argv* (cdr argv))

              (set! *interactive* #f)

              (__script (cadr argv)))

--- a/test/ast/asttools.lsp

+++ b/test/ast/asttools.lsp

@@ -21,23 +21,23 @@

 (define (maptree-pre f tr)

   (let ((new-t (f tr)))

-    (if (pair? new-t)

+    (if (cons? new-t)

         (map (lambda (e) (maptree-pre f e)) new-t)

       new-t)))

 (define (maptree-post f tr)

-  (if (not (pair? tr))

+  (if (not (cons? tr))

       (f tr)

     (let ((new-t (map (lambda (e) (maptree-post f e)) tr)))

       (f new-t))))

 (define (foldtree-pre f t zero)

-  (if (not (pair? t))

+  (if (not (cons? t))

       (f t zero)

       (foldl t (lambda (e state) (foldtree-pre f e state)) (f t zero))))

 (define (foldtree-post f t zero)

-  (if (not (pair? t))

+  (if (not (cons? t))

       (f t zero)

       (f t (foldl t (lambda (e state) (foldtree-post f e state)) zero))))

@@ -49,7 +49,7 @@

 ; (mapper tree state) - should return transformed tree given current state

 ; (folder tree state) - should return new state

 (define (map&fold t zero mapper folder)

-  (let ((head (and (pair? t) (car t))))

+  (let ((head (and (cons? t) (car t))))

     (cond ((eq? head 'quote)

 	   t)

 	  ((or (eq? head 'the) (eq? head 'meta))

@@ -59,7 +59,7 @@

 	  (else

 	   (let ((new-s (folder t zero)))

 	     (mapper

-	      (if (pair? t)

+	      (if (cons? t)

 		  ; head symbol is a tag; never transform it

 		  (cons (car t)

 			(map (lambda (e) (map&fold e new-s mapper folder))

@@ -79,7 +79,7 @@

   (map&fold t () f

 	    (lambda (tree state)

 	      (if (and (eq? (car t) 'lambda)

-		       (pair? (cdr t)))

+		       (cons? (cdr t)))

 		  (append.2 (cadr t) state)

 		  state))))

@@ -86,10 +86,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 (pair? node)

+                  (if (and (cons? node)

                            (eq (car node) op)

-                           (pair? (cdr node))

-                           (pair? (cadr node))

+                           (cons? (cdr node))

+                           (cons? (cadr node))

                            (eq (caadr node) op))

                       (cons op

                             (append (cdadr node) (cddr node)))

@@ -107,7 +107,7 @@

         (lookup-var v (cdr env) (+ lev 1))))))

 (define (lvc- e env)

   (cond ((symbol? e) (lookup-var e env 0))

-        ((pair? e)

+        ((cons? e)

          (if (eq (car e) 'quote)

              e

 	     (let* ((newvs (and (eq (car e) 'lambda) (cadr e)))

@@ -125,7 +125,7 @@

 ; convert let to lambda

 (define (let-expand e)

   (maptree-post (lambda (n)

-		  (if (and (pair? n) (eq (car n) 'let))

+		  (if (and (cons? n) (eq (car n) 'let))

 		      `((lambda ,(map car (cadr n)) ,@(cddr n))

 			,@(map cadr (cadr n)))

                     n))

@@ -147,7 +147,7 @@

 		  t))

 	    ; folder: add locals to environment if entering a new scope

 	    (lambda (t env)

-	      (if (and (pair? t) (or (eq? (car t) 'let)

+	      (if (and (cons? t) (or (eq? (car t) 'let)

 				     (eq? (car t) 'lambda)))

 		  (append (cadr t) env)

 		  env))))

--- a/test/ast/match.lsp

+++ b/test/ast/match.lsp

@@ -50,7 +50,7 @@

 	((procedure? p)

 	 (and (p expr) state))

-	((pair? p)

+	((cons? 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) '--)

@@ -59,7 +59,7 @@

 	       ((eq (car p) '-$)  ; greedy alternation for toplevel pattern

 		(match-alt (cdr p) () (list expr) state #f 1))

 	       (#t

-		(and (pair? expr)

+		(and (cons? expr)

 		     (equal? (car p) (car expr))

 		     (match-seq (cdr p) (cdr expr) state (length (cdr expr)))))))

@@ -107,12 +107,12 @@

 	(#t

 	 (let ((subp (car p))

 	       (var  #f))

-	   (if (and (pair? subp)

+	   (if (and (cons? subp)

 		    (eq (car subp) '--))

 	       (begin (set! var (cadr subp))

                       (set! subp (caddr subp)))

 	       #f)

-	   (let ((head (if (pair? subp) (car subp) ())))

+	   (let ((head (if (cons? subp) (car subp) ())))

 	     (cond ((eq subp '...)

 		    (match-star '_ (cdr p) expr state var 0 L L))

 		   ((eq head '-*)

@@ -124,7 +124,7 @@

 		   ((eq head '-$)

 		    (match-alt (cdr subp) (cdr p) expr state var L))

 		   (#t

-		    (and (pair? expr)

+		    (and (cons? expr)

 			 (match-seq (cdr p) (cdr expr)

 				    (match- (car p) (car expr) state)

 				    (- L 1))))))))))

@@ -137,7 +137,7 @@

               (not (member p metasymbols)))

          (list p))

-        ((pair? p)

+        ((cons? p)

          (if (eq (car p) '-/)

              ()

 	     (unique (apply append (map patargs- (cdr p))))))

@@ -170,7 +170,7 @@

 ; (pattern-lambda (/ 2 3) '(/ 3 2)), (pattern-lambda (/ 3 2) '(/ 2 3))

 ; TODO: ignore quoted expressions

 (define (pattern-expand plist expr)

-  (if (not (pair? expr))

+  (if (not (cons? expr))

       expr

       (let ((enew (apply-patterns plist expr)))

 	(if (eq enew expr)

--- a/test/ast/match.scm

+++ b/test/ast/match.scm

@@ -42,7 +42,7 @@

 	((procedure? p)

 	 (and (p expr) state))

-	((pair? p)

+	((cons? 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) '--)

@@ -51,7 +51,7 @@

 	       ((eq? (car p) '-$)  ; greedy alternation for toplevel pattern

 		(match-alt (cdr p) () (list expr) state #f 1))

 	       (else

-		(and (pair? expr)

+		(and (cons? expr)

 		     (equal? (car p) (car expr))

 		     (match-seq (cdr p) (cdr expr) state (length (cdr expr)))))))

@@ -100,12 +100,12 @@

 	(else

 	 (let ((subp (car p))

 	       (var  #f))

-	   (if (and (pair? subp)

+	   (if (and (cons? subp)

 		    (eq? (car subp) '--))

 	       (begin (set! var (cadr subp))

 		      (set! subp (caddr subp)))

 	       #f)

-	   (let ((head (if (pair? subp) (car subp) ())))

+	   (let ((head (if (cons? subp) (car subp) ())))

 	     (cond ((eq? subp '...)

 		    (match-star '_ (cdr p) expr state var 0 L L))

 		   ((eq? head '-*)

@@ -117,7 +117,7 @@

 		   ((eq? head '-$)

 		    (match-alt (cdr subp) (cdr p) expr state var L))

 		   (else

-		    (and (pair? expr)

+		    (and (cons? expr)

 			 (match-seq (cdr p) (cdr expr)

 				    (match- (car p) (car expr) state)

 				    (- L 1))))))))))

@@ -131,7 +131,7 @@

 		(not (member p metasymbols)))

 	   (list p))

-	  ((pair? p)

+	  ((cons? p)

 	   (if (eq? (car p) '-/)

 	       ()

 	       (delete-duplicates (apply append (map patargs- (cdr p))))))

@@ -163,7 +163,7 @@

 ; (pattern-lambda (/ 2 3) '(/ 3 2)), (pattern-lambda (/ 3 2) '(/ 2 3))

 ; TODO: ignore quoted expressions

 (define (pattern-expand plist expr)

-  (if (not (pair? expr))

+  (if (not (cons? expr))

       expr

       (let ((enew (apply-patterns plist expr)))

 	(if (eq? enew expr)

--- a/test/ast/rpasses.lsp

+++ b/test/ast/rpasses.lsp

@@ -7,7 +7,7 @@

 ; tree inspection utils

 (define (assigned-var e)

-  (and (pair? e)

+  (and (cons? e)

        (or (eq (car e) '<-) (eq (car e) 'ref=))

        (symbol? (cadr e))

        (cadr e)))

@@ -27,13 +27,13 @@

 (define (dollarsign-transform e)

   (pattern-expand

    (pattern-lambda ($ lhs name)

-		   (let* ((g (if (not (pair? lhs)) lhs (r-gensym)))

+		   (let* ((g (if (not (cons? 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 (pair? lhs))

+		     (if (not (cons? lhs))

 			 expr

                        `(r-block (ref= ,g ,lhs) ,expr))))

    e))

@@ -47,9 +47,9 @@

   (pattern-expand

    (pattern-lambda (-$ (<-  (r-call f lhs ...) rhs)

                        (<<- (r-call f lhs ...) rhs))

-		   (let ((g  (if (pair? rhs) (r-gensym) rhs))

+		   (let ((g  (if (cons? rhs) (r-gensym) rhs))

                          (op (car __)))

-		     `(r-block ,@(if (pair? rhs) `((ref= ,g ,rhs)) ())

+		     `(r-block ,@(if (cons? rhs) `((ref= ,g ,rhs)) ())

                                (,op ,lhs (r-call ,(symconcat f '<-) ,@(cddr (cadr __)) ,g))

                                ,g)))

    e))

@@ -69,10 +69,10 @@

 ; convert r function expressions to lambda

 (define (normalize-r-functions e)

   (maptree-post (lambda (n)

-		  (if (and (pair? n) (eq (car n) 'function))

+		  (if (and (cons? n) (eq (car n) 'function))

 		      `(lambda ,(func-argnames n)

 			 (r-block ,@(gen-default-inits (cadr n))

-				  ,@(if (and (pair? (caddr n))

+				  ,@(if (and (cons? (caddr n))

 					     (eq (car (caddr n)) 'r-block))

 					(cdr (caddr n))

                                       (list (caddr n)))))

@@ -82,7 +82,7 @@

 (define (find-assigned-vars n)

   (let ((vars ()))

     (maptree-pre (lambda (s)

-		   (if (not (pair? s)) s

+		   (if (not (cons? s)) s

                      (cond ((eq (car s) 'lambda) ())

                            ((eq (car s) '<-)

                             (set! vars (list-adjoin (cadr s) vars))

@@ -94,7 +94,7 @@

 ; introduce let based on assignment statements

 (define (letbind-locals e)

   (maptree-post (lambda (n)

-                  (if (and (pair? n) (eq (car n) 'lambda))

+                  (if (and (cons? n) (eq (car n) 'lambda))

                       (let ((vars (find-assigned-vars (cddr n))))

                         `(lambda ,(cadr n) (let ,(map (lambda (v) (list v ()))

                                                       vars)

--- a/test/color.lsp

+++ b/test/color.lsp

@@ -46,7 +46,7 @@

         (map

          (λ (n)

            (let ((color-pair (assq n coloring)))

-             (if (pair? color-pair) (cdr color-pair) ())))

+             (if (cons? color-pair) (cdr color-pair) ())))

          (graph-neighbors g node-to-color)))))

 (define (try-each f lst)

--- a/test/equal.scm

+++ b/test/equal.scm

@@ -7,7 +7,7 @@

 ; nontermination, otherwise #t or #f for the correct answer.

 (define (bounded-equal a b N)

   (cond ((<= N 0) 0)

-	((and (pair? a) (pair? b))

+	((and (cons? a) (cons? b))

 	 (let ((as

 		(bounded-equal (car a) (car b) (- N 1))))

 	   (if (number? as)

@@ -43,7 +43,7 @@

 ; set them equal and move on.

 (define (cyc-equal a b table)

   (cond ((eq? a b)  #t)

-	((not (and (pair? a) (pair? b)))  (eq? a b))

+	((not (and (cons? a) (cons? b)))  (eq? a b))

 	(else

 	 (let ((aa (car a))  (da (cdr a))

 	       (ab (car b))  (db (cdr b)))

--- a/test/test.lsp

+++ b/test/test.lsp

@@ -95,7 +95,7 @@

   (filter (λ (e) (not (eq e x))) l))

 (define (conscount c)

-  (if (pair? c) (+ 1

+  (if (cons? c) (+ 1

                    (conscount (car c))

                    (conscount (cdr c)))

       0))

@@ -135,7 +135,7 @@

                        (todo   (f-body (cddr  catc))))

                    `(λ (,var)

                       (if (or (eq ,var ',extype)

-                              (and (pair? ,var)

+                              (and (cons? ,var)

                                    (eq (car ,var) ',extype)))

                           ,todo

                         (,next ,var)))))

@@ -190,7 +190,7 @@

 (define (map-indexed f lst)

   (if (atom? lst) lst

     (let ((i 0))

-      (accumulate-while (pair? lst) (f (car lst) i)

+      (accumulate-while (cons? lst) (f (car lst) i)

                         (begin (set! lst (cdr lst))

                                (set! i (1+ i)))))))

--- a/test/unittest.lsp

+++ b/test/unittest.lsp

@@ -444,7 +444,7 @@

          not      1      null?    1

          boolean? 1      symbol?  1

          number?  1      bound?   1

-         pair?    1      builtin? 1

+         cons?    1      builtin? 1

          vector?  1      fixnum?  1

          cons     2      car      1

          cdr      1      set-car! 2