X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=ecmalisp.lisp;h=d015254570b5531a763da031f01eb46881117707;hb=0294dcffc8c3a9f7bd0a2c5242a091fc33cbcc6e;hp=46b92932bca175ecddedabad07b1eb37f57dfad3;hpb=ea250a1c0f5e0bc48a43fba2cdcaea1a7932cf0f;p=jscl.git diff --git a/ecmalisp.lisp b/ecmalisp.lisp index 46b9293..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,12 +1544,54 @@ decls) (concat "return " (progn ,@body) ";" *newline*))) +;;; 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 +;;; code which performs the transformation on these variables. + +(defun variable-arity-call (args function) + (unless (consp args) + (error "ARGS must be a non-empty list")) + (let ((counter 0) + (variables '()) + (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!';" + *newline*)))) + (js!selfcall prelude (funcall function (reverse variables))))) + + +(defmacro variable-arity (args &body body) + (unless (symbolp args) + (error "Bad usage of VARIABLE-ARITY, yo must pass a symbol")) + `(variable-arity-call ,args + (lambda (,args) + (concat "return " ,@body ";" *newline*)))) + + (defun num-op-num (x op y) (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))