Index: gnu/commonlisp/lang/ChangeLog =================================================================== --- gnu/commonlisp/lang/ChangeLog (revision 7783) +++ gnu/commonlisp/lang/ChangeLog (working copy) @@ -1,3 +1,9 @@ +2014-02-07 Charles Turner + + * CommonLisp.java: Change NOT to be defined as in Scheme, so that + it gets picked up as a procedure. Also added first, cdr, rest, + second, third, nthcdr, nth, 1- and 1+. + 2014-02-06 Charles Turner * CommonLisp.java: Proof-of-concept start to loading the CL Index: gnu/commonlisp/lang/CommonLisp.java =================================================================== --- gnu/commonlisp/lang/CommonLisp.java (revision 7783) +++ gnu/commonlisp/lang/CommonLisp.java (working copy) @@ -7,6 +7,7 @@ import gnu.expr.*; import gnu.text.Char; import kawa.standard.Scheme; +import gnu.kawa.functions.*; import gnu.bytecode.Type; import gnu.kawa.lispexpr.LangPrimType; import gnu.kawa.functions.DisplayFormat; @@ -64,7 +65,8 @@ public static final NumberCompare numLss; public static final NumberCompare numLEq; - public static final gnu.kawa.functions.IsEq isEq; + public static final Not not; + public static final IsEq isEq; /** Package location symbols. */ public static final Symbol internalKeyword = Keyword.make("INTERNAL"); @@ -77,6 +79,7 @@ instance.define("t", TRUE); instance.define("nil", FALSE); + not = new Not(instance, "not"); numEqu = NumberCompare.make(instance, "=", NumberCompare.TRUE_IF_EQU); numGrt = NumberCompare.make(instance, ">", @@ -146,11 +149,9 @@ defun("prog2", prog1.prog2); defun("progn", new kawa.standard.begin()); defun("unwind-protect", new gnu.commonlisp.lang.UnwindProtect()); - Procedure not = new gnu.kawa.functions.Not(this); - defun("not", not); defun("null", not); - defun("eq", new gnu.kawa.functions.IsEq(this, "eq")); - defun("equal", new gnu.kawa.functions.IsEqual(this, "equal")); + defun("eq", new IsEq(this, "eq")); + defun("equal", new IsEqual(this, "equal")); defun("typep", new gnu.kawa.reflect.InstanceOf(this)); defProcStFld("the", "gnu.kawa.functions.Convert", "as"); defun("%flet", new kawa.standard.let("flet", true)); @@ -163,9 +164,18 @@ defProcStFld(">", "gnu.commonlisp.lang.CommonLisp", "numGrt"); defProcStFld("<=", "gnu.commonlisp.lang.CommonLisp", "numLEq"); defProcStFld(">=", "gnu.commonlisp.lang.CommonLisp", "numGEq"); - + defProcStFld("not", "gnu.commonlisp.lang.CommonLisp"); defProcStFld("functionp", "gnu.commonlisp.lisp.PrimOps"); defProcStFld("car", "gnu.commonlisp.lisp.primitives"); + defProcStFld("first", "gnu.commonlisp.lisp.primitives"); + defProcStFld("cdr", "gnu.commonlisp.lisp.primitives"); + defProcStFld("rest", "gnu.commonlisp.lisp.primitives"); + defProcStFld("second", "gnu.commonlisp.lisp.primitives"); + defProcStFld("third", "gnu.commonlisp.lisp.primitives"); + defProcStFld("nthcdr", "gnu.commonlisp.lisp.primitives"); + defProcStFld("nth", "gnu.commonlisp.lisp.primitives"); + defProcStFld("1-", "gnu.commonlisp.lisp.primitives"); + defProcStFld("1+", "gnu.commonlisp.lisp.primitives"); } public static CommonLisp getInstance() Index: gnu/commonlisp/lisp/ChangeLog =================================================================== --- gnu/commonlisp/lisp/ChangeLog (revision 7783) +++ gnu/commonlisp/lisp/ChangeLog (working copy) @@ -1,3 +1,9 @@ +2014-02-07 Charles Turner + + * PrimsOps.scm (cdr): Remove. + * primitives.lisp: Added first, cdr, rest, second, third, nthcdr, + nth, 1- and 1+. + 2014-02-06 Per Bothner * PrimOps.scm (car): Remove. Index: gnu/commonlisp/lisp/PrimOps.scm =================================================================== --- gnu/commonlisp/lisp/PrimOps.scm (revision 7783) +++ gnu/commonlisp/lisp/PrimOps.scm (working copy) @@ -2,9 +2,6 @@ ;;; They should be re-written in Common Lisp, but there are still some ;;; limitations in the Common Lisp support making that difficult. -(define (cdr x) - (if (eq? x '()) x ((as x):getCdr))) - (define (setcar (p ) x) (set-car! p x)) Index: gnu/commonlisp/lisp/primitives.lisp =================================================================== --- gnu/commonlisp/lisp/primitives.lisp (working copy) +++ gnu/commonlisp/lisp/primitives.lisp (working copy) @@ -2,3 +2,32 @@ (if (null x) nil (invoke (the pair x) '|getCar|))) + +(defun first (x) + (car x)) + +(defun cdr (x) + (if (null x) + nil + (invoke (the pair x) '|getCdr|))) + +(defun rest (x) + (cdr x)) + +(defun second (x) + (first (rest x))) + +(defun third (x) + (first (rest (rest x)))) + +(defun nthcdr (n lst) + (declare (int n)) + (do ((i n (1- i)) + (result lst (cdr result))) + ((= i 0) result))) + +(defun nth (n x) + (first (nthcdr n x))) + +(defun 1- (x) (- x 1)) +(defun 1+ (x) (+ x 1)) Index: gnu/commonlisp/testsuite/ChangeLog =================================================================== --- gnu/commonlisp/testsuite/ChangeLog (revision 7783) +++ gnu/commonlisp/testsuite/ChangeLog (working copy) @@ -1,3 +1,9 @@ +2014-02-07 Charles Turner + + * lang-test.lisp: New tests for car, cdr, first, rest, nth and + nthcdr. + * warnings.lisp: Fix TODO item by using the new 1+ procedure. + 2013-08-25 Per Bothner * lang-test.lisp: Add test for '#' in token. Index: gnu/commonlisp/testsuite/lang-test.lisp =================================================================== --- gnu/commonlisp/testsuite/lang-test.lisp (revision 7783) +++ gnu/commonlisp/testsuite/lang-test.lisp (working copy) @@ -1,4 +1,4 @@ -(test-init "Common Lisp tests" 18) +(test-init "Common Lisp tests" 35) (setq y 100) (defun foo1 (x) @@ -52,3 +52,21 @@ ;; # is a non-terminating macro character in Common Lisp. (test '(|a#com#b|) 'sharp-in-token '(a#|com|#b)) + +(test nil 'car-1 (car nil)) +(test 1 'car-2 (car '(1 . 2))) +(test nil 'cdr-1 (cdr nil)) +(test 2 'cdr-2 (cdr '(1 . 2))) +(test nil 'first-1 (first nil)) +(test 1 'first-2 (first '(1 . 2))) +(test nil 'rest-1 (rest nil)) +(test 2 'rest-2 (rest '(1 . 2))) +(test 'foo 'nth-1 (nth 0 '(foo bar baz))) +(test 'bar 'nth-2 (nth 1 '(foo bar baz))) +(test nil 'nth-3 (nth 3 '(foo bar baz))) +(test nil 'nthcdr-1 (nthcdr 0 '())) +(test nil 'nthcdr-2 (nthcdr 3 '())) +(test '(a b c) 'nthcdr-3 (nthcdr 0 '(a b c))) +(test '(c) 'nthcdr-4 (nthcdr 2 '(a b c))) +(test '() 'nthcdr-5 (nthcdr 4 '(a b c))) +(test 1 'nthcdr-6 (nthcdr 1 '(0 . 1))) Index: gnu/commonlisp/testsuite/warnings.lisp =================================================================== --- gnu/commonlisp/testsuite/warnings.lisp (revision 7783) +++ gnu/commonlisp/testsuite/warnings.lisp (working copy) @@ -9,8 +9,7 @@ (defun list-of-numbers (start end) (if (> start end) nil - (cons start (list-of-numbers (+ 1 start) end)))) -; TODO: use the standard library function #'1+ instead + (cons start (list-of-numbers (1+ start) end)))) (defvar list-of-numbers (list-of-numbers 1 3)) (write list-of-numbers) (newline) @@ -20,7 +19,7 @@ (let* ((x y) (x (cdr (list-of-numbers x (+ x 3))))) (write (/ (car (cdr x)) 2)) (newline))) -;; Diagnostic: warnings.lisp:20:13: warning - no declaration seen for y +;; Diagnostic: warnings.lisp:19:13: warning - no declaration seen for y (write (apply #'list-of-numbers '(1 5))) (newline) ;; Output: (1 2 3 4 5)