X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=lispstrack.lisp;h=562f004228962bef1da46536f6d20b03534e825f;hb=7a3b48bc54c5540a963c6aca4c974ca90c41bfca;hp=288360bfa6cdb4a026620fe8b2372f7f3dcf2413;hpb=0530199ae143595a5fa0c18c25eaacef7639e84b;p=jscl.git diff --git a/lispstrack.lisp b/lispstrack.lisp index 288360b..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) @@ -407,15 +415,18 @@ (concat (car list) separator (join-trailing (cdr list) separator)))) (defun integer-to-string (x) - (if (zerop x) - "0" - (let ((digits nil)) - (while (not (zerop x)) - (push (mod x 10) digits) - (setq x (truncate x 10))) - (join (mapcar (lambda (d) (string (char "0123456789" d))) - digits) - "")))) + (cond + ((zerop x) + "0") + ((minusp x) + (concat "-" (integer-to-string (- 0 x)))) + (t + (let ((digits nil)) + (while (not (zerop x)) + (push (mod x 10) digits) + (setq x (truncate x 10))) + (join (mapcar (lambda (d) (string (char "0123456789" d))) + digits)))))) (defun print-to-string (form) (cond @@ -748,7 +759,7 @@ cases) (incf idx))) (push (concat "default: break;" *newline*) cases) - (join (reverse cases) ""))) + (join (reverse cases)))) "}" *newline*) "") ;; &rest argument @@ -979,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) @@ -1101,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))))