X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=ecmalisp.lisp;h=d015254570b5531a763da031f01eb46881117707;hb=0294dcffc8c3a9f7bd0a2c5242a091fc33cbcc6e;hp=d042b0811769c01fe0269b6cbef5102b192a0122;hpb=517df84ae3cab89852b77ad9c4137cb6f1e55941;p=jscl.git diff --git a/ecmalisp.lisp b/ecmalisp.lisp index d042b08..d015254 100644 --- a/ecmalisp.lisp +++ b/ecmalisp.lisp @@ -98,8 +98,6 @@ ;; Basic functions (defun = (x y) (= x y)) - (defun + (x y) (+ x y)) - (defun - (x y) (- x y)) (defun * (x y) (* x y)) (defun / (x y) (/ x y)) (defun 1+ (x) (+ x 1)) @@ -249,6 +247,18 @@ ;;; constructions. #+ecmalisp (progn + (defun + (&rest args) + (let ((r 0)) + (dolist (x args r) + (incf r x)))) + + (defun - (x &rest others) + (if (null others) + (- x) + (let ((r x)) + (dolist (y others r) + (decf r y))))) + (defun append-two (list1 list2) (if (null list1) list2 @@ -1534,7 +1544,7 @@ decls) (concat "return " (progn ,@body) ";" *newline*))) -;;; VARIABLE-ARITY compiles variable arity operations. ARGS stand for +;;; VARIABLE-ARITY compiles variable arity operations. ARGS stands for ;;; a variable which holds a list of forms. It will compile them and ;;; store the result in some Javascript variables. BODY is evaluated ;;; with ARGS bound to the list of these variables to generate the @@ -1545,13 +1555,13 @@ (error "ARGS must be a non-empty list")) (let ((counter 0) (variables '()) - (prelude)) + (prelude "")) (dolist (x args) (let ((v (concat "x" (integer-to-string (incf counter))))) (push v variables) (concatf prelude (concat "var " v " = " (ls-compile x) ";" *newline* - "if (typeof " v " !=== 'number') throw 'Not a number!';" + "if (typeof " v " !== 'number') throw 'Not a number!';" *newline*)))) (js!selfcall prelude (funcall function (reverse variables))))) @@ -1568,8 +1578,20 @@ (type-check (("x" "number" x) ("y" "number" y)) (concat "x" op "y"))) -(define-builtin + (x y) (num-op-num x "+" y)) -(define-builtin - (x y) (num-op-num x "-" y)) +(define-raw-builtin + (&rest numbers) + (if (null numbers) + "0" + (variable-arity numbers + (join numbers "+")))) + +(define-raw-builtin - (x &rest others) + (let ((args (cons x others))) + (variable-arity args + (if (null others) + (concat "-" (car args)) + (join args "-"))))) + + (define-builtin * (x y) (num-op-num x "*" y)) (define-builtin / (x y) (num-op-num x "/" y))