`(return (call (get func "apply") |window| args))))))
(define-compilation multiple-value-prog1 (first-form &rest forms)
- (js!selfcall
- "var args = " (ls-compile first-form *multiple-value-p*) ";"
- (ls-compile-block forms)
- "return args;" ))
+ (js!selfcall*
+ `(var (args ,(ls-compile first-form *multiple-value-p*)))
+ ;; TODO: Interleave is temporal
+ `(progn ,@(interleave (mapcar #'ls-compile forms)
+ '(code ";")
+ t))
+ `(return args)))
(define-transformation backquote (form)
(bq-completely-process form))
(let ,(mapcar (lambda (arg) `(,arg (ls-compile ,arg))) args)
,@body)))
-;;; DECLS is a list of (JSVARNAME TYPE LISPFORM) declarations.
-(defmacro type-check (decls &body body)
- `(js!selfcall
- ,@(mapcar (lambda (decl)
- `(let ((name ,(first decl))
- (value ,(third decl)))
- `(code "var " ,name " = " ,value ";" )))
- decls)
- ,@(mapcar (lambda (decl)
- `(let ((name ,(first decl))
- (type ,(second decl)))
- `(code "if (typeof " ,name " != '" ,type "')"
- (code "throw 'The value ' + "
- ,name
- " + ' is not a type "
- ,type
- ".';"
- ))))
- decls)
- `(code "return " ,,@body ";" )))
-
;;; 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"))
(fargs '())
(prelude '()))
(dolist (x args)
- (cond
- ((or (floatp x) (numberp x)) (push x fargs))
- (t (let ((v (make-symbol (code "x" (incf counter)))))
- (push v fargs)
- (push `(code "var " ,v " = " ,(ls-compile x) ";"
- "if (typeof " ,v " !== 'number') throw 'Not a number!';")
- prelude)))))
- (js!selfcall
- `(code ,@(reverse prelude))
+ (if (or (floatp x) (numberp x))
+ (push x fargs)
+ (let ((v (make-symbol (concat "x" (integer-to-string (incf counter))))))
+ (push v fargs)
+ (push `(var (,v ,(ls-compile x)))
+ prelude)
+ (push `(if (!= (typeof ,v) "number")
+ (throw "Not a number!"))
+ prelude))))
+ (js!selfcall*
+ `(progn ,@(reverse prelude))
(funcall function (reverse fargs)))))
(defmacro variable-arity (args &body body)
(unless (symbolp args)
(error "`~S' is not a symbol." args))
- `(variable-arity-call ,args
- (lambda (,args)
- `(code "return " ,,@body ";" ))))
-
-(defun num-op-num (x op y)
- (type-check (("x" "number" x) ("y" "number" y))
- `(code "x" ,op "y")))
+ `(variable-arity-call ,args (lambda (,args) `(return ,,@body))))
(define-raw-builtin + (&rest numbers)
(if (null numbers)
(reduce (lambda (x y) `(/ ,x ,y))
args)))))
-(define-builtin mod (x y) (num-op-num x "%" y))
+(define-builtin mod (x y)
+ `(% ,x ,y))
(defun comparison-conjuntion (vars op)
(js!bool `(== (typeof ,x) "number")))
(define-builtin floor (x)
- (type-check (("x" "number" x))
- "Math.floor(x)"))
+ `(call (get |Math| |floor|) ,x))
(define-builtin expt (x y)
- (type-check (("x" "number" x)
- ("y" "number" y))
- "Math.pow(x, y)"))
+ `(call (get |Math| |pow|) ,x ,y))
(define-builtin float-to-string (x)
- (type-check (("x" "number" x))
- "make_lisp_string(x.toString())"))
+ `(call |make_lisp_string| (call (get ,x |toString|))))
(define-builtin cons (x y)
`(object "car" ,x "cdr" ,y))
(get tmp "cdr")))))
(define-builtin rplaca (x new)
- (type-check (("x" "object" x))
- `(code "(x.car = " ,new ", x)")))
+ `(= (get ,x "car") ,new))
(define-builtin rplacd (x new)
- (type-check (("x" "object" x))
- `(code "(x.cdr = " ,new ", x)")))
+ `(= (get ,x "cdr") ,new))
(define-builtin symbolp (x)
(js!bool `(instanceof ,x |Symbol|)))
(js!bool `(=== ,x ,y)))
(define-builtin char-code (x)
- (type-check (("x" "string" x))
- "char_to_codepoint(x)"))
+ `(call |char_to_codepoint| ,x))
(define-builtin code-char (x)
- (type-check (("x" "number" x))
- "char_from_codepoint(x)"))
+ `(call |char_from_codepoint| ,x))
(define-builtin characterp (x)
(js!bool
(define-raw-builtin apply (func &rest args)
(if (null args)
- `(code "(" ,(ls-compile func) ")()")
+ (ls-compile func)
(let ((args (butlast args))
(last (car (last args))))
- (js!selfcall
- "var f = " (ls-compile func) ";"
- "var args = [" `(code
- ,@(interleave (list* (if *multiple-value-p* "values" "pv")
- (integer-to-string (length args))
- (mapcar #'ls-compile args))
- ", "))
- "];"
- "var tail = (" (ls-compile last) ");"
- "while (tail != " (ls-compile nil) "){"
- " args.push(tail.car);"
- " args[1] += 1;"
- " tail = tail.cdr;"
- "}"
- "return (typeof f === 'function'? f : f.fvalue).apply(this, args);" ))))
+ (js!selfcall*
+ `(var (f ,(ls-compile func)))
+ `(var (args ,(list-to-vector
+ (list* (if *multiple-value-p* '|values| '|pv|)
+ (length args)
+ (mapcar #'ls-compile args)))))
+ `(var (tail ,(ls-compile last)))
+ `(while (!= tail ,(ls-compile nil))
+ (call (get args "push") (get tail "car"))
+ (post++ (property args 1))
+ (= tail (get tail "cdr")))
+ `(return (call (get (if (=== (typeof f) "function")
+ f
+ (get f "fvalue"))
+ "apply")
+ this
+ args))))))
(define-builtin js-eval (string)
(if *multiple-value-p*
projects / jscl.git / blobdiff