git » jacl.git » commit c6074e0

Fix COND, add CL::DESIGNATED-STRING

author Alan Dipert
2020-01-31 01:12:50 UTC
committer Alan Dipert
2020-01-31 01:12:50 UTC
parent a1cd176d3fe07b546a45212fdf3f925e39dca3a2

Fix COND, add CL::DESIGNATED-STRING

boot.lisp +20 -6

diff --git a/boot.lisp b/boot.lisp
index 38d3644..1a0619d 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -70,22 +70,28 @@
 (defun not (x) (eq x nil))
 
 (export 'car)
-(defun car (x) (jacl:\. x |car|))
+(defun car (x)
+  (when (not (null x))
+    (jacl:\. x |car|)))
 
 (export 'cdr)
-(defun cdr (x) (jacl:\. x |cdr|))
+(defun cdr (x)
+  (when (not (null x))
+    (jacl:\. x |cdr|)))
 
 (export 'caar)
-(defun caar (x) (car (car x)))
+(defun caar (x)
+  (car (car x)))
 
-(export 'cdar)
-(defun cdar (x) (car (cdr x)))
+(export 'cadar)
+(defun cadar (x)
+  (car (cdr (car x))))
 
 (export 'cond)
 (defmacro cond (&rest clauses)
   (when clauses
     `(if ,(caar clauses)
-         ,(cdar clauses)
+         ,(cadar clauses)
        (cond ,@(cdr clauses)))))
 
 (export 'numberp)
@@ -108,6 +114,14 @@
 (defmacro go (tag)
   `(jacl:%go ,tag))
 
+(defun designated-string (x)
+  (cond ((stringp x) x)
+        ((symbolp x)
+         (jacl:\. (jacl:%js "LispString") (|fromString| (jacl:\. x |name|))))
+        (t (jacl:%throw
+            (jacl:%new (jacl:%js "TypeError")
+                       (jacl:\. "Not a string designator" (|toString|)))))))
+
 ;; Use COMMON-LISP from COMMON-LISP-USER and switch to
 ;; COMMON-LISP-USER
 (%let ((cl-user-pkg (\. (%js "Package") (|get| (\. '#:common-lisp-user |name|)))))