LAST and BUTLAST work for improper lists

[jscl.git] / lispstrack.lisp

diff --git a/lispstrack.lisp b/lispstrack.lisp
index 5a23bdb..562f004 100644 (file)
--- a/lispstrack.lisp
+++ b/lispstrack.lisp
@@ -273,14 +273,13 @@
       (t (nth (1- n) (cdr list)))))
 
   (defun last (x)
-    (if (null (cdr x))
-        x
-        (last (cdr x))))
+    (if (consp (cdr x))
+        (last (cdr x))
+        x))
 
   (defun butlast (x)
-    (if (null (cdr x))
-        nil
-        (cons (car x) (butlast (cdr x)))))
+    (and (consp (cdr x))
+         (cons (car x) (butlast (cdr x)))))
 
   (defun member (x list)
     (cond
@@ -323,6 +322,15 @@
         (- x #\0)
         nil))
 
+  (defun subseq (seq a &optional b)
+    (cond
+     ((stringp seq)
+      (if b
+          (slice seq a b)
+          (slice seq a)))
+     (t
+      (error "Unsupported argument."))))
+
   (defun parse-integer (string)
     (let ((value 0)
           (index 0)
@@ -418,8 +426,7 @@
          (push (mod x 10) digits)
          (setq x (truncate x 10)))
        (join (mapcar (lambda (d) (string (char "0123456789" d)))
-                     digits)
-             "")))))
+                     digits))))))
 
 (defun print-to-string (form)
   (cond
@@ -752,7 +759,7 @@
                                              cases)
                                        (incf idx)))
                                    (push (concat "default: break;" *newline*) cases)
-                                   (join (reverse cases) "")))
+                                   (join (reverse cases))))
                           "}" *newline*)
                   "")
               ;; &rest argument
@@ -983,6 +990,17 @@
 (define-compilation string-length (x)
   (concat "(" (ls-compile x env fenv) ").length"))
 
+(define-compilation slice (string a &optional b)
+  (concat "(function(){" *newline*
+          "var str = " (ls-compile string env fenv) ";" *newline*
+          "var a = " (ls-compile a env fenv) ";" *newline*
+          "var b;" *newline*
+          (if b
+              (concat "b = " (ls-compile b env fenv) ";" *newline*)
+              "")
+          "return str.slice(a,b);" *newline*
+          "})()"))
+
 (define-compilation char (string index)
   (concat "("
           (ls-compile string env fenv)
@@ -1105,8 +1123,7 @@
   (let ((code (ls-compile sexp nil nil)))
     (prog1
         (concat (join (mapcar (lambda (x) (concat x ";" *newline*))
-                              *toplevel-compilations*)
-               "")
+                              *toplevel-compilations*))
                 code)
       (setq *toplevel-compilations* nil))))