Added support for Function.caller/arguments.callee.caller property. Since this adds overhead to every function call, it is off by default and can be enabled with the *enable-Function.caller* flag before compiling JS code

Author: Vladimir Sedach

api.lisp

@@ -6,6 +6,9 @@
 (defun reset ()
   (setf *env* (create-env *printlib*)))
 
+(defvar *enable-Function.caller* nil
+  "If T, enables support for arguments.callee.caller/Function.caller property in newly compiled JavaScript code")
+
 (defun run-js (str &key (compile t) (wrap-parse-errors nil) (optimize nil) (wrap-as-module nil))
   (unless (boundp '*env*) (reset))
   (let* ((ast (handler-bind ((js-parse-error
@@ -56,8 +59,9 @@
          (format t (if continue "  " "> "))))))
 
 (defun tests ()
-  (with-js-env (*printlib*)
-    (run-js-file (asdf:system-relative-pathname :cl-js "test.js"))))
+  (let ((*enable-function.caller* t))
+    (with-js-env (*printlib*)
+      (run-js-file (asdf:system-relative-pathname :cl-js "test.js")))))
 
 (defun js-obj (&optional proto struct-type)
   (let ((cls (etypecase proto

package.lisp

@@ -2,6 +2,7 @@
   (:use :cl :parse-js)
   (:export #:run-js-file #:run-js #:js-repl
            #:*env* #:with-js-env #:create-env #:add-to-env
+           #:*enable-Function.caller*
 
            #:*printlib* #:requirelib
 

runtime.lisp

@@ -172,6 +172,8 @@
     (.func "decodeURIComponent" (str)
       (with-uri-err (url-encode:url-decode (to-string str) "")))))
 
+(defvar *Function.caller-stack* '(:null :null))
+
 (add-to-lib *stdlib*
   (flet ((defprops (obj props)
            (let ((props (to-object props)))
@@ -251,7 +253,8 @@
           (build-func (lambda (this &rest args-inner)
                         (declare (ignore this))
                         (apply proc self (append args args-inner)))
-                      (max 0 (- arity (length args)))))))))
+                      (max 0 (- arity (length args))))))
+      (.active-r "caller" (second *Function.caller-stack*)))))
 
 (add-to-lib *stdlib*
   (.constructor "Array" (&rest args)

test.js

@@ -541,6 +541,14 @@ function test_39() {
         true);
 }
 
+function test_40() {
+    var foo = function foo() { return arguments.callee.caller; };
+    var bar = function bar() { return foo(); };
+    if (typeof bar() != "function") {
+        throw "arguments.callee.caller doesn't work";
+    }
+}
+
 function runTests() {
   var failures = [];
   var run = 0;

translate.lisp

@@ -410,7 +410,8 @@
          (uses-args (or uses-eval (references-arguments body)))
          (eval-scope (gensym "eval-scope"))
          (base-locals (cons "this" args))
-         (fname (and uses-args (or name (symbol-name (gensym))))))
+         (fname (and (or uses-args *enable-Function.caller*)
+                     (or name (symbol-name (gensym))))))
     (when name (push name base-locals))
     (when uses-args (push "arguments" base-locals))
     (multiple-value-bind (locals internal) (find-locals body base-locals)
@@ -420,7 +421,11 @@
                       (make-simple-scope :vars locals))
         (when uses-eval
           (push (make-with-scope :var eval-scope) *scope*))
-        (let ((body1 `((let* (,@(loop :for var :in internal :collect `(,var :undefined))
+        (let ((body1 `((let* (,@(when *enable-Function.caller*
+                                  `((*Function.caller-stack*
+                                     (cons ,(as-sym fname)
+                                           *Function.caller-stack*))))
+                              ,@(loop :for var :in internal :collect `(,var :undefined))
                               ;; TODO sane object init
                               ,@(and uses-eval `((,eval-scope (make-obj (find-cls :object)))
                                                  (eval-env ,(capture-scope)))))