X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=lispstrack.lisp;h=562f004228962bef1da46536f6d20b03534e825f;hb=7a3b48bc54c5540a963c6aca4c974ca90c41bfca;hp=5a23bdbba9ebeb39321fce1f38eb3f20c4072a80;hpb=6b2b1275c0d8fe4513db92cb3202ff37c118d927;p=jscl.git diff --git a/lispstrack.lisp b/lispstrack.lisp index 5a23bdb..562f004 100644 --- 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))))