;;; function call.
(defvar *multiple-value-p* nil)
+;;; It is bound dinamically to the number of nested calls to
+;;; `convert'. Therefore, a form is being compiled as toplevel if it
+;;; is zero.
+(defvar *convert-level* -1)
+
+
;;; Environment
(def!struct binding
(push (cons sexp jsvar) *literal-table*)
(toplevel-compilation `(var (,jsvar ,dumped)))
(when (keywordp sexp)
- (toplevel-compilation `(= ,(get jsvar "value") ,jsvar)))
+ (toplevel-compilation `(= (get ,jsvar "value") ,jsvar)))
jsvar)))))))
,(convert-block body t))))
+;;; Was the compiler invoked from !compile-file?
(defvar *compiling-file* nil)
-(define-compilation eval-when-compile (&rest body)
- (if *compiling-file*
- (progn
- (eval (cons 'progn body))
- (convert 0))
- (convert `(progn ,@body))))
+
+;;; NOTE: It is probably wrong in many cases but we will not use this
+;;; heavily. Please, do not rely on wrong cases of this
+;;; implementation.
+(define-compilation eval-when (situations &rest body)
+ ;; TODO: Error checking
+ (cond
+ ;; Toplevel form compiled by !compile-file.
+ ((and *compiling-file* (zerop *convert-level*))
+ ;; If the situation `compile-toplevel' is given. The form is
+ ;; evaluated at compilation-time.
+ (when (find :compile-toplevel situations)
+ (eval (cons 'progn body)))
+ ;; `load-toplevel' is given, then just compile the subforms as usual.
+ (when (find :load-toplevel situations)
+ (convert-toplevel `(progn ,@body) *multiple-value-p*)))
+ ((find :execute situations)
+ (convert `(progn ,@body) *multiple-value-p*))
+ (t
+ (convert nil))))
(defmacro define-transformation (name args form)
`(define-compilation ,name ,args
(throw (+ "Function `" (call |xstring| (get symbol "name")) "' is undefined.")))
(return func)))
-(define-builtin symbol-plist (x)
- `(or (get ,x "plist") ,(convert nil)))
-
(define-builtin lambda-code (x)
`(call |make_lisp_string| (method-call ,x "toString")))
(define-builtin functionp (x)
`(bool (=== (typeof ,x) "function")))
-(define-builtin %write-string (x)
- `(method-call |lisp| "write" ,x))
-
(define-builtin /debug (x)
`(method-call |console| "log" (call |xstring| ,x)))
,@(mapcar (lambda (key)
`(progn
(= obj (property obj (call |xstring| ,(convert key))))
- (if (=== object undefined)
+ (if (=== obj undefined)
(throw "Impossible to set object property."))))
(butlast keys))
(var (tmp
(define-builtin in (key object)
`(bool (in (call |xstring| ,key) ,object)))
+(define-builtin delete-property (key object)
+ `(selfcall
+ (delete (property ,object (call |xstring| ,key)))))
+
(define-builtin map-for-in (function object)
`(selfcall
(var (f ,function)
(g (if (=== (typeof f) "function") f (get f "fvalue")))
(o ,object))
(for-in (key o)
- (call g ,(if *multiple-value-p* '|values| '|pv|) 1 (get o "key")))
+ (call g ,(if *multiple-value-p* '|values| '|pv|) 1 (property o key)))
(return ,(convert nil))))
(define-compilation %js-vref (var)
#+jscl((symbolp function)
`(call ,(convert `#',function) ,@arglist))
((and (consp function) (eq (car function) 'lambda))
- `(call ,(convert `#',function) ,@arglist))
+ `(call ,(convert `(function ,function)) ,@arglist))
((and (consp function) (eq (car function) 'oget))
`(call |js_to_lisp|
(call ,(reduce (lambda (obj p)
`(property ,obj (call |xstring| ,p)))
(mapcar #'convert (cdr function)))
,@(mapcar (lambda (s)
- `(call |lisp_to_js| ,s))
+ `(call |lisp_to_js| ,(convert s)))
args))))
(t
(error "Bad function descriptor")))))
(when expandedp
(return-from convert (convert sexp multiple-value-p)))
;; The expression has been macroexpanded. Now compile it!
- (let ((*multiple-value-p* multiple-value-p))
+ (let ((*multiple-value-p* multiple-value-p)
+ (*convert-level* (1+ *convert-level*)))
(cond
((symbolp sexp)
(let ((b (lookup-in-lexenv sexp *environment* 'variable)))
(subseq string 0 n)))
(defun convert-toplevel (sexp &optional multiple-value-p)
- (let ((*toplevel-compilations* nil))
+ ;; Macroexpand sexp as much as possible
+ (multiple-value-bind (sexp expandedp) (!macroexpand-1 sexp)
+ (when expandedp
+ (return-from convert-toplevel (convert-toplevel sexp multiple-value-p))))
+ ;; Process as toplevel
+ (let ((*convert-level* -1)
+ (*toplevel-compilations* nil))
(cond
;; Non-empty toplevel progn
((and (consp sexp)