X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=ecmalisp.lisp;h=05ef19c6787eebd4335fcad3e47ef5560f1ed9e1;hb=1c8b1cc2bde530d701c9dfd0c590b47708b76608;hp=d042b0811769c01fe0269b6cbef5102b192a0122;hpb=517df84ae3cab89852b77ad9c4137cb6f1e55941;p=jscl.git diff --git a/ecmalisp.lisp b/ecmalisp.lisp index d042b08..05ef19c 100644 --- a/ecmalisp.lisp +++ b/ecmalisp.lisp @@ -1534,7 +1534,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 @@ -1558,12 +1558,24 @@ (defmacro variable-arity (args &body body) (unless (symbolp args) - (error "Bad usage of VARIABLE-ARITY, yo must pass a symbol")) + (error "Bad usage of VARIABLE-ARITY, you must pass a symbol")) `(variable-arity-call ,args (lambda (,args) (concat "return " ,@body ";" *newline*)))) +(define-raw-builtin plus (&rest numbers) + (variable-arity numbers + (join numbers "+"))) + +(define-raw-builtin minus (x &rest others) + (let ((args (cons x others))) + (variable-arity args + (if (null others) + (concat "-" (car args)) + (join args "+"))))) + + (defun num-op-num (x op y) (type-check (("x" "number" x) ("y" "number" y)) (concat "x" op "y"))) @@ -1575,11 +1587,22 @@ (define-builtin mod (x y) (num-op-num x "%" y)) -(define-builtin < (x y) (js!bool (num-op-num x "<" y))) -(define-builtin > (x y) (js!bool (num-op-num x ">" y))) -(define-builtin = (x y) (js!bool (num-op-num x "==" y))) -(define-builtin <= (x y) (js!bool (num-op-num x "<=" y))) -(define-builtin >= (x y) (js!bool (num-op-num x ">=" y))) +(defmacro define-builtin-comparison (op sym) + `(define-raw-builtin ,op (&rest args) + (js!bool + (let ((x (car args)) + (res "true")) + (dolist (y (cdr args)) + (setq res (concat "(" + (ls-compile x) " " ,sym " " (ls-compile y) ")" " && " res)) + (setq x y)) + res)))) + +(define-builtin-comparison > ">") +(define-builtin-comparison < "<") +(define-builtin-comparison >= ">=") +(define-builtin-comparison <= "<=") +(define-builtin-comparison = "==") (define-builtin numberp (x) (js!bool (concat "(typeof (" x ") == \"number\")"))) @@ -1661,7 +1684,6 @@ (define-builtin lambda-code (x) (concat "(" x ").toString()")) - (define-builtin eq (x y) (js!bool (concat "(" x " === " y ")"))) (define-builtin equal (x y) (js!bool (concat "(" x " == " y ")"))) @@ -1880,7 +1902,9 @@ remove-if remove-if-not return return-from revappend reverse second set setq some string-upcase string string= stringp subseq symbol-function symbol-name symbol-package symbol-plist symbol-value symbolp t tagbody third throw truncate unless unwind-protect variable -warn when write-line write-string zerop)) +warn when write-line write-string zerop +arithmetic plus minus +)) (setq *package* *user-package*)