diff --git a/cl-cc-javascript.asd b/cl-cc-javascript.asd index 562df42..77d11a5 100644 --- a/cl-cc-javascript.asd +++ b/cl-cc-javascript.asd @@ -46,13 +46,13 @@ (:file "v8-objects/package") (:file "package") (:module "syntax" :serial t :components ((:file "macros") (:file "registry") (:file "lexer") (:file "lexer-string") (:file "lexer-operator") (:file "parser"))) - (:module "objects" :serial t :components ((:file "runtime-values") (:file "runtime-hooks") (:file "runtime-function-hooks") (:file "runtime-generator-hooks") (:file "runtime-collections") (:file "runtime-collections-set") (:file "runtime-map") (:file "runtime-object") (:file "runtime-object-vm") (:file "runtime-object-ops") (:file "runtime-property") (:file "runtime-coercion") (:file "runtime-symbol") (:file "runtime-weak-collections") (:file "runtime-console"))) - (:module "expressions" :serial t :components ((:file "parser-expr") (:file "parser-expr-literal") (:file "parser-expr-incdec") (:file "parser-expr-postfix") (:file "parser-expr-primary") (:file "parser-expr-unary") (:file "runtime-ops") (:file "runtime"))) + (:module "objects" :serial t :components ((:file "runtime-values") (:file "runtime-hooks") (:file "runtime-function-hooks") (:file "runtime-generator-hooks") (:file "runtime-collections") (:file "runtime-collections-set") (:file "runtime-map") (:file "runtime-object") (:file "runtime-object-vm") (:file "runtime-object-ops") (:file "runtime-property-descriptors") (:file "runtime-property") (:file "runtime-coercion") (:file "runtime-symbol") (:file "runtime-weak-collections") (:file "runtime-console"))) + (:module "expressions" :serial t :components ((:file "parser-expr") (:file "parser-expr-gdi") (:file "parser-expr-literal") (:file "parser-expr-incdec") (:file "parser-expr-postfix") (:file "parser-expr-primary") (:file "parser-expr-unary") (:file "runtime-ops") (:file "runtime"))) (:module "statements" :serial t :components ((:file "parser-stmt") (:file "parser-stmt-binding") (:file "parser-stmt-control") (:file "parser-stmt-switch") (:file "parser-stmt-dispatch") (:file "runtime-control"))) (:module "functions" :serial t :components ((:file "parser-arrow-params") (:file "parser-arrow") (:file "parser-expr-args") (:file "parser-stmt-fn") (:file "runtime-call") (:file "runtime-object-handlers"))) (:module "classes" :serial t :components ((:file "parser-class-member-syntax") (:file "parser-class-lower-classify") (:file "parser-class-lower") (:file "parser-class") (:file "runtime-class"))) (:module "v8-objects" :serial t :components ((:file "runtime-vm-objects"))) - (:module "proxies" :serial t :components ((:file "runtime-builtins-object") (:file "runtime-object-hooks"))) + (:module "proxies" :serial t :components ((:file "runtime-builtins-object") (:file "runtime-builtins-object-descriptors") (:file "runtime-object-hooks"))) (:module "iterators" :serial t :components ((:file "runtime-collections-iterators") (:file "runtime-collections-zip") (:file "runtime-for-of") (:file "runtime-generator") (:file "runtime-builtins-platform-atomics") (:file "runtime-object-hooks") (:file "runtime-object-generator-hooks"))) (:module "async" :serial t :components ((:file "runtime-hooks") (:file "runtime-promise") (:file "runtime-builtins-platform-abort"))) (:module "modules" :serial t :components ((:file "parser-module") (:file "parser-module-export") (:file "runtime-module"))) @@ -66,7 +66,7 @@ (:module "errors" :serial t :components ((:file "runtime-exception") (:file "runtime-builtins"))) (:module "disposables" :serial t :components ((:file "parser-stmt-flow"))) - (:module "backend" :serial t :components ((:file "runtime-function-hooks") (:file "runtime-builtins-globals") (:file "runtime-builtins-platform") (:file "runtime-builtins-platform-crypto") (:file "runtime-builtins-prelude") (:file "runtime-builtins-table-specs") (:file "runtime-builtins-table") (:file "runtime-builtins-table-globals") (:file "runtime-method-resolver") (:file "runtime-method-resolver-core") (:file "runtime-method-resolver-tables") (:file "runtime-method-resolver-dispatch") (:file "runtime-bridge-provider") (:file "vm-integration"))) + (:module "backend" :serial t :components ((:file "runtime-function-hooks") (:file "runtime-builtins-globals") (:file "runtime-builtins-platform") (:file "runtime-builtins-platform-crypto") (:file "runtime-gdi-environment") (:file "runtime-gdi-declarations") (:file "runtime-builtins-prelude") (:file "runtime-builtins-table-specs") (:file "runtime-builtins-table") (:file "runtime-builtins-table-globals") (:file "runtime-method-resolver") (:file "runtime-method-resolver-core") (:file "runtime-method-resolver-tables") (:file "runtime-method-resolver-dispatch") (:file "runtime-bridge-provider") (:file "vm-integration"))) ) :in-order-to ((test-op (test-op "cl-cc-javascript/test")))) @@ -121,7 +121,7 @@ (:module "json" :serial t :components ( (:file "runtime-json-test") (:file "suite"))) (:module "dates" :serial t :components ((:file "runtime-date-test") (:file "runtime-temporal-test") (:file "suite"))) - (:module "backend" :serial t :components ((:file "runtime-method-resolver-dispatch-test") (:file "runtime-builtins-platform-test") (:file "runtime-object-coercion-clone-test") (:file "suite"))) + (:module "backend" :serial t :components ((:file "runtime-method-resolver-dispatch-test") (:file "runtime-builtins-platform-test") (:file "runtime-object-coercion-clone-test") (:file "gdi-prelude-global-properties-test") (:file "gdi-instantiation-test") (:file "gdi-instantiation-execution-test") (:file "suite"))) (:module "v8-objects" :serial t :components ((:file "runtime-vm-objects-test") (:file "suite"))) (:module "functions" :serial t :components ((:file "suite"))) (:module "classes" :serial t :components ((:file "suite"))) diff --git a/nix/feature-dependencies.sexp b/nix/feature-dependencies.sexp index 0f474f9..bb7e0b9 100644 --- a/nix/feature-dependencies.sexp +++ b/nix/feature-dependencies.sexp @@ -116,4 +116,4 @@ :facade-packages ("cl-cc/javascript") :domain-package "cl-cc/javascript/backend" :infra-package nil - :depends-on ("arrays" "async" "classes" "dates" "errors" "expressions" "functions" "intl" "iterators" "json" "numbers" "objects" "proxies" "regex" "strings" "syntax"))) + :depends-on ("arrays" "async" "classes" "dates" "errors" "expressions" "functions" "intl" "iterators" "json" "numbers" "objects" "proxies" "regex" "statements" "strings" "syntax"))) diff --git a/src/backend/runtime-bridge-provider.lisp b/src/backend/runtime-bridge-provider.lisp index 8fee3f2..467d338 100644 --- a/src/backend/runtime-bridge-provider.lisp +++ b/src/backend/runtime-bridge-provider.lisp @@ -14,20 +14,27 @@ (in-package #:cl-cc/javascript/backend) (defun %js-host-bridge-entries () - "Return (symbol . function) pairs for every fbound, non-macro %JS-* function -homed in :cl-cc/javascript." - (let ((pkg (find-package :cl-cc/javascript)) + "Return (symbol . function) pairs for runtime helpers owned by this frontend." + (let ((packages (remove nil + (list (find-package :cl-cc/javascript) + (find-package :cl-cc/javascript/backend)))) (entries '())) - (when pkg - (do-symbols (sym pkg) - (when (and (eq (symbol-package sym) pkg) - (fboundp sym) - (not (macro-function sym)) - (not (special-operator-p sym)) - (let ((name (symbol-name sym))) - (and (>= (length name) 4) - (string= "%JS-" name :end2 4)))) - (push (cons sym (fdefinition sym)) entries)))) + (dolist (pkg packages) + (let ((prefix (if (eq pkg (find-package :cl-cc/javascript)) + "%JS-" + "%JS-GDI-")) + (prefix-length (if (eq pkg (find-package :cl-cc/javascript)) + 4 + 8))) + (do-symbols (sym pkg) + (when (and (eq (symbol-package sym) pkg) + (fboundp sym) + (not (macro-function sym)) + (not (special-operator-p sym)) + (let ((name (symbol-name sym))) + (and (>= (length name) prefix-length) + (string= prefix name :end2 prefix-length)))) + (push (cons sym (fdefinition sym)) entries))))) (nreverse entries))) (register-backend-bridge-provider #'%js-host-bridge-entries) diff --git a/src/backend/runtime-builtins-prelude.lisp b/src/backend/runtime-builtins-prelude.lisp index 5e9730f..3bc8f24 100644 --- a/src/backend/runtime-builtins-prelude.lisp +++ b/src/backend/runtime-builtins-prelude.lisp @@ -6,7 +6,6 @@ ;;;; ;;;; Load order: after runtime-builtins-table.lisp (needs *js-builtin-specs*, ;;;; %js-builtin-ref, and all the %js-make-* / *js-* symbols). - (in-package #:cl-cc/javascript/backend) ;;; ----------------------------------------------------------------------- @@ -22,7 +21,6 @@ ;;; :builtin — %js-builtin-ref lookup by key string e.g. "Set" ;;; ;;; Add new globals here; js-program-forms consumes this table automatically. - (defparameter *js-prelude-global-specs* '((:call "console" %js-make-console) (:var "Symbol" *js-symbol-global*) @@ -41,7 +39,7 @@ (:namespace "Promise" "Promise") (:namespace "Iterator" "Iterator") (:namespace "Intl" "Intl") - (:call "globalThis" %js-make-object) + (:call "globalThis" %js-gdi-global-object) (:var "Temporal" *js-temporal-global*) (:var "BigInt" *js-bigint-global*) ;; URI helpers @@ -98,21 +96,103 @@ before every compiled JS program so standard globals are available.") (defun %js-prelude-form (spec) - "Emit a defparameter AST node for one entry in *js-prelude-global-specs*." + "Emit a prelude AST declaration for one entry in *js-prelude-global-specs*." (destructuring-bind (kind js-name cl-sym) spec - (make-ast-defvar - :name (js-ident-sym js-name) - :kind 'defparameter - :value (ecase kind - (:call (%js-call cl-sym)) - (:var (make-ast-var :name cl-sym)) - (:function (make-ast-function :name cl-sym)) - (:namespace (%js-call '%js-make-namespace-object (make-ast-quote :value cl-sym))) - (:quote (make-ast-quote :value cl-sym)) - (:builtin (%js-call '%js-builtin-ref (make-ast-quote :value cl-sym))))))) + (make-ast-defvar :name + (js-ident-sym js-name) + :kind + (if (equal js-name "globalThis") + (quote defvar) + (quote defparameter)) + :value + (ecase kind + (:call (%js-call cl-sym)) + (:var (make-ast-var :name cl-sym)) + (:function (make-ast-function :name cl-sym)) + (:namespace + (%js-call (quote %js-make-namespace-object) (make-ast-quote :value cl-sym))) + (:quote (make-ast-quote :value cl-sym)) + (:builtin (%js-call (quote %js-builtin-ref) (make-ast-quote :value cl-sym))))))) + +(defun %js-gdi-build-script-forms (source) + (multiple-value-bind (raw lexical-bindings) + (let ((cl-cc/javascript/statements:*js-gdi-mode* t) + (cl-cc/javascript/statements:*js-gdi-lower-var-declarations* nil) + (cl-cc/javascript/statements:*js-gdi-lexical-scope-depth* 0) + (cl-cc/javascript/statements:*js-gdi-collect-global-lexical-bindings* t) + (cl-cc/javascript/statements:*js-gdi-global-lexical-bindings* nil) + (cl-cc/javascript/syntax:*js-gdi-global-reference-mode* nil)) + (values (parse-js-source source) + (nreverse cl-cc/javascript/statements:*js-gdi-global-lexical-bindings*))) + (let* ((var-names (%js-gdi-var-names raw)) + (functions (%js-gdi-selected-functions raw)) + (function-names (mapcar (function cl-cc/ast:ast-defun-name) functions)) + (all-var-names (%js-gdi-unique-names (append var-names function-names))) + (forms + (let ((cl-cc/javascript/statements:*js-gdi-mode* t) + (cl-cc/javascript/statements:*js-gdi-lower-var-declarations* t) + (cl-cc/javascript/statements:*js-gdi-collect-global-lexical-bindings* nil) + (cl-cc/javascript/syntax:*js-gdi-global-reference-mode* t) + (cl-cc/javascript/syntax:*js-gdi-global-lexical-names* + (mapcar (function car) lexical-bindings)) + (cl-cc/javascript/syntax:*js-gdi-global-var-names* all-var-names) + (cl-cc/javascript/syntax:*js-gdi-shadowed-names* nil)) + (parse-js-source source))) + (selected-functions (%js-gdi-selected-functions forms)) + (selected-names (mapcar (function cl-cc/ast:ast-defun-name) selected-functions)) + (preflight + (%js-call (quote %js-gdi-prepare) + (make-ast-quote :value lexical-bindings) + (make-ast-quote :value selected-names) + (make-ast-quote :value var-names))) + (declare-vars + (mapcar + (lambda (name) + (make-ast-defvar :name name :kind (quote defvar) :value nil)) + all-var-names)) + (initialize-functions + (%js-call (quote %js-gdi-create-global-functions) + (make-ast-quote :value (%js-gdi-function-metadata selected-functions)))) + (create-vars + (%js-call (quote %js-gdi-create-global-vars) + (make-ast-quote :value var-names) + (make-ast-quote :value selected-names))) + (body + (loop for form in forms + append (cond + ((cl-cc/ast:ast-defun-p form) nil) + ((and (cl-cc/ast:ast-let-p form) + (member :var (cl-cc/ast:ast-let-declarations form))) + (list (%js-gdi-lower-declaration form :var))) + ((and (cl-cc/ast:ast-let-p form) + (null (cl-cc/ast:ast-let-body form)) + (intersection (cl-cc/ast:ast-let-declarations form) + (quote (:let :const)) + :test + (function eq))) + (list + (%js-gdi-lower-declaration form + (if (member :const + (cl-cc/ast:ast-let-declarations + form)) + :const + :let)))) + ((cl-cc/ast:ast-defclass-p form) (%js-gdi-lower-class form)) + (t (list form)))))) + (append (mapcar (function %js-prelude-form) *js-prelude-global-specs*) + (list + (%js-call (quote %js-gdi-initialize-prelude-global-properties) + (make-ast-quote :value + (mapcar + (lambda (spec) + (js-ident-sym (second spec))) + *js-prelude-global-specs*))) + preflight) + declare-vars + selected-functions + (list initialize-functions create-vars) + body)))) (defun js-program-forms (source) - "Parse JS SOURCE prepending the standard-globals prelude. -Returns top-level AST forms ready for the compiler backend." - (append (mapcar #'%js-prelude-form *js-prelude-global-specs*) - (parse-js-source source))) + "Parse a JavaScript script, instantiate its global declarations, then execute its body." + (%js-gdi-build-script-forms source)) diff --git a/src/backend/runtime-gdi-declarations.lisp b/src/backend/runtime-gdi-declarations.lisp new file mode 100644 index 0000000..437a9c9 --- /dev/null +++ b/src/backend/runtime-gdi-declarations.lisp @@ -0,0 +1,240 @@ +(in-package #:cl-cc/javascript/backend) + +(defun %js-gdi-define-global-property (name value writable enumerable configurable) + (let ((global (%js-gdi-global-object))) + (when global + (%js-object-define-property global + (symbol-name name) + (%js-make-object "value" + value + "writable" + writable + "enumerable" + enumerable + "configurable" + configurable))) + (when cl-cc/vm:*vm-state* + (setf (gethash name (cl-cc/vm:vm-global-vars cl-cc/vm:*vm-state*)) value)) + value)) + +(defun %js-gdi-create-global-functions (function-metadata) + (let* ((state cl-cc/vm:*vm-state*) + (registry (and state (cl-cc/vm:vm-function-registry state)))) + (dolist (metadata function-metadata) + (let* ((name (car metadata)) + (flags + (if (consp (cdr metadata)) + (cddr metadata) + nil)) + (non-constructable-p (member :non-constructable flags :test (function eq))) + (prototype-p + (or (not non-constructable-p) + (member :prototype flags :test (function eq)) + (member :prototype-without-constructor flags :test (function eq)))) + (prototype-constructor-p + (not (member :prototype-without-constructor flags :test (function eq)))) + (length + (if non-constructable-p + (second metadata) + (cdr metadata))) + (function (and registry (gethash name registry)))) + (unless function + (%js-gdi-throw *js-type-error-class* "Function declaration was not instantiated")) + (let ((descriptor (%js-gdi-global-descriptor name))) + (if (and (%js-gdi-descriptor-present-p descriptor) + (not + (%js-truthy (cl-cc/javascript/objects:%js-get-prop descriptor "configurable")))) + (progn + (cl-cc/javascript/objects:%js-set-prop (%js-gdi-global-object) + (symbol-name name) + function) + (when state + (setf (gethash name (cl-cc/vm:vm-global-vars state)) function))) + (%js-gdi-define-global-property name function t t nil))) + (%js-object-define-property function + "length" + (%js-make-object "value" + length + "writable" + nil + "enumerable" + nil + "configurable" + t)) + (%js-object-define-property function + "name" + (%js-make-object "value" + (symbol-name name) + "writable" + nil + "enumerable" + nil + "configurable" + t)) + (when prototype-p + (let ((prototype (%js-make-object))) + (when prototype-constructor-p + (%js-object-define-property prototype + "constructor" + (%js-make-object "value" + function + "writable" + t + "enumerable" + nil + "configurable" + t))) + (%js-object-define-property function + "prototype" + (%js-make-object "value" + prototype + "writable" + t + "enumerable" + nil + "configurable" + nil)))) + (%js-gdi-global-var-declared-p name t))) + +js-undefined+)) + +(defun %js-gdi-create-global-vars (var-names function-names) + (let ((state cl-cc/vm:*vm-state*)) + (dolist (name (%js-gdi-unique-names var-names)) + (unless (member name function-names :test (function eq)) + (let ((descriptor (%js-gdi-global-descriptor name))) + (unless (%js-gdi-descriptor-present-p descriptor) + (%js-gdi-discard-global-write-mirror name) + (multiple-value-bind (value value-p) + (if state + (gethash name (cl-cc/vm:vm-global-vars state)) + (values nil nil)) + (%js-gdi-define-global-property name + (if value-p + value + +js-undefined+) + t + t + nil))) + (when (and state + (not (nth-value 1 (gethash name (cl-cc/vm:vm-global-vars state))))) + (setf (gethash name (cl-cc/vm:vm-global-vars state)) + (if (%js-gdi-descriptor-present-p descriptor) + (cl-cc/javascript/objects:%js-get-prop descriptor "value") + +js-undefined+))) + (when (%js-gdi-descriptor-present-p (%js-gdi-global-descriptor name)) + (%js-gdi-record-global-write-mirror name)))) + (%js-gdi-global-var-declared-p name t)) + +js-undefined+)) + +(defun %js-gdi-initialize-lexical (name value) + (let* ((environment (%js-gdi-lexical-environment nil)) + (binding (and environment (gethash name environment)))) + (unless binding + (%js-gdi-throw *js-reference-error-class* "Global lexical binding does not exist")) + (when (getf binding :initialized) + (%js-gdi-throw *js-type-error-class* "Global lexical binding was initialized twice")) + (setf (getf binding :value) value + (getf binding :initialized) t) + value)) + +(defun %js-gdi-var-names (forms) + (let ((names nil)) + (labels ((visit (node) + (cond + ((or (cl-cc/ast:ast-defun-p node) + (cl-cc/ast:ast-lambda-p node) + (cl-cc/ast:ast-defclass-p node)) nil) + ((and (cl-cc/ast:ast-call-p node) + (cl-cc/ast:ast-var-p (cl-cc/ast:ast-call-func node)) + (eq (cl-cc/ast:ast-var-name (cl-cc/ast:ast-call-func node)) + 'cl-cc/javascript/statements:%js-try-catch-finally)) + (dolist (arg (cl-cc/ast:ast-call-args node)) + (if (cl-cc/ast:ast-lambda-p arg) + (dolist (form (cl-cc/ast:ast-lambda-body arg)) + (visit form)) + (visit arg)))) + (t + (when + (and (cl-cc/ast:ast-let-p node) + (member :var (cl-cc/ast:ast-let-declarations node))) + (dolist (binding (cl-cc/ast:ast-let-bindings node)) + (let ((name (car binding))) + (when + (and (symbolp name) + (eq (symbol-package name) (find-package :cl-cc/javascript))) + (push name names))))) + (dolist (child (cl-cc/ast:ast-children node)) + (visit child)))))) + (dolist (form forms) + (visit form)) + (%js-gdi-unique-names (nreverse names))))) + +(defun %js-gdi-selected-functions (forms) + (let ((seen (make-hash-table :test #'eq)) + (selected nil)) + (dolist (form (reverse forms)) + (when (cl-cc/ast:ast-defun-p form) + (let ((name (cl-cc/ast:ast-defun-name form))) + (unless (gethash name seen) + (setf (gethash name seen) t) + (push form selected))))) + selected)) + +(defun %js-gdi-lower-declaration (form kind) + (let ((tail nil)) + (dolist (binding (reverse (cl-cc/ast:ast-let-bindings form))) + (let ((name (car binding)) + (value (cdr binding))) + (if (and (symbolp name) (eq (symbol-package name) (find-package :cl-cc/javascript))) + (unless + (and (eq kind :var) + (cl-cc/ast:ast-quote-p value) + (eq (cl-cc/ast:ast-quote-value value) :js-gdi-no-initializer)) + (setf tail (cons + (if (eq kind :var) + (%js-call '%js-gdi-global-write (make-ast-quote :value name) value) + (%js-call '%js-gdi-initialize-lexical + (make-ast-quote :value name) + value)) + tail))) + (setf tail (list (cl-cc/ast:make-ast-let :bindings (list binding) :body tail)))))) + (if tail + (cl-cc/ast:make-ast-progn :forms tail) + (make-ast-quote :value :js-undefined)))) + +(defun %js-gdi-lower-class (form) + (list form + (%js-call '%js-gdi-initialize-lexical + (make-ast-quote :value (cl-cc/ast:ast-defclass-name form)) + (make-ast-var :name (cl-cc/ast:ast-defclass-name form))))) + +(defun %js-gdi-function-metadata (functions) + (mapcar + (lambda (function) + (let* ((name (cl-cc/ast:ast-defun-name function)) + (length (length (cl-cc/ast:ast-defun-params function))) + (declarations (cl-cc/ast:ast-defun-declarations function)) + (async-p (member :js-async declarations :test #'eq)) + (generator-p (member :js-generator declarations :test #'eq))) + (cond + ((and (not async-p) (not generator-p)) (cons name length)) + (generator-p (list name length :non-constructable :prototype-without-constructor)) + (t (list name length :non-constructable))))) + functions)) + +(defun %js-gdi-global-read-ast (name) + (%js-call '%js-gdi-global-read (make-ast-quote :value name))) + +(defun %js-gdi-global-typeof-ast (name) + (%js-call '%js-gdi-global-typeof (make-ast-quote :value name))) + +(defun %js-gdi-global-write-ast (name value) + (%js-call '%js-gdi-global-write (make-ast-quote :value name) value)) + +(eval-when (:load-toplevel :execute) + (cl-cc/javascript/syntax:register-js-parser-handler :gdi-global-read-ast + (function %js-gdi-global-read-ast)) + (cl-cc/javascript/syntax:register-js-parser-handler :gdi-global-write-ast + (function %js-gdi-global-write-ast)) + (cl-cc/javascript/syntax:register-js-parser-handler :gdi-global-typeof-ast + (function %js-gdi-global-typeof-ast))) diff --git a/src/backend/runtime-gdi-environment.lisp b/src/backend/runtime-gdi-environment.lisp new file mode 100644 index 0000000..16264ce --- /dev/null +++ b/src/backend/runtime-gdi-environment.lisp @@ -0,0 +1,254 @@ +(in-package #:cl-cc/javascript/backend) +(defvar *js-gdi-global-environments* + (make-hash-table :test #'eq)) +(defvar *js-gdi-global-var-declarations* (make-hash-table :test (function eq))) +(defvar *js-gdi-global-write-mirrors* (make-hash-table :test (function eq))) +(defvar *js-gdi-global-objects* (make-hash-table :test (function eq))) +(defvar *js-gdi-prelude-properties-initialized* (make-hash-table :test (function eq))) + +(defun %js-gdi-lexical-environment (&optional (create-p t)) + (let* ((state cl-cc/vm:*vm-state*) + (table (gethash state *js-gdi-global-environments*))) + (when (and create-p (null table)) + (setf table (setf (gethash state *js-gdi-global-environments*) (make-hash-table + :test + #'eq)))) + table)) +(defun %js-gdi-global-var-declared-p (name &optional (declare-p nil)) + (let* ((state cl-cc/vm:*vm-state*) + (table (and state + (or (gethash state *js-gdi-global-var-declarations*) + (when declare-p + (setf (gethash state *js-gdi-global-var-declarations*) + (make-hash-table :test (function eq)))))))) + (when (and table declare-p) + (setf (gethash name table) t)) + (and table (gethash name table)))) +(defun %js-gdi-record-global-write-mirror (name &optional (value nil value-p)) + (let ((state cl-cc/vm:*vm-state*)) + (when state + (let ((table + (or (gethash state *js-gdi-global-write-mirrors*) + (setf (gethash state *js-gdi-global-write-mirrors*) + (make-hash-table :test (function eq)))))) + (setf (gethash name table) t) + (when value-p + (setf (gethash name (cl-cc/vm:vm-global-vars state)) value)))) + value)) +(defun %js-gdi-discard-global-write-mirror (name) + "Remove a stale VM value but retain its marker to prevent fallback resurrection." + (let* ((state cl-cc/vm:*vm-state*) + (table (and state (gethash state *js-gdi-global-write-mirrors*)))) + (when (and table (nth-value 1 (gethash name table))) + (remhash name (cl-cc/vm:vm-global-vars state)) + t))) + +(defun %js-gdi-global-object () + "Return the stable global object for the current VM state." + (let ((state cl-cc/vm:*vm-state*)) + (when state + (or (gethash state *js-gdi-global-objects*) + (let* ((vars (cl-cc/vm:vm-global-vars state)) + (name (js-ident-sym "globalThis")) + (global + (multiple-value-bind (value found-p) + (gethash name vars) + (if found-p value (%js-make-object))))) + (setf (gethash state *js-gdi-global-objects*) global + (gethash name vars) global) + global))))) + +(defun %js-gdi-global-descriptor (name) + (let ((global (%js-gdi-global-object))) + (if global + (%js-object-get-own-property-descriptor global (symbol-name name)) + +js-undefined+))) + +(defun %js-gdi-descriptor-present-p (descriptor) + (not (eq descriptor +js-undefined+))) +(defun %js-gdi-restricted-global-name-p (name) + (member (symbol-name name) + (list "undefined" "Infinity" "NaN") + :test (function string=))) +(defun %js-gdi-restricted-global-property-p (name) + "Check restricted properties omitted from the global object mirror." + (or (%js-gdi-restricted-global-name-p name) + (let ((descriptor (%js-gdi-global-descriptor name))) + (and (%js-gdi-descriptor-present-p descriptor) + (not + (%js-truthy + (cl-cc/javascript/objects:%js-get-prop descriptor + "configurable"))))))) +(defun %js-gdi-initialize-prelude-global-properties (names) + "Create missing global properties for the values installed by the prelude." + (let ((state cl-cc/vm:*vm-state*)) + (when (and state + (not (gethash state *js-gdi-prelude-properties-initialized*))) + (let ((global (%js-gdi-global-object)) + (vars (cl-cc/vm:vm-global-vars state))) + (when global + (dolist (name names) + (multiple-value-bind (value found-p) (gethash name vars) + (when found-p + (%js-gdi-record-global-write-mirror name value) + (when (eq (%js-object-get-own-property-descriptor + global (symbol-name name)) + +js-undefined+) + (let ((writable + (not (%js-gdi-restricted-global-name-p name)))) + (%js-object-define-property + global (symbol-name name) + (%js-make-object "value" value + "writable" writable + "enumerable" nil + "configurable" writable)))))))) + (setf (gethash state *js-gdi-prelude-properties-initialized*) t))) + +js-undefined+)) + +(defun %js-gdi-throw (class message) + (cl-cc/javascript/errors:%js-throw + (cl-cc/javascript/classes:%js-make-error-instance class message))) + +(defun %js-gdi-unique-names (names) + (let ((seen (make-hash-table :test #'eq)) + (unique nil)) + (dolist (name names (nreverse unique)) + (unless (gethash name seen) + (setf (gethash name seen) t) + (push name unique))))) + +(defun %js-gdi-can-declare-global-var-p (name) + (or (%js-gdi-descriptor-present-p (%js-gdi-global-descriptor name)) + (let ((global (%js-gdi-global-object))) + (or (null global) (%js-object-extensible-p global))))) + +(defun %js-gdi-can-declare-global-function-p (name) + (and + (not (%js-gdi-restricted-global-name-p name)) + (let* ((descriptor (%js-gdi-global-descriptor name)) + (global (%js-gdi-global-object)) + (descriptor-p (%js-gdi-descriptor-present-p descriptor))) + (or (and (not descriptor-p) + (or (null global) (%js-object-extensible-p global))) + (and descriptor-p + (or (%js-truthy + (cl-cc/javascript/objects:%js-get-prop descriptor + "configurable")) + (and (not (nth-value 1 (gethash "get" descriptor))) + (not (nth-value 1 (gethash "set" descriptor))) + (%js-truthy + (cl-cc/javascript/objects:%js-get-prop descriptor + "writable")) + (%js-truthy + (cl-cc/javascript/objects:%js-get-prop descriptor + "enumerable"))))))))) + +(defun %js-gdi-prepare (lexical-bindings function-names var-names) + (let* ((environment (%js-gdi-lexical-environment)) + (all-var-names + (%js-gdi-unique-names (append function-names var-names))) + (seen-lexicals (make-hash-table :test (function eq)))) + (dolist (binding lexical-bindings) + (let ((name (car binding))) + (when (gethash name seen-lexicals) + (%js-gdi-throw *js-syntax-error-class* + "Identifier has already been declared")) + (setf (gethash name seen-lexicals) t) + (when (member name all-var-names :test (function eq)) + (%js-gdi-throw *js-syntax-error-class* + "Lexical declaration conflicts with a var declaration")) + (when (or (gethash name environment) + (%js-gdi-global-var-declared-p name)) + (%js-gdi-throw *js-syntax-error-class* + "Identifier has already been declared")) + (when (%js-gdi-restricted-global-property-p name) + (%js-gdi-throw *js-syntax-error-class* + "Lexical declaration conflicts with a restricted global property")))) + (dolist (name all-var-names) + (when (gethash name environment) + (%js-gdi-throw *js-syntax-error-class* + "Var declaration conflicts with a global lexical binding"))) + (dolist (name function-names) + (unless (%js-gdi-can-declare-global-function-p name) + (%js-gdi-throw *js-type-error-class* "Cannot declare global function"))) + (dolist + (name + (%js-gdi-unique-names + (remove-if + (lambda (name) + (member name function-names :test (function eq))) + var-names))) + (unless (%js-gdi-can-declare-global-var-p name) + (%js-gdi-throw *js-type-error-class* "Cannot declare global variable"))) + (dolist (binding lexical-bindings) + (setf (gethash (car binding) environment) + (list :kind (cdr binding) :initialized nil :value +js-undefined+))) + +js-undefined+)) +(defun %js-gdi-lexical-read (name) + (let* ((environment (%js-gdi-lexical-environment nil)) + (binding (and environment (gethash name environment)))) + (unless (and binding (getf binding :initialized)) + (%js-gdi-throw *js-reference-error-class* + "Cannot access global lexical binding before initialization")) + (getf binding :value))) +(defun %js-gdi-global-read (name) + (let* ((environment (%js-gdi-lexical-environment nil)) + (binding (and environment (gethash name environment))) + (global (%js-gdi-global-object)) + (descriptor (%js-gdi-global-descriptor name))) + (cond + (binding (%js-gdi-lexical-read name)) + ((%js-gdi-descriptor-present-p descriptor) + (cl-cc/javascript/objects:%js-get-prop global (symbol-name name))) + ((%js-gdi-discard-global-write-mirror name) + (%js-gdi-throw *js-reference-error-class* "Global binding is not defined")) + (t + (multiple-value-bind (value found-p) + (if cl-cc/vm:*vm-state* + (gethash name (cl-cc/vm:vm-global-vars cl-cc/vm:*vm-state*)) + (values +js-undefined+ nil)) + (if found-p + value + (%js-gdi-throw *js-reference-error-class* "Global binding is not defined"))))))) +(defun %js-gdi-global-typeof (name) + (let* ((environment (%js-gdi-lexical-environment nil)) + (binding (and environment (gethash name environment))) + (global (%js-gdi-global-object)) + (descriptor (%js-gdi-global-descriptor name))) + (cond + (binding (%js-typeof (%js-gdi-lexical-read name))) + ((%js-gdi-descriptor-present-p descriptor) + (%js-typeof (cl-cc/javascript/objects:%js-get-prop global (symbol-name name)))) + ((%js-gdi-discard-global-write-mirror name) "undefined") + (t + (multiple-value-bind (value found-p) + (if cl-cc/vm:*vm-state* + (gethash name (cl-cc/vm:vm-global-vars cl-cc/vm:*vm-state*)) + (values +js-undefined+ nil)) + (if found-p + (%js-typeof value) + "undefined")))))) +(defun %js-gdi-global-write (name value) + (let* ((environment (%js-gdi-lexical-environment nil)) + (binding (and environment (gethash name environment)))) + (if binding + (progn + (%js-gdi-lexical-read name) + (unless (member (getf binding :kind) (list :let :class) :test (function eq)) + (%js-gdi-throw *js-type-error-class* "Assignment to immutable global lexical binding")) + (setf (getf binding :value) value)) + (let* ((global (%js-gdi-global-object)) + (descriptor (%js-gdi-global-descriptor name))) + (cond + ((not global) (%js-gdi-define-global-property name value t t t)) + ((not (%js-gdi-descriptor-present-p descriptor)) + (cl-cc/javascript/objects:%js-set-prop global (symbol-name name) value) + (when (%js-gdi-descriptor-present-p (%js-gdi-global-descriptor name)) + (%js-gdi-record-global-write-mirror name value))) + ((or (nth-value 1 (gethash "get" descriptor)) + (nth-value 1 (gethash "set" descriptor))) + (cl-cc/javascript/objects:%js-set-prop global (symbol-name name) value)) + ((%js-truthy (cl-cc/javascript/objects:%js-get-prop descriptor "writable")) + (cl-cc/javascript/objects:%js-set-prop global (symbol-name name) value) + (%js-gdi-record-global-write-mirror name value))))) + value)) diff --git a/src/classes/parser-class-lower.lisp b/src/classes/parser-class-lower.lisp index b7e421e..1efbc8a 100644 --- a/src/classes/parser-class-lower.lisp +++ b/src/classes/parser-class-lower.lisp @@ -47,9 +47,9 @@ rebuilt once per instance here, matching how field inits already work." for fn = (%js-wrap-method-super (%js-slot-to-method-lambda slot) super-expr) when fn collect (%js-call '%js-class-private-field-set - (make-ast-var :name '%js-this) - (make-ast-quote :value orig-name) - fn))) + (make-ast-var :name '%js-this) + (make-ast-quote :value orig-name) + fn))) (defun %js-lower-class-ctor (ctor-slot field-inits super-expr) "Build the class's constructor lambda: an explicit ctor gets FIELD-INITS @@ -57,27 +57,25 @@ prepended; a class with fields but no explicit ctor gets a synthetic one (forwarding to super for a derived class so the parent still initializes)." (cond (ctor-slot - (let ((lam (%js-slot-to-method-lambda ctor-slot))) - (when field-inits - (setf (ast-lambda-body lam) (append field-inits (ast-lambda-body lam)))) - (%js-wrap-method-super lam super-expr))) + (let ((lam (%js-slot-to-method-lambda ctor-slot))) + (when field-inits + (setf (ast-lambda-body lam) (append field-inits (ast-lambda-body lam)))) + (%js-wrap-method-super lam super-expr))) (field-inits - (make-ast-lambda - :params - nil - :rest-param - (when super-expr - 'js-ctor-rest-args) - :body - (append - (when super-expr - (list - (%js-call - '%js-run-constructor - (%js-super-ref super-expr) - (make-ast-var :name '%js-this) - (make-ast-var :name 'js-ctor-rest-args)))) - field-inits))) + (make-ast-lambda :params + nil + :rest-param + (when super-expr + 'js-ctor-rest-args) + :body + (append + (when super-expr + (list + (%js-call '%js-run-constructor + (%js-super-ref super-expr) + (make-ast-var :name '%js-this) + (make-ast-var :name 'js-ctor-rest-args)))) + field-inits))) (t (make-ast-quote :value nil)))) (defun %js-lower-class-method-args (method-slots super-expr) @@ -105,12 +103,14 @@ further \"@@private-static\" marker for private)." object alongside the static methods via the same \"@@static\" marker." (loop for slot in static-field-slots for orig-name = (%js-class-member-orig-name slot) - append (list - (%js-class-member-key-ast slot orig-name) - (or (ast-slot-initform slot) (make-ast-quote :value +js-undefined+))))) + append (list (%js-class-member-key-ast slot orig-name) + (or (ast-slot-initform slot) (make-ast-quote :value +js-undefined+))))) -(defun %js-lower-class-make-class-call - (super-expr ctor-lambda method-args static-args static-field-args private-static-args) +(defun %js-lower-class-make-class-call (super-expr ctor-lambda + method-args + static-args + static-field-args + private-static-args) "The %js-make-class call itself: super ctor inst-methods... [@@static statics... [@@private-static private-statics...]]. The \"@@private-static\" marker (and everything after \"@@static\") is only @@ -118,22 +118,19 @@ emitted when PRIVATE-STATIC-ARGS is non-empty, since %js-make-class's own marker search only looks for it within whatever follows \"@@static\" -- so \"@@static\" itself must be present whenever private static methods are, even if there are no ordinary static methods/fields to go with it." - (make-ast-call - :func - (make-ast-var :name '%js-make-class) - :args - (list* - (or super-expr (make-ast-quote :value nil)) - ctor-lambda - (append - method-args - (when (or static-args static-field-args private-static-args) - (append - (list (make-ast-quote :value "@@static")) - static-args - static-field-args - (when private-static-args - (cons (make-ast-quote :value "@@private-static") private-static-args)))))))) + (make-ast-call :func + (make-ast-var :name '%js-make-class) + :args + (list* (or super-expr (make-ast-quote :value nil)) + ctor-lambda + (append method-args + (when (or static-args static-field-args private-static-args) + (append (list (make-ast-quote :value "@@static")) + static-args + static-field-args + (when private-static-args + (cons (make-ast-quote :value "@@private-static") + private-static-args)))))))) ;;; ─── %js-lower-class-to-ast ────────────────────────────────────────────────── (defun %js-lower-class-to-ast (name-sym super-expr members decorators) @@ -160,6 +157,10 @@ DECORATORS — list of AST nodes for class-level decorators" (make-class-call (%js-lower-class-make-class-call super-expr ctor-lambda method-args static-args static-field-args private-static-args)) + (superclass-name + (or (and (ast-var-p super-expr) (ast-var-name super-expr)) + (and super-expr + (js-call-parser-handler :gdi-reference-name super-expr)))) ;; Single primary ast-defclass node — carries full semantic info for ;; tools/tests AND encodes the runtime implementation. :php-kind ;; :javascript tells codegen-clos to compile the :metaclass make-class-call @@ -168,8 +169,7 @@ DECORATORS — list of AST nodes for class-level decorators" (class-node (make-ast-defclass :name effective-name - :superclasses (when (and super-expr (ast-var-p super-expr)) - (list (ast-var-name super-expr))) + :superclasses (when superclass-name (list superclass-name)) :slots members :php-kind :javascript :metaclass make-class-call))) @@ -185,60 +185,57 @@ DECORATORS — list of decorator AST nodes collected before the class keyword. Returns (values ast-list rest) where AST-LIST is a list of AST nodes produced by %js-lower-class-to-ast." - ;; The 'class' keyword has already been consumed by the caller. + ;; The class keyword has already been consumed by the caller. (let ((current stream) (class-name nil) (super-expr nil)) - ;; Optional class name: present in declarations, optional in expressions + ;; Optional class name: present in declarations, optional in expressions. (when (eq (js-peek-type current) :T-IDENT) (multiple-value-bind (tok rest) (js-consume current) (setf class-name (js-ident-sym (js-tok-value tok)) current rest))) (unless (or expression-p class-name) (error "JS parse error: class declaration requires a name")) - ;; Optional: extends SuperClass - (when (and current (eq (js-peek-type current) :T-EXTENDS)) - (setf current (cdr current)) ; consume 'extends' - ;; Parse super-class reference (simple identifier or member expression) - (multiple-value-bind (tok rest) (js-expect :T-IDENT current) - (setf super-expr (make-ast-var :name (js-ident-sym (js-tok-value tok))) - current rest) - ;; Walk optional .Member access on super expression - (loop while (and current (eq (js-peek-type current) :T-DOT)) - do (setf current (cdr current)) ; consume '.' - (multiple-value-bind (mem-tok rest2) (js-expect :T-IDENT current) - (setf super-expr - (make-ast-call - :func (make-ast-var :name (js-ident-sym "%JS-GET-PROP")) - :args (list super-expr - (make-ast-quote - :value (js-tok-value mem-tok)))) - current rest2))))) - ;; Class body - (multiple-value-bind (members rest) (%js-parse-class-body current class-name) - (values (%js-lower-class-to-ast class-name super-expr members decorators) - rest)))) + ;; The name of a class expression is in scope during heritage evaluation and + ;; throughout the class body. + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (if (and expression-p class-name) + (cons class-name cl-cc/javascript/syntax:*js-gdi-shadowed-names*) + cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + ;; Parse the heritage as an expression so GDI resolves its identifiers. + (when (and current (eq (js-peek-type current) :T-EXTENDS)) + (setf current (cdr current)) + (multiple-value-bind (expr rest) (js-call-parser-handler :expression current) + (setf super-expr expr + current rest))) + (multiple-value-bind (members rest) + (%js-parse-class-body current class-name) + (values (%js-lower-class-to-ast class-name super-expr members decorators) + rest))))) + ;;; ─── js-parse-class-decl (public entry point) ─────────────────────────────── (eval-when (:load-toplevel :execute) - (register-js-parser-handler - '(:statement :T-CLASS) - (lambda (stream) - (multiple-value-bind (ast-list rest) (js-parse-class-decl stream) - (values (if (and (consp ast-list) (= (length ast-list) 1)) - (first ast-list) - (make-ast-progn :forms ast-list)) - rest)))) - (register-js-parser-handler - :statement-decorated-class - (lambda (stream) - (multiple-value-bind (decorators rest) (%js-parse-decorators stream) - (unless (eq (js-peek-type rest) :T-CLASS) - (error "JS parse error: decorators must precede a class declaration")) - (multiple-value-bind (ast-list rest2) - (js-parse-class-decl (cdr rest) :decorators decorators) - (values (if (and (consp ast-list) (= (length ast-list) 1)) - (first ast-list) - (make-ast-progn :forms ast-list)) - rest2)))))) + (register-js-parser-handler '(:statement :T-CLASS) + (lambda (stream) + (multiple-value-bind (ast-list rest) (js-parse-class-decl stream) + (values + (if (and (consp ast-list) (= (length ast-list) 1)) + (first ast-list) + (make-ast-progn :forms ast-list)) + rest)))) + (register-js-parser-handler :statement-decorated-class + (lambda (stream) + (multiple-value-bind (decorators rest) (%js-parse-decorators stream) + (unless (eq (js-peek-type rest) :T-CLASS) + (error + "JS parse error: decorators must precede a class declaration")) + (multiple-value-bind (ast-list rest2) + (js-parse-class-decl (cdr rest) :decorators decorators) + (values + (if (and (consp ast-list) (= (length ast-list) 1)) + (first ast-list) + (make-ast-progn :forms ast-list)) + rest2)))))) -(eval-when (:load-toplevel :execute) (register-js-parser-handler :class-declaration (function js-parse-class-decl))) +(eval-when (:load-toplevel :execute) + (register-js-parser-handler :class-declaration (function js-parse-class-decl))) diff --git a/src/classes/parser-class-member-syntax.lisp b/src/classes/parser-class-member-syntax.lisp index 93d9262..e6f58c5 100644 --- a/src/classes/parser-class-member-syntax.lisp +++ b/src/classes/parser-class-member-syntax.lisp @@ -11,13 +11,13 @@ (defun js-private-ident-sym (str) "Intern a JS private field name (without #) with a %JS-PRIV- prefix." (intern - (concatenate - 'string - "%JS-PRIV-" - (string-upcase - (if (stringp str) str - (symbol-name str)))) - :cl-cc/javascript)) + (concatenate 'string + "%JS-PRIV-" + (string-upcase + (if (stringp str) + str + (symbol-name str)))) + :cl-cc/javascript)) (defun %js-skip-balanced-until (stream delimiter-types) "Advance STREAM past tokens until reaching one whose type is in @@ -28,13 +28,10 @@ decorator argument or parameter default that is itself `foo(1,2)' or matched delimiter, or at EOF if none was found before the token list ran out." (let ((depth 0)) - (loop while (and stream - (or (plusp depth) - (not (member (js-peek-type stream) delimiter-types)))) + (loop while (and stream (or (plusp depth) (not (member (js-peek-type stream) delimiter-types)))) do (case (js-peek-type stream) ((:T-LPAREN :T-LBRACKET :T-LBRACE) (incf depth)) - ((:T-RPAREN :T-RBRACKET :T-RBRACE) (decf depth))) - (setf stream (cdr stream)))) + ((:T-RPAREN :T-RBRACKET :T-RBRACE) (decf depth))) (setf stream (cdr stream)))) stream) ;;; ─── Decorator parser ──────────────────────────────────────────────────────── @@ -43,11 +40,14 @@ out." into one SYM named \"FOO.BAR.BAZ\"). Returns (values extended-sym rest)." (let ((current stream)) (loop while (and current (eq (js-peek-type current) :T-DOT)) - do (setf current (cdr current)) - (multiple-value-bind (mem-tok rest) (js-expect :T-IDENT current) - (setf sym (js-ident-sym - (concatenate 'string (symbol-name sym) "." (js-tok-value mem-tok))) - current rest))) + do (setf current (cdr current)) (multiple-value-bind (mem-tok rest) + (js-expect :T-IDENT current) + (setf sym (js-ident-sym + (concatenate 'string + (symbol-name sym) + "." + (js-tok-value mem-tok))) + current rest))) (values sym current))) (defun %js-parse-decorator-args (stream) @@ -64,10 +64,18 @@ commas, nor its own closing delimiter for the decorator's. Returns (values args-list rest)." (let ((args nil)) (loop until (or (js-at-eof-p stream) (eq (js-peek-type stream) :T-RPAREN)) - do (push (make-ast-var :name (js-ident-sym "_decorator-arg_")) args) - (setf stream (%js-skip-balanced-until stream '(:T-COMMA :T-RPAREN))) - (when (and stream (eq (js-peek-type stream) :T-COMMA)) - (setf stream (cdr stream)))) + do (push (make-ast-var :name (js-ident-sym "_decorator-arg_")) args) (setf stream (%js-skip-balanced-until + stream + '(:T-COMMA + :T-RPAREN))) (when + (and + stream + (eq + (js-peek-type + stream) + :T-COMMA)) + (setf stream (cdr + stream)))) (values (nreverse args) stream))) (defun %js-parse-decorator (stream) @@ -96,8 +104,8 @@ Returns (values decorators-list rest)." (current stream)) (loop while (and current (eq (js-peek-type current) :T-AT)) do (multiple-value-bind (dec rest) (%js-parse-decorator current) - (push dec decorators) - (setf current rest))) + (push dec decorators) + (setf current rest))) (values (nreverse decorators) current))) ;;; ─── Computed member name ──────────────────────────────────────────────────── @@ -153,98 +161,97 @@ methods under ORIG-NAME); NIL for computed names." (multiple-value-bind (params body rest2) (%js-parse-method-params-body rest) (let* ((computed-p (not (symbolp name))) (sym - (if computed-p (gensym - (if (eq kind :getter) "JS-GETTER-" - "JS-SETTER-")) - name)) + (if computed-p + (gensym + (if (eq kind :getter) + "JS-GETTER-" + "JS-SETTER-")) + name)) (slot - (make-ast-slot-def - :name - sym - :initform - (make-ast-defun - :name - sym - :params - (unless (eq kind :getter) - params) - :body - (list body)) - :allocation - (if static-p :class - :instance) - :imports - (append - (when computed-p - (list :js-computed-key-ast name)) - (%js-member-kind-metadata kind static-p private-p nil nil decorators))))) + (make-ast-slot-def :name + sym + :initform + (make-ast-defun :name + sym + :params + (unless (eq kind :getter) + params) + :body + (list body)) + :allocation + (if static-p + :class + :instance) + :imports + (append + (when computed-p + (list :js-computed-key-ast name)) + (%js-member-kind-metadata kind + static-p + private-p + nil + nil + decorators))))) (values slot (js-skip-semis rest2)))))) (defun %js-parse-method-params-body (stream) - "Parse ( params ) { body } for a method. Returns (values params body rest). -Params is a list of symbols; body is an ast-progn of properly-parsed AST nodes. - -Previously this function collected method body tokens verbatim and stored them -as (ast-progn (ast-quote raw-token-list)). That meant class method bodies were -never compiled - every method silently became a no-op. Now the body is parsed -via js-parse-stmt-list (the real statement parser) so methods execute normally." - ;; Parameter list + "Parse ( params ) { body } for a method." (let ((rest (nth-value 1 (js-expect :T-LPAREN stream))) (params nil)) (loop until (or (js-at-eof-p rest) (eq (js-peek-type rest) :T-RPAREN)) do (cond - ;; Rest parameter ...name ((eq (js-peek-type rest) :T-ELLIPSIS) - (setf rest (cdr rest)) - (multiple-value-bind (tok rest2) (js-expect :T-IDENT rest) - (push (list :rest (js-ident-sym (js-tok-value tok))) params) - (setf rest rest2))) - ;; Normal identifier param (ignore defaults for now) - ((member (js-peek-type rest) '(:T-IDENT :T-THIS)) + (setf rest (cdr rest)) + (multiple-value-bind (tok rest2) (js-expect :T-IDENT rest) + (push (list :rest (js-ident-sym (js-tok-value tok))) params) + (setf rest rest2))) + ((member (js-peek-type rest) (quote (:T-IDENT :T-THIS))) (multiple-value-bind (tok rest2) (js-consume rest) (push (js-ident-sym (js-tok-value tok)) params) (setf rest rest2) - ;; Skip default value = expr. %JS-SKIP-BALANCED-UNTIL - ;; tracks nesting depth so a default that is itself a call - ;; or bracketed literal (m(a, b=foo(1,2))) doesn't stop at - ;; its own internal comma/close-paren instead of the - ;; parameter list's. - (when (and rest (eq (js-peek-type rest) :T-OP) - (equal "=" (js-peek-value rest))) + (when (and rest (eq (js-peek-type rest) :T-OP) (equal "=" (js-peek-value rest))) (setf rest (cdr rest)) - (setf rest (%js-skip-balanced-until rest '(:T-COMMA :T-RPAREN)))))) + (setf rest (%js-skip-balanced-until rest (quote (:T-COMMA :T-RPAREN))))))) (t - ;; Destructuring params or other complex params - skip token - (setf rest (cdr rest)))) - ;; consume comma separator - (when (and rest (eq (js-peek-type rest) :T-COMMA)) - (setf rest (cdr rest)))) + (setf rest (cdr rest)))) (when (and rest (eq (js-peek-type rest) :T-COMMA)) + (setf rest (cdr rest)))) (multiple-value-bind (_ rest2) (js-expect :T-RPAREN rest) (declare (ignore _)) - ;; Method body { stmts... } - ;; js-parse-stmt-list consumes the opening { and closing } and returns - ;; (values stmt-list rest-after-rbrace) - the real statement parser used - ;; by js-parse-block and js-parse-function-body. (multiple-value-bind (_ rest3) (js-expect :T-LBRACE rest2) (declare (ignore _)) - (multiple-value-bind (body-stmts rest4) (js-call-parser-handler :statement-list rest3) + (multiple-value-bind (body-stmts rest4) + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append + (mapcar + (lambda (param) + (if (and (consp param) (eq (first param) :rest)) + (second param) + param)) + (reverse params)) + cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (js-call-parser-handler :function-body rest3)) (let ((body-ast (make-ast-progn :forms (%js-callable-body body-stmts)))) (values (nreverse params) body-ast rest4))))))) -(defun %js-member-kind-metadata (kind static-p private-p async-p generator-p decorators &optional orig-name) +(defun %js-member-kind-metadata (kind static-p + private-p + async-p + generator-p + decorators + &optional + orig-name) "Build the :imports plist for a class member slot. ORIG-NAME is the original-case method name string (case-sensitive key for prototype)." - (append - (list :js-member-kind kind) - (when orig-name - (list :js-orig-name orig-name)) - (when static-p - (list :js-static t)) - (when private-p - (list :js-private t)) - (when async-p - (list :js-async t)) - (when generator-p - (list :js-generator t)) - (when decorators - (list :js-decorators decorators)))) + (append (list :js-member-kind kind) + (when orig-name + (list :js-orig-name orig-name)) + (when static-p + (list :js-static t)) + (when private-p + (list :js-private t)) + (when async-p + (list :js-async t)) + (when generator-p + (list :js-generator t)) + (when decorators + (list :js-decorators decorators)))) diff --git a/src/disposables/parser-stmt-flow.lisp b/src/disposables/parser-stmt-flow.lisp index 7f4af10..506d01b 100644 --- a/src/disposables/parser-stmt-flow.lisp +++ b/src/disposables/parser-stmt-flow.lisp @@ -4,11 +4,9 @@ ;;;; using declaration (ES2025). ;;;; ;;;; Load order: after parser-stmt.lisp and parser-stmt-control.lisp. - (in-package #:cl-cc/javascript/disposables) ;;; ─── Break / Continue ──────────────────────────────────────────────────────── - (defun js-parse-break-stmt (stream) "Parse break [label]; — emits (return-from label-block) for labeled, (go end) for plain." (let ((current stream) @@ -55,7 +53,6 @@ (values (make-ast-go :tag target) current)))))) ;;; ─── Return Statement ──────────────────────────────────────────────────────── - (defun js-parse-return-stmt (stream) "Parse return [expr];. Returns (values ast rest)." (if (or (js-at-eof-p stream) @@ -64,26 +61,23 @@ (values (make-ast-return-from :name nil :value (make-ast-quote :value nil)) (js-skip-semis stream)) (multiple-value-bind (expr rest) (js-call-parser-handler :expression stream) - (values (make-ast-return-from :name nil :value expr) - (js-skip-semis rest))))) + (values (make-ast-return-from :name nil :value expr) (js-skip-semis rest))))) ;;; ─── Throw Statement ───────────────────────────────────────────────────────── - (defun js-parse-throw-stmt (stream) "Parse throw expr; -> (values (%js-throw expr) rest)." (multiple-value-bind (expr rest) (js-call-parser-handler :expression stream) - (values (make-ast-call :func (make-ast-var :name '%js-throw) - :args (list expr)) + (values (make-ast-call :func (make-ast-var :name '%js-throw) :args (list expr)) (js-skip-semis rest)))) ;;; ─── Try / Catch / Finally ─────────────────────────────────────────────────── - (defun %js-parse-catch-binding (stream) "Parse an optional catch(e) binding at STREAM. Returns (values var-sym rest) — VAR-SYM is nil for a bindless `catch {}` or when STREAM has no parenthesized binding at all." (if (eq (js-peek-type stream) :T-LPAREN) - (let ((current (cdr stream)) (var-sym nil)) + (let ((current (cdr stream)) + (var-sym nil)) (when (eq (js-peek-type current) :T-IDENT) (multiple-value-bind (tok rest) (js-consume current) (setf var-sym (%js-binding-sym (js-tok-value tok)) @@ -92,17 +86,22 @@ parenthesized binding at all." (values nil stream))) (defun %js-parse-catch-clauses (stream) - "Parse zero or more `catch (e) {...}` clauses starting at STREAM (JS syntax -allows only one, but the loop mirrors the grammar rather than assuming it). -Returns (values clauses rest), CLAUSES a list of (var-sym body-forms) in -source order." - (let ((clauses nil) (current stream)) + "Parse zero or more catch clauses and return their bindings and bodies." + (let ((clauses nil) + (current stream)) (loop while (and current (eq (js-peek-type current) :T-CATCH)) - do (setf current (cdr current)) - (multiple-value-bind (var-sym rest) (%js-parse-catch-binding current) - (multiple-value-bind (catch-ast rest2) (js-parse-block rest) - (push (list var-sym (ast-progn-forms catch-ast)) clauses) - (setf current rest2)))) + do (setf current (cdr current)) (multiple-value-bind (var-sym rest) + (%js-parse-catch-binding current) + (multiple-value-bind (catch-ast rest2) + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append + (when var-sym + (list var-sym)) + cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (js-parse-block rest)) + (push (list var-sym (ast-progn-forms catch-ast)) + clauses) + (setf current rest2)))) (values (nreverse clauses) current))) (defun %js-parse-finally-clause (stream) @@ -122,10 +121,11 @@ when it declared one, or just running the body when it didn't. No clauses at all (a bare try/finally) yields nil — %js-try-catch-finally rethrows in that case." (if clauses - (let* ((clause (first clauses)) (var (first clause)) (body (second clause))) + (let* ((clause (first clauses)) + (var (first clause)) + (body (second clause))) (if var - (make-ast-let :bindings (list (cons var (make-ast-var :name err-sym))) - :body body) + (make-ast-let :bindings (list (cons var (make-ast-var :name err-sym))) :body body) (make-ast-progn :forms body))) (make-ast-quote :value nil))) @@ -135,33 +135,33 @@ case." Returns (values ast rest)." (multiple-value-bind (try-ast rest) (js-parse-block stream) (multiple-value-bind (clauses rest2) (%js-parse-catch-clauses rest) - (multiple-value-bind (finally-present-p finally-body rest3) - (%js-parse-finally-clause rest2) + (multiple-value-bind (finally-present-p finally-body rest3) (%js-parse-finally-clause rest2) (unless (or clauses finally-present-p) (error "JS parse error: try must have catch or finally")) (let* ((err-sym (gensym "JS-ERR-")) (catch-dispatch (%js-build-catch-dispatch clauses err-sym)) (protected - (make-ast-call - :func (make-ast-var :name '%js-try-catch-finally) - :args (list (make-ast-lambda :params nil :body (ast-progn-forms try-ast)) - (make-ast-lambda :params (list err-sym) - :body (list catch-dispatch)) - (make-ast-lambda :params nil - :body (or finally-body - (list (make-ast-quote :value nil)))))))) + (make-ast-call :func + (make-ast-var :name '%js-try-catch-finally) + :args + (list (make-ast-lambda :params nil :body (ast-progn-forms try-ast)) + (make-ast-lambda :params + (list err-sym) + :body + (list catch-dispatch)) + (make-ast-lambda :params + nil + :body + (or finally-body + (list (make-ast-quote :value nil)))))))) (values protected rest3)))))) ;;; ─── Debugger Statement ────────────────────────────────────────────────────── - (defun js-parse-debugger-stmt (stream) "Parse debugger; -> (values (%js-debugger) rest)." - (values (make-ast-call :func (make-ast-var :name '%js-debugger) - :args nil) - (js-skip-semis stream))) + (values (make-ast-call :func (make-ast-var :name '%js-debugger) :args nil) (js-skip-semis stream))) ;;; ─── Using Declaration (ES2025 Explicit Resource Management) ───────────────── - (defun js-parse-using-decl (stream) "Parse using x = expr (ES2025 explicit resource management). Lowers to ast-let + registration of disposable resource on scope exit. @@ -185,8 +185,8 @@ case." :declarations (list :js-using) :body nil) (js-skip-semis rest3))))))) -;;; ─── Using Declaration (ES2025 Explicit Resource Management) ───────────────── +;;; ─── Using Declaration (ES2025 Explicit Resource Management) ───────────────── (eval-when (:load-toplevel :execute) (register-js-parser-handler '(:statement :T-BREAK) (function js-parse-break-stmt)) (register-js-parser-handler '(:statement :T-CONTINUE) (function js-parse-continue-stmt)) diff --git a/src/expressions/parser-expr-gdi.lisp b/src/expressions/parser-expr-gdi.lisp new file mode 100644 index 0000000..10a600d --- /dev/null +++ b/src/expressions/parser-expr-gdi.lisp @@ -0,0 +1,164 @@ +(in-package #:cl-cc/javascript/expressions) + +(defun %js-gdi-global-name-p (name) + (and + (or cl-cc/javascript/syntax:*js-gdi-global-reference-mode* + (member name cl-cc/javascript/syntax:*js-gdi-global-lexical-names* :test (function eq)) + (member name cl-cc/javascript/syntax:*js-gdi-global-var-names* :test (function eq))) + (not (member name cl-cc/javascript/syntax:*js-gdi-shadowed-names* :test (function eq))))) + +(defun %js-gdi-reference-ast (name) + (if (%js-gdi-global-name-p name) + (js-call-parser-handler :gdi-global-read-ast name) + (make-ast-var :name name))) + +(defun %js-gdi-reference-name (ast) + (when + (and (ast-call-p ast) + (ast-var-p (ast-call-func ast)) + (string= "%JS-GDI-GLOBAL-READ" (symbol-name (ast-var-name (ast-call-func ast))))) + (let ((argument (first (ast-call-args ast)))) + (when (cl-cc/ast:ast-quote-p argument) + (cl-cc/ast:ast-quote-value argument))))) + +(defun %js-gdi-global-write-ast (name value) + (js-call-parser-handler :gdi-global-write-ast name value)) + +(defun %js-gdi-lower-global-logical-assign (op name read-ast rhs) + (let* ((kind (%js-logical-assign-short-circuit-p op)) + (temporary (gensym "JS-GDI-LOGICAL-")) + (current (make-ast-var :name temporary)) + (test + (if (eq kind :non-null) + (%js-call (quote %js-not-nullish) current) + (%js-call (quote %js-truthy) current))) + (assign (%js-gdi-global-write-ast name rhs)) + (result + (ecase kind + (:truthy (make-ast-if :cond test :then assign :else current)) + (:falsy (make-ast-if :cond test :then current :else assign)) + (:non-null (make-ast-if :cond test :then current :else assign))))) + (make-ast-let :bindings (list (cons temporary read-ast)) :body (list result)))) + +(defun %js-gdi-function-var-names (forms) + (let ((names nil)) + (labels ((visit (node) + (cond + ((or (cl-cc/ast:ast-defun-p node) + (cl-cc/ast:ast-defclass-p node) + (cl-cc/ast:ast-lambda-p node)) nil) + ((and (cl-cc/ast:ast-call-p node) + (cl-cc/ast:ast-var-p (cl-cc/ast:ast-call-func node)) + (string= "%JS-TRY-CATCH-FINALLY" + (symbol-name + (cl-cc/ast:ast-var-name (cl-cc/ast:ast-call-func node))))) + (dolist (arg (cl-cc/ast:ast-call-args node)) + (if (cl-cc/ast:ast-lambda-p arg) + (dolist (form (cl-cc/ast:ast-lambda-body arg)) + (visit form)) + (visit arg)))) + (t + (when + (and (cl-cc/ast:ast-let-p node) + (member :var (cl-cc/ast:ast-let-declarations node))) + (dolist (binding (cl-cc/ast:ast-let-bindings node)) + (let ((name (car binding))) + (when + (and (symbolp name) + (eq (symbol-package name) (find-package :cl-cc/javascript))) + (push name names))))) + (dolist (child (cl-cc/ast:ast-children node)) + (visit child)))))) + (dolist (form forms) + (visit form))) + (nreverse names))) + +(defun %js-gdi-function-lexical-names (forms) + (let ((names nil)) + (labels ((visit-direct (items) + (dolist (node items) + (cond + ((cl-cc/ast:ast-defun-p node) (push (cl-cc/ast:ast-defun-name node) names)) + ((cl-cc/ast:ast-defclass-p node) (push (cl-cc/ast:ast-defclass-name node) names)) + ((cl-cc/ast:ast-let-p node) + (when + (intersection (cl-cc/ast:ast-let-declarations node) + '(:let :const) + :test + #'eq) + (dolist (binding (cl-cc/ast:ast-let-bindings node)) + (let ((name (car binding))) + (when + (and (symbolp name) + (eq (symbol-package name) (find-package :cl-cc/javascript))) + (push name names))))) + (when + (intersection (cl-cc/ast:ast-let-declarations node) + '(:var :let :const) + :test + #'eq) + (visit-direct (cl-cc/ast:ast-let-body node)))))))) + (visit-direct forms) + (nreverse names)))) + +(defun js-parse-function-body (stream) + "Parse statements inside a function body after its opening brace." + (if cl-cc/javascript/syntax:*js-gdi-global-reference-mode* + (multiple-value-bind (raw-forms raw-rest) + (let ((cl-cc/javascript/syntax:*js-gdi-global-reference-mode* nil)) + (js-call-parser-handler :function-body-statement-list stream)) + (declare (ignore raw-rest)) + (let* ((local-names + (append (%js-gdi-function-var-names raw-forms) + (%js-gdi-function-lexical-names raw-forms))) + (cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append local-names cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (js-call-parser-handler :function-body-statement-list stream))) + (js-call-parser-handler :function-body-statement-list stream))) +(defun js-parse-function-expr (stream &key async-p generator-p name) + "Parse a JavaScript function expression." + (let ((current stream) + (is-generator generator-p) + (named-expression-p nil)) + (when (js-at-op-p current "*") + (%js-consume-then (rest (js-consume current)) + (setf is-generator t + current rest))) + (when (and (null name) (eq (js-peek-type current) :T-IDENT)) + (multiple-value-bind (name-token rest) (js-consume current) + (setf name (js-ident-sym (js-tok-value name-token)) + named-expression-p t + current rest))) + (let* ((name-shadow + (when named-expression-p + (list name))) + (first-pass + (multiple-value-list + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append name-shadow cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (js-call-parser-handler :function-params current)))) + (all-params (first first-pass))) + (multiple-value-bind (params optionals rest-sym rest2) + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append all-params name-shadow cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (js-call-parser-handler :function-params current)) + (%js-consume-then (rest3 (js-expect :T-LBRACE rest2)) + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append params + (when name + (list name)) + cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (multiple-value-bind (body-forms rest4) (js-parse-function-body rest3) + (values + (%js-build-function-expr-ast params + optionals + rest-sym + body-forms + async-p + is-generator + name) + rest4)))))))) + +(eval-when (:load-toplevel :execute) + (register-js-parser-handler :function-body (function js-parse-function-body)) + (register-js-parser-handler :gdi-reference-name (function %js-gdi-reference-name))) diff --git a/src/expressions/parser-expr-incdec.lisp b/src/expressions/parser-expr-incdec.lisp index f793c27..709a96f 100644 --- a/src/expressions/parser-expr-incdec.lisp +++ b/src/expressions/parser-expr-incdec.lisp @@ -1,15 +1,13 @@ (in-package #:cl-cc/javascript/expressions) ;;; ─── Increment / decrement on places (obj.x / arr[i]) ──────────────────────── - (defun %js-place-get-prop-p (ast) "True when AST is an assignable property place — either a public property access (%js-get-prop OBJ KEY) or a private field access (%js-class-private-field-get OBJ KEY)." (and (ast-call-p ast) (ast-var-p (ast-call-func ast)) - (member (ast-var-name (ast-call-func ast)) - '(%js-get-prop %js-class-private-field-get)) + (member (ast-var-name (ast-call-func ast)) '(%js-get-prop %js-class-private-field-get)) (= (length (ast-call-args ast)) 2))) (defun %js-lower-place-incdec (place op return-new-p) @@ -18,58 +16,77 @@ PLACE may be a public (%js-get-prop) or private (%js-class-private-field-get) ac OP is '+ or '-. RETURN-NEW-P true means prefix (yields updated value); false means postfix (yields original). OBJ and KEY are captured in temps so the place expression is evaluated exactly once." - (let* ((obj (first (ast-call-args place))) - (key (second (ast-call-args place))) - (get-fn (ast-var-name (ast-call-func place))) - (set-fn (if (eq get-fn '%js-class-private-field-get) - '%js-class-private-field-set - '%js-set-prop)) + (let* ((obj (first (ast-call-args place))) + (key (second (ast-call-args place))) + (get-fn (ast-var-name (ast-call-func place))) + (set-fn + (if (eq get-fn '%js-class-private-field-get) + '%js-class-private-field-set + '%js-set-prop)) (obj-tmp (gensym "JS-OBJ-")) (key-tmp (gensym "JS-KEY-")) (old-tmp (gensym "JS-OLD-"))) (flet ((bumped () - (make-ast-binop :op op - :lhs (make-ast-var :name old-tmp) - :rhs (make-ast-int :value 1)))) - (make-ast-let - :bindings (list (cons obj-tmp obj) (cons key-tmp key)) - :body - (list - (make-ast-let - :bindings (list (cons old-tmp (%js-call get-fn - (make-ast-var :name obj-tmp) - (make-ast-var :name key-tmp)))) - :body (list (%js-call set-fn - (make-ast-var :name obj-tmp) - (make-ast-var :name key-tmp) - (bumped)) - (if return-new-p (bumped) (make-ast-var :name old-tmp))))))))) + (make-ast-binop :op op :lhs (make-ast-var :name old-tmp) :rhs (make-ast-int :value 1)))) + (make-ast-let :bindings + (list (cons obj-tmp obj) (cons key-tmp key)) + :body + (list + (make-ast-let :bindings + (list + (cons old-tmp + (%js-call get-fn + (make-ast-var :name obj-tmp) + (make-ast-var :name key-tmp)))) + :body + (list + (%js-call set-fn + (make-ast-var :name obj-tmp) + (make-ast-var :name key-tmp) + (bumped)) + (if return-new-p + (bumped) + (make-ast-var :name old-tmp))))))))) (defun %js-incdec-setq (var-sym op-sym) "The (setq VAR-SYM (OP-SYM VAR-SYM 1)) AST shared by ++/--'s plain-variable prefix and postfix lowering below." - (make-ast-setq :var var-sym - :value (make-ast-binop :op op-sym - :lhs (make-ast-var :name var-sym) - :rhs (make-ast-int :value 1)))) + (make-ast-setq :var + var-sym + :value + (make-ast-binop :op + op-sym + :lhs + (make-ast-var :name var-sym) + :rhs + (make-ast-int :value 1)))) (defun %js-lower-incdec (expr op-sym prefix-p fallback-helper) - "Lower a ++/-- application to EXPR (OP-SYM is '+ or '-), shared by prefix -and postfix parsing. A plain variable rewrites to a direct setq (prefix: -yields the updated value; postfix: binds the original to a temp and yields -that). A property/element place delegates to %js-lower-place-incdec, which -already knows prefix vs postfix. Anything else falls back to FALLBACK-HELPER -\(%js-prefix-inc / %js-postfix-inc / -dec at the call site)." - (cond - ((ast-var-p expr) - (let ((var-sym (ast-var-name expr))) - (if prefix-p - (%js-incdec-setq var-sym op-sym) - (let ((tmp (gensym "JS-POSTFIX-"))) - (make-ast-let - :bindings (list (cons tmp (make-ast-var :name var-sym))) - :body (list (%js-incdec-setq var-sym op-sym) - (make-ast-var :name tmp))))))) - ((%js-place-get-prop-p expr) - (%js-lower-place-incdec expr op-sym prefix-p)) - (t (%js-call fallback-helper expr)))) + (let ((global-name (%js-gdi-reference-name expr))) + (cond + (global-name + (let ((tmp (gensym "JS-GDI-INCDEC-"))) + (flet ((bumped (value) + (make-ast-binop :op op-sym :lhs value :rhs (make-ast-int :value 1))) + (write-value (value) + (%js-gdi-global-write-ast global-name value))) + (if prefix-p + (write-value (bumped expr)) + (make-ast-let :bindings + (list (cons tmp expr)) + :body + (list + (make-ast-progn :forms + (list (write-value (bumped (make-ast-var :name tmp))) + (make-ast-var :name tmp))))))))) + ((ast-var-p expr) + (let ((var-sym (ast-var-name expr))) + (if prefix-p + (%js-incdec-setq var-sym op-sym) + (let ((tmp (gensym "JS-POSTFIX-"))) + (make-ast-let :bindings + (list (cons tmp (make-ast-var :name var-sym))) + :body + (list (%js-incdec-setq var-sym op-sym) (make-ast-var :name tmp))))))) + ((%js-place-get-prop-p expr) (%js-lower-place-incdec expr op-sym prefix-p)) + (t (%js-call fallback-helper expr))))) diff --git a/src/expressions/parser-expr-literal.lisp b/src/expressions/parser-expr-literal.lisp index de26706..f1a7c09 100644 --- a/src/expressions/parser-expr-literal.lisp +++ b/src/expressions/parser-expr-literal.lisp @@ -59,26 +59,34 @@ Handles elision (holes), spread elements, and assignment expressions." (defun %js-parse-object-property-spread (stream) "...expr — STREAM points at the ellipsis token." (%js-consume-then (rest (js-consume stream)) - (multiple-value-bind (expr rest2) (js-parse-assignment-expr rest) - (values :spread expr nil nil rest2)))) + (multiple-value-bind (expr rest2) (js-parse-assignment-expr rest) + (values :spread expr nil nil rest2)))) (defun %js-parse-object-property-computed (stream) "[expr]: value or [expr](...) {} — STREAM points at '['." (%js-consume-then (rest (js-consume stream)) - (multiple-value-bind (key-expr rest2) (js-parse-assignment-expr rest) - (%js-consume-then (rest3 (js-expect :T-RBRACKET rest2)) - (if (eq (js-peek-type rest3) :T-LPAREN) (multiple-value-bind (fn-ast rest4) (js-parse-function-expr rest3 :name nil) - (values key-expr fn-ast t t rest4)) - (%js-consume-then (rest4 (js-expect :T-COLON rest3)) - (multiple-value-bind (val-expr rest5) (js-parse-assignment-expr rest4) - (values key-expr val-expr nil t rest5)))))))) + (multiple-value-bind (key-expr rest2) (js-parse-assignment-expr rest) + (%js-consume-then (rest3 (js-expect :T-RBRACKET rest2)) + (if (eq (js-peek-type rest3) :T-LPAREN) + (multiple-value-bind (fn-ast rest4) + (js-parse-function-expr rest3 :name nil) + (values key-expr fn-ast t t rest4)) + (%js-consume-then (rest4 (js-expect :T-COLON rest3)) + (multiple-value-bind (val-expr rest5) + (js-parse-assignment-expr rest4) + (values key-expr + val-expr + nil + t + rest5)))))))) (defun %js-parse-object-property-generator-method (stream) "*name(...) {} — STREAM points past '*'." (let ((key-str (js-peek-value stream))) (%js-consume-then (rest (js-consume stream)) - (multiple-value-bind (fn-ast rest2) (js-parse-function-expr rest :generator-p t :name (js-ident-sym key-str)) - (values (make-ast-quote :value key-str) fn-ast t nil rest2))))) + (multiple-value-bind (fn-ast rest2) + (js-parse-function-expr rest :generator-p t :name (js-ident-sym key-str)) + (values (make-ast-quote :value key-str) fn-ast t nil rest2))))) (defun %js-parse-object-property-async-method (stream) "async [*]name(...) {} or the {async} shorthand — STREAM points past 'async'." @@ -111,19 +119,28 @@ Handles elision (holes), spread elements, and assignment expressions." (multiple-value-bind (val-expr rest3) (js-parse-assignment-expr rest2) (values (make-ast-quote :value "async") val-expr nil nil rest3))) (values (make-ast-quote :value "async") - (make-ast-var :name key-sym) + (%js-gdi-reference-ast key-sym) nil nil stream))))))) (defun %js-parse-object-property-accessor (stream) "get name() {} / set name(x) {} — STREAM points at the T-GET/T-SET token." (let ((accessor-kind (js-tok-value (car stream)))) (%js-consume-then (rest (js-consume stream)) - (let ((key-str (js-peek-value rest))) - (%js-consume-then (rest2 (js-consume rest)) - (multiple-value-bind (fn-ast rest3) (js-parse-function-expr rest2 :name (js-ident-sym key-str)) - (let ((tagged-fn - (%js-call '%js-accessor (make-ast-quote :value accessor-kind) fn-ast))) - (values (make-ast-quote :value key-str) tagged-fn t nil rest3)))))))) + (let ((key-str (js-peek-value rest))) + (%js-consume-then (rest2 (js-consume rest)) + (multiple-value-bind (fn-ast rest3) + (js-parse-function-expr rest2 + :name + (js-ident-sym key-str)) + (let ((tagged-fn + (%js-call '%js-accessor + (make-ast-quote :value accessor-kind) + fn-ast))) + (values (make-ast-quote :value key-str) + tagged-fn + t + nil + rest3)))))))) (defun %js-parse-object-property-shorthand-or-method-or-kv (stream key-str) "name(...) {} / name: value / {name} shorthand — STREAM points past the @@ -143,7 +160,7 @@ already-consumed key token; KEY-STR is that key's value." ;; Shorthand: { name } — same as { name: name } (t (values (make-ast-quote :value key-str) - (make-ast-var :name (js-ident-sym key-str)) + (%js-gdi-reference-ast (js-ident-sym key-str)) nil nil stream))))) (defun %js-parse-object-property (stream) @@ -264,34 +281,3 @@ this AST-building logic at its deepest, hardest-to-read level." (make-ast-var :name name))) result))))) -(defun js-parse-function-expr (stream &key async-p generator-p name) - "Parse function [*] [name] (params) { body } as expression. -ASYNC-P and GENERATOR-P are boolean flags from the calling context. -NAME is an optional symbol for the function name. -Returns (values ast rest)." - (let ((current stream) - (is-generator generator-p)) - ;; Consume optional * for generators - (when (js-at-op-p current "*") - (%js-consume-then (rest (js-consume current)) - (setf is-generator t - current rest))) - ;; Optional function name - (when (and (null name) (eq (js-peek-type current) :T-IDENT)) - (multiple-value-bind (name-tok rest) (js-consume current) - (setf name (js-ident-sym (js-tok-value name-tok)) - current rest))) - ;; Parameter list - (multiple-value-bind (params optionals rest-sym rest2) - (js-call-parser-handler :function-params current) - ;; Body: { stmts... } - (%js-consume-then (rest3 (js-expect :T-LBRACE rest2)) - (multiple-value-bind (body-forms rest4) - (js-parse-function-body rest3) - (values (%js-build-function-expr-ast - params optionals rest-sym body-forms async-p is-generator name) - rest4)))))) - -(defun js-parse-function-body (stream) - "Parse statements inside { } until matching }." - (js-call-parser-handler :statement-list stream)) diff --git a/src/expressions/parser-expr-primary.lisp b/src/expressions/parser-expr-primary.lisp index 529654f..feed5b0 100644 --- a/src/expressions/parser-expr-primary.lisp +++ b/src/expressions/parser-expr-primary.lisp @@ -9,11 +9,9 @@ ;;;; postfix, template literal, and unary parsers. ;;;; ;;;; Load order: after parser-expr.lisp, before parser-stmt.lisp. - (in-package #:cl-cc/javascript/expressions) ;;; ─── Primary Expression ────────────────────────────────────────────────────── - ;;; Data table: token type -> zero-arg AST builder, for primary tokens that ;;; consume exactly one token and always build the same fixed AST node ;;; (booleans, null, undefined, this, super). Mirrors *js-unary-kw-builders* @@ -117,7 +115,7 @@ yield, await, import()." (%js-consume-then (rest (js-consume stream)) (if (eq (js-peek-type rest) :T-ARROW) (js-call-parser-handler :function-finish-arrow (list (js-ident-sym val)) rest) - (values (make-ast-var :name (js-ident-sym val)) rest)))) + (values (%js-gdi-reference-ast (js-ident-sym val)) rest)))) ;; Private field identifier #name — as standalone (for #name in obj) (:T-PRIVATE-IDENT (%js-consume-then (rest (js-consume stream)) @@ -129,14 +127,12 @@ yield, await, import()." ;; with parser-stmt-binding.lisp) lives here instead of as a clause key. (if (member type *js-contextual-keyword-token-types* :test #'eq) (%js-consume-then (rest (js-consume stream)) - (values (make-ast-var :name (js-ident-sym val)) rest)) + (values (%js-gdi-reference-ast (js-ident-sym val)) rest)) (error "JS parse error: unexpected token ~S in expression" (js-peek stream)))))))) - ;;; Arrow/paren/async/class/import expression helpers → see parser-arrow.lisp ;;; Main Pratt parser → see below (js-parse-expr, js-parse-assignment-expr) ;;; ─── Main Pratt Parser ─────────────────────────────────────────────────────── - (defun js-parse-expr (stream &optional (min-prec 0)) "Main Pratt expression parser. Returns (values ast rest). Handles all infix operators at precedence >= MIN-PREC including @@ -197,57 +193,54 @@ assignment (right-assoc), ternary, binary ops, and comma." (defun %js-lower-assignment (op-val lhs rhs) "Lower an assignment expression LHS op RHS to the appropriate AST." - (cond - ;; Simple variable assignment - ((ast-var-p lhs) - (let ((var-sym (ast-var-name lhs))) + (let ((global-name (%js-gdi-reference-name lhs))) + (cond + (global-name (cond - ((string= op-val "=") - (make-ast-setq :var var-sym :value rhs)) - ;; Logical assign + ((string= op-val "=") (%js-gdi-global-write-ast global-name rhs)) ((assoc op-val *js-logical-assign-ops* :test #'string=) - (%js-lower-logical-assign op-val var-sym rhs)) - ;; Compound assign - (t - (make-ast-setq :var var-sym - :value (%js-compound-rhs op-val lhs rhs)))))) - ;; Property assignment: obj.prop = val or obj[key] = val - ((and (ast-call-p lhs) - (ast-var-p (ast-call-func lhs)) - (eq (ast-var-name (ast-call-func lhs)) '%js-get-prop)) - (let ((obj (first (ast-call-args lhs))) - (key (second (ast-call-args lhs)))) - (cond - ((string= op-val "=") - (%js-call '%js-set-prop obj key rhs)) - (t - ;; Compound prop assign: obj.k op= rhs → obj.k = (obj.k op rhs) - (let ((obj-tmp (gensym "JS-OBJ-")) - (key-tmp (gensym "JS-KEY-"))) - (make-ast-let - :bindings (list (cons obj-tmp obj) (cons key-tmp key)) - :body (list (%js-call '%js-set-prop - (make-ast-var :name obj-tmp) - (make-ast-var :name key-tmp) - (%js-compound-rhs op-val lhs rhs))))))))) - ;; Private field assignment - ((and (ast-call-p lhs) - (ast-var-p (ast-call-func lhs)) - (eq (ast-var-name (ast-call-func lhs)) '%js-class-private-field-get)) - (let ((obj (first (ast-call-args lhs))) - (key (second (ast-call-args lhs)))) - (%js-call '%js-class-private-field-set obj key rhs))) - ;; Destructuring assignment (array or object pattern) — lower to runtime helper - (t - (%js-call '%js-assign-pattern lhs rhs)))) + (%js-gdi-lower-global-logical-assign op-val global-name lhs rhs)) + (t (%js-gdi-global-write-ast global-name (%js-compound-rhs op-val lhs rhs))))) + ((ast-var-p lhs) + (let ((var-sym (ast-var-name lhs))) + (cond + ((string= op-val "=") (make-ast-setq :var var-sym :value rhs)) + ((assoc op-val *js-logical-assign-ops* :test #'string=) + (%js-lower-logical-assign op-val var-sym rhs)) + (t (make-ast-setq :var var-sym :value (%js-compound-rhs op-val lhs rhs)))))) + ((and (ast-call-p lhs) + (ast-var-p (ast-call-func lhs)) + (eq (ast-var-name (ast-call-func lhs)) '%js-get-prop)) + (let ((obj (first (ast-call-args lhs))) + (key (second (ast-call-args lhs)))) + (cond + ((string= op-val "=") (%js-call '%js-set-prop obj key rhs)) + (t + (let ((obj-tmp (gensym "JS-OBJ-")) + (key-tmp (gensym "JS-KEY-"))) + (make-ast-let :bindings + (list (cons obj-tmp obj) (cons key-tmp key)) + :body + (list + (%js-call '%js-set-prop + (make-ast-var :name obj-tmp) + (make-ast-var :name key-tmp) + (%js-compound-rhs op-val lhs rhs))))))))) + ((and (ast-call-p lhs) + (ast-var-p (ast-call-func lhs)) + (eq (ast-var-name (ast-call-func lhs)) '%js-class-private-field-get)) + (let ((obj (first (ast-call-args lhs))) + (key (second (ast-call-args lhs)))) + (%js-call '%js-class-private-field-set obj key rhs))) + (t (%js-call '%js-assign-pattern lhs rhs))))) (defun js-parse-assignment-expr (stream) "Like js-parse-expr but stops at comma (min-prec = 2). Use for function arguments and array/object elements." (js-parse-expr stream 2)) + (eval-when (:load-toplevel :execute) (register-js-parser-handler :expression (function js-parse-expr)) (register-js-parser-handler :assignment-expression (function js-parse-assignment-expr))) ;;; ─── Entry Point Helpers ───────────────────────────────────────────────────── - diff --git a/src/expressions/parser-expr-unary.lisp b/src/expressions/parser-expr-unary.lisp index bf9e414..f4a8dbb 100644 --- a/src/expressions/parser-expr-unary.lisp +++ b/src/expressions/parser-expr-unary.lisp @@ -15,14 +15,13 @@ (let ((tok (js-peek stream))) (case (js-tok-type tok) (:T-STRING - (multiple-value-bind (str-tok rest) (js-consume stream) - (values (list (js-tok-value str-tok)) rest))) + (multiple-value-bind (str-tok rest) (js-consume stream) + (values (list (js-tok-value str-tok)) rest))) (:T-TEMPLATE-PARTS - (multiple-value-bind (parts-tok rest) (js-consume stream) - (values (js-tok-value parts-tok) rest))) + (multiple-value-bind (parts-tok rest) (js-consume stream) + (values (js-tok-value parts-tok) rest))) (:T-TEMPLATE-START - (%js-consume-then (rest (js-consume stream)) - (%js-template-parts-and-rest rest))) + (%js-consume-then (rest (js-consume stream)) (%js-template-parts-and-rest rest))) (t (error "JS parse error: expected template literal, got ~S" tok))))) (defun %js-parse-tagged-template (tag-ast stream) @@ -44,24 +43,22 @@ lexer segment, not one concatenated run." (dolist (part parts) (cond ((and (consp part) (eq (car part) :text)) - (push (make-ast-quote :value (second part)) cooked) - (push (make-ast-quote :value (third part)) raw)) + (push (make-ast-quote :value (second part)) cooked) + (push (make-ast-quote :value (third part)) raw)) ((and (consp part) (eq (car part) :template-expr)) (multiple-value-bind (expr _r) (js-parse-assignment-expr (cadr part)) (declare (ignore _r)) (push expr values))))) (values - (make-ast-call - :func - tag-ast - :args - (cons - (%js-call - '%js-make-tagged-template-strings - (apply #'%js-call '%js-make-array (nreverse cooked)) - (apply #'%js-call '%js-make-array (nreverse raw))) - (nreverse values))) - rest)))) + (make-ast-call :func + tag-ast + :args + (cons + (%js-call '%js-make-tagged-template-strings + (apply #'%js-call '%js-make-array (nreverse cooked)) + (apply #'%js-call '%js-make-array (nreverse raw))) + (nreverse values))) + rest)))) (defun %js-parse-template-literal (stream) "Parse a template literal starting at :T-TEMPLATE-START or :T-STRING. @@ -104,42 +101,43 @@ Returns (values ast rest)." ;;; Prefix ++/--, unary -, and yield have special logic and are handled explicitly. ;;; OP-string unaries: maps operator string -> (lambda (expr) -> ast). ;;; Excludes - (constant folding), ++ and -- (place/var dispatch). -(define-builder-table - *js-unary-op-builders* - (:documentation - "Data table: JS unary OP string -> AST builder (lambda (expr) -> ast). +(define-builder-table *js-unary-op-builders* + (:documentation + "Data table: JS unary OP string -> AST builder (lambda (expr) -> ast). Only for simple single-argument operators; -, ++, --, yield handled separately.") - ("!" - (lambda (expr) - (%js-not (%js-call '%js-truthy expr)))) - ("~" - (lambda (expr) - (%js-call '%js-bitwise-not expr))) - ("+" - (lambda (expr) - (%js-call '%js-unary-plus expr)))) + ("!" + (lambda (expr) + (%js-not (%js-call '%js-truthy expr)))) + ("~" + (lambda (expr) + (%js-call '%js-bitwise-not expr))) + ("+" + (lambda (expr) + (%js-call '%js-unary-plus expr)))) ;;; Keyword unaries: maps token type -> (lambda (expr) -> ast). ;;; typeof/void/delete/await all follow the same consume-one-token pattern. -(define-builder-table - *js-unary-kw-builders* - (:test - #'eq - :documentation - "Data table: keyword unary token type -> AST builder (lambda (expr) -> ast). -typeof/void/delete/await all consume one token and wrap the sub-expression.") - (:T-TYPEOF - (lambda (expr) - (%js-call '%js-typeof expr))) - (:T-DELETE - (lambda (expr) - (%js-call '%js-delete expr))) - (:T-AWAIT - (lambda (expr) - (%js-call '%js-await expr))) - (:T-VOID - (lambda (expr) - (make-ast-progn :forms (list expr (make-ast-quote :value :js-undefined)))))) +(define-builder-table *js-unary-kw-builders* + (:test (function eq) + :documentation + "Data table: keyword unary token type to AST builder. typeof/void/delete/await consume one token and wrap the sub-expression.") + (:T-TYPEOF + (lambda (expr) + (let ((global-name + (and cl-cc/javascript/syntax:*js-gdi-global-reference-mode* + (js-call-parser-handler :gdi-reference-name expr)))) + (if global-name + (js-call-parser-handler :gdi-global-typeof-ast global-name) + (%js-call '%js-typeof expr))))) + (:T-DELETE + (lambda (expr) + (%js-call '%js-delete expr))) + (:T-AWAIT + (lambda (expr) + (%js-call '%js-await expr))) + (:T-VOID + (lambda (expr) + (make-ast-progn :forms (list expr (make-ast-quote :value :js-undefined)))))) (defun %js-parse-yield-expr (stream) "Parse 'yield', 'yield expr', or 'yield* expr'. STREAM points at the yield diff --git a/src/functions/parser-arrow.lisp b/src/functions/parser-arrow.lisp index 33db59c..396d5b8 100644 --- a/src/functions/parser-arrow.lisp +++ b/src/functions/parser-arrow.lisp @@ -14,150 +14,163 @@ (in-package #:cl-cc/javascript/functions) (defun %js-parse-arrow-or-paren-item (current) - "Parse one non-rest item in a parenthesized-expression/arrow-param list at -CURRENT: try it as an assignment-expr, then classify it as a default param -(`x = e`), a plain identifier param, a destructurable pattern, or (if none of -those fit) a plain expression that disqualifies the arrow-function reading. -Returns (values new-current expr-form param-sym optional-pair pattern-pair -arrow-candidate-p): PARAM-SYM/OPTIONAL-PAIR/PATTERN-PAIR are NIL when not -applicable to this item; EXPR-FORM is always this item's expression-position -AST (the non-arrow fallback); ARROW-CANDIDATE-P is NIL only when this item -rules out the whole list being arrow params." - (multiple-value-bind (expr rest2) (js-call-parser-handler :assignment-expression current) - (setf current rest2) - ;; Default parameter: `var = default'. js-parse-assignment-expr - ;; stops at the `=' here (it is not an assignment operator in this - ;; position), so consume it ourselves and parse the default. - (if (and (ast-var-p expr) - (js-at-op-p current "=")) - (multiple-value-bind (eq-tok rest3) (js-consume current) - (declare (ignore eq-tok)) - (multiple-value-bind (default-expr rest4) - (js-call-parser-handler :assignment-expression rest3) - (values rest4 - ;; non-arrow fallback: a parenthesized assignment expr - (make-ast-setq :var (ast-var-name expr) :value default-expr) - (ast-var-name expr) - (cons (ast-var-name expr) default-expr) - nil - t))) + "Parse one expression item and classify it as an arrow parameter when possible." + (let ((start current)) + (multiple-value-bind (expr rest2) (js-call-parser-handler :assignment-expression current) + (setf current rest2) + (let* ((assignment-p + (and (cl-cc/ast:ast-setq-p expr) + (eq (js-peek-type start) :T-IDENT) + (js-at-op-p (cdr start) "="))) + (param-sym + (or (and (ast-var-p expr) (ast-var-name expr)) + (js-call-parser-handler :gdi-reference-name expr) + (and assignment-p (cl-cc/ast:ast-setq-var expr))))) (cond - ((ast-var-p expr) - (values current expr (ast-var-name expr) nil nil t)) - ;; Array/object literal in param position: an arrow - ;; destructuring pattern. Give it a gensym param and - ;; record the pattern for body-prologue unpacking. + ((and param-sym assignment-p) + (values current expr param-sym (cons param-sym (cl-cc/ast:ast-setq-value expr)) nil t)) + ((and param-sym (js-at-op-p current "=")) + (multiple-value-bind (eq-tok rest3) (js-consume current) + (declare (ignore eq-tok)) + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (cons param-sym cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (multiple-value-bind (default-expr rest4) + (js-call-parser-handler :assignment-expression rest3) + (values rest4 + (make-ast-setq :var param-sym :value default-expr) + param-sym + (cons param-sym default-expr) + nil + t))))) + (param-sym (values current expr param-sym nil nil t)) (t (let ((pat (%js-expr-to-binding-pattern expr))) (if (and pat (listp pat)) (let ((g (second pat))) (values current expr g nil (cons g pat) t)) - ;; not a valid pattern -> not an arrow - (values current expr nil nil nil nil)))))))) + (values current expr nil nil nil nil))))))))) (defun %js-parse-paren-or-arrow (stream) - "Parse ( ... ) — either a parenthesized expression or arrow function params. + "Parse ( ... ) as either a parenthesized expression or arrow parameters. Returns (values ast rest)." - ;; We use a speculative approach: try to detect => after the closing ) - ;; by collecting the paren contents and peeking ahead. - ;; Strategy: parse a comma-separated list of assignment-exprs or patterns, - ;; then check for =>. - (multiple-value-bind (tok rest) (js-consume stream) ; consume ( + (multiple-value-bind (tok rest) (js-consume stream) (declare (ignore tok)) (if (eq (js-peek-type rest) :T-RPAREN) - ;; () => ... (arrow with no params) — must be followed by => (multiple-value-bind (tok2 rest2) (js-consume rest) (declare (ignore tok2)) (if (eq (js-peek-type rest2) :T-ARROW) (%js-finish-arrow-function nil rest2) - ;; () as expression is a syntax error in JS but we emit undefined for tolerance (values (make-ast-quote :value :js-undefined) rest2))) - ;; Non-empty: collect items, recording BOTH an arrow-param interpretation - ;; (params + optionals + rest-sym) and an expression fallback (exprs), then - ;; commit once we can peek past the ) for =>. A default param `x = e` is - ;; ambiguous with a parenthesized assignment `(x = e)`, so we keep both. (let ((exprs nil) (params nil) - (optionals nil) ; (sym . default-ast) alist for `x = default' - (param-patterns nil) ; (gensym . binding-pattern) for [a,b]/{x,y} params + (optionals nil) + (param-patterns nil) (is-arrow-candidate t) (current rest) (rest-sym nil)) - ;; Collect items - (loop - (cond - ;; ...rest param - ((eq (js-peek-type current) :T-ELLIPSIS) - (multiple-value-bind (tok2 rest2) (js-consume current) - (declare (ignore tok2)) - (multiple-value-bind (name-tok rest3) (js-expect :T-IDENT rest2) - (let ((sym (js-ident-sym (js-tok-value name-tok)))) - (setf rest-sym sym - current rest3)))) - (return)) ; rest param must be last - (t - ;; Try as assignment-expr, then classify it - (multiple-value-bind (new-current expr-form param-sym optional-pair - pattern-pair arrow-candidate-p) - (%js-parse-arrow-or-paren-item current) - (setf current new-current) - (push expr-form exprs) - (when param-sym (push param-sym params)) - (when optional-pair (push optional-pair optionals)) - (when pattern-pair (push pattern-pair param-patterns)) - (unless arrow-candidate-p (setf is-arrow-candidate nil))))) - (multiple-value-bind (next-stream more-p) (%js-comma-list-step current :T-RPAREN) - (setf current next-stream) - (unless more-p (return)))) + (loop do (if (eq (js-peek-type current) :T-ELLIPSIS) + (progn + (multiple-value-bind (tok2 rest2) (js-consume current) + (declare (ignore tok2)) + (multiple-value-bind (name-tok rest3) (js-expect :T-IDENT rest2) + (setf rest-sym (js-ident-sym (js-tok-value name-tok)) + current rest3))) + (return)) + (let ((reparse-fallback-p + (and params cl-cc/javascript/syntax:*js-gdi-global-reference-mode*)) + (fallback-expr nil)) + (when reparse-fallback-p + (multiple-value-bind (_stream expr-form + _param + _optional + _pattern + _candidate) + (%js-parse-arrow-or-paren-item current) + (declare (ignore _stream _param _optional _pattern _candidate)) + (setf fallback-expr expr-form))) + (multiple-value-bind (new-current expr-form + param-sym + optional-pair + pattern-pair + arrow-candidate-p) + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append (reverse params) + cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (%js-parse-arrow-or-paren-item current)) + (setf current new-current) + (push + (if reparse-fallback-p + fallback-expr + expr-form) + exprs) + (when param-sym + (push param-sym params)) + (when optional-pair + (push optional-pair optionals)) + (when pattern-pair + (push pattern-pair param-patterns)) + (unless arrow-candidate-p + (setf is-arrow-candidate nil))))) + do (multiple-value-bind (next-stream more-p) (%js-comma-list-step current :T-RPAREN) + (setf current next-stream) + (unless more-p + (return)))) (multiple-value-bind (tok2 rest2) (js-expect :T-RPAREN current) (declare (ignore tok2)) - ;; Check for => (if (and is-arrow-candidate (eq (js-peek-type rest2) :T-ARROW)) - (%js-finish-arrow-function (nreverse params) rest2 - :optionals (nreverse optionals) - :rest-sym rest-sym - :param-patterns (nreverse param-patterns)) - ;; Parenthesized expression — return last expression (or progn) + (let* ((first-pass (multiple-value-list (%js-parse-param-list stream))) + (all-params (first first-pass))) + (multiple-value-bind (new-params new-stream + new-optionals + new-rest-sym + new-patterns) + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append all-params cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (%js-parse-param-list stream)) + (%js-finish-arrow-function new-params + new-stream + :optionals + new-optionals + :rest-sym + new-rest-sym + :param-patterns + new-patterns))) (let ((all-exprs (nreverse exprs))) - (values (if (cdr all-exprs) (make-ast-progn :forms all-exprs) (car all-exprs)) - rest2)))))))) + (values + (if (cdr all-exprs) + (make-ast-progn :forms all-exprs) + (car all-exprs)) + rest2)))))))) (defun %js-finish-arrow-function (params stream &key optionals rest-sym param-patterns) - "Consume => and parse arrow function body. PARAMS is the list of required-param -symbols; OPTIONALS is a (sym . default-ast) alist for defaulted params; REST-SYM -is the rest-parameter symbol (or nil); PARAM-PATTERNS is a (gensym . pattern) -alist for destructuring params like ([a,b])=>… (the gensym param is unpacked by a -body-prologue let, exactly as for named functions). Returns (values ast rest)." + "Parse => body and build a lambda." (multiple-value-bind (tok rest) (js-expect :T-ARROW stream) (declare (ignore tok)) - (multiple-value-bind (required opts) (%js-split-params-by-defaults params optionals) - ;; FINISH builds the lambda from a body-form list: defaults become - ;; optional-params; the rest param is routed through %js-rest-binding, which - ;; wraps the body to bind REST-SYM to a JS array of the trailing args. - (flet ((finish (body-forms rest2) - (multiple-value-bind (rest-param wrapped-body) - (%js-rest-binding rest-sym - (%js-prepend-param-destructuring - param-patterns body-forms)) - (values (make-ast-lambda :params required - :optional-params opts - :rest-param rest-param - :body wrapped-body) - rest2)))) - (if (eq (js-peek-type rest) :T-LBRACE) - ;; Block body: => { stmts }. Wrap in (block nil ...) via %js-callable-body - ;; so `return' (which lowers to return-from nil) works — a bare lambda - ;; establishes no block, so without this the body fails to compile and the - ;; enclosing form is silently dropped (same fix as regular functions). - (multiple-value-bind (tok2 rest2) (js-consume rest) - (declare (ignore tok2)) - (multiple-value-bind (body-forms rest3) - (js-parse-function-body rest2) - (finish (%js-callable-body body-forms) rest3))) - ;; Concise body: => expr. The lambda yields EXPR directly as its value; - ;; no return-from/block is needed (and a bare lambda binds no block nil). - (multiple-value-bind (expr rest2) (js-call-parser-handler :assignment-expression rest) - (finish (list expr) rest2))))))) + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append params cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (multiple-value-bind (required opts) (%js-split-params-by-defaults params optionals) + (flet ((finish (body-forms rest2) + (multiple-value-bind (rest-param wrapped-body) + (%js-rest-binding rest-sym + (%js-prepend-param-destructuring param-patterns body-forms)) + (values + (make-ast-lambda :params + required + :optional-params + opts + :rest-param + rest-param + :body + wrapped-body) + rest2)))) + (if (eq (js-peek-type rest) :T-LBRACE) + (multiple-value-bind (tok2 rest2) (js-consume rest) + (declare (ignore tok2)) + (multiple-value-bind (body-forms rest3) + (js-call-parser-handler :function-body rest2) + (finish (%js-callable-body body-forms) rest3))) + (multiple-value-bind (expr rest2) (js-call-parser-handler :assignment-expression rest) + (finish (list expr) rest2)))))))) ;;; ─── Async Expression ──────────────────────────────────────────────────────── (defun %js-parse-async-expr (stream) @@ -201,21 +214,25 @@ Returns (values ast rest)." (values (make-ast-var :name (js-ident-sym "async")) rest)))))) (defun %js-finish-async-arrow (params stream) - "Parse => body for an async arrow function. Returns (values ast rest)." + "Parse => body for an async arrow function." (multiple-value-bind (tok rest) (js-expect :T-ARROW stream) (declare (ignore tok)) - (let ((body-and-rest - (if (eq (js-peek-type rest) :T-LBRACE) (multiple-value-bind (tok2 rest2) (js-consume rest) - (declare (ignore tok2)) - (multiple-value-bind (body-forms rest3) (js-parse-function-body rest2) - (list (%js-callable-body body-forms) rest3))) - (multiple-value-bind (expr rest2) (js-call-parser-handler :assignment-expression rest) - (list (list expr) rest2))))) - (values - (%js-call - '%js-object-make-async - (make-ast-lambda :params params :body (car body-and-rest))) - (cadr body-and-rest))))) + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append params cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (let ((body-and-rest + (if (eq (js-peek-type rest) :T-LBRACE) + (multiple-value-bind (tok2 rest2) (js-consume rest) + (declare (ignore tok2)) + (multiple-value-bind (body-forms rest3) + (js-call-parser-handler :function-body rest2) + (list (%js-callable-body body-forms) rest3))) + (multiple-value-bind (expr rest2) + (js-call-parser-handler :assignment-expression rest) + (list (list expr) rest2))))) + (values + (%js-call (quote %js-object-make-async) + (make-ast-lambda :params params :body (car body-and-rest))) + (cadr body-and-rest)))))) ;;; ─── Class Expression ──────────────────────────────────────────────────────── (defun %js-parse-class-expr (stream) @@ -258,6 +275,7 @@ Returns (values ast rest)." (values (%js-call '%js-import spec-ast) rest4))))) (t (error "JS parse error: unexpected token after 'import': ~S" (js-peek rest)))))) + ;;; ─── import() Dynamic Import ───────────────────────────────────────────────── (eval-when (:load-toplevel :execute) (register-js-parser-handler :function-paren-or-arrow (function %js-parse-paren-or-arrow)) diff --git a/src/functions/parser-stmt-fn.lisp b/src/functions/parser-stmt-fn.lisp index 86148e5..ce4f4f7 100644 --- a/src/functions/parser-stmt-fn.lisp +++ b/src/functions/parser-stmt-fn.lisp @@ -12,46 +12,45 @@ ;;; ─── Function Declaration Parsing ─────────────────────────────────────────── (defun %js-parse-param-list (stream) "Parse (param, ...) parameter list. - Returns (values params-list rest optionals rest-sym param-patterns), where - OPTIONALS is an alist (sym . default-ast) for parameters with `= default', - REST-SYM is the ...rest parameter symbol (or NIL), and PARAM-PATTERNS is an - alist (param-gensym . binding-pattern) for destructuring parameters like - function f([a,b]) / f({x,y}) — the caller prepends a destructuring let to the - body that unpacks the gensym param into the pattern's names. Callers binding - only the first values are unaffected." +Returns (values params-list rest optionals rest-sym param-patterns), where +OPTIONALS is an alist (sym . default-ast), REST-SYM is the ...rest parameter +symbol, and PARAM-PATTERNS maps destructuring parameter symbols to patterns." (let ((current (%js-consume-expected :T-LPAREN stream)) - (params nil) (optionals nil) (rest-sym nil) (param-patterns nil)) + (params nil) + (optionals nil) + (rest-sym nil) + (param-patterns nil)) (loop (when (or (js-at-eof-p current) (eq (js-peek-type current) :T-RPAREN)) (return)) (cond - ;; Rest parameter: ...name — the AST rest-param, not a positional one. ((eq (js-peek-type current) :T-ELLIPSIS) (setf current (cdr current)) (multiple-value-bind (tok rest) (js-consume current) (setf rest-sym (%js-binding-sym (js-tok-value tok)) current rest)) - (return)) ; rest must be last + (return)) (t (multiple-value-bind (binding rest) (%js-parse-binding-pattern current) (let ((sym (%js-binding-to-sym binding))) - (push sym params) - ;; A destructuring param (binding is a (:array-pattern|:object-pattern - ;; gensym desc) list, not a bare symbol): record it so the caller can - ;; unpack the gensym into the named locals at the top of the body. (when (listp binding) (push (cons sym binding) param-patterns)) (setf current rest) - ;; Default parameter value: = expr — recorded so the param becomes - ;; an &optional with that default (was parsed and discarded). (when (and current (eq (js-peek-type current) :T-OP) (equal (js-peek-value current) "=")) (setf current (cdr current)) - (multiple-value-bind (default-ast rest2) (js-call-parser-handler :expression current) - (push (cons sym default-ast) optionals) - (setf current rest2))))))) + ;; The current parameter shadows outer globals during its default, + ;; where JavaScript requires an uninitialized local binding. + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append (cons sym (reverse params)) + cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (multiple-value-bind (default-ast rest2) + (js-call-parser-handler :assignment-expression current) + (push (cons sym default-ast) optionals) + (setf current rest2)))) + (push sym params))))) (when (eq (js-peek-type current) :T-COMMA) (setf current (cdr current)))) (values (nreverse params) @@ -68,16 +67,18 @@ the rest of the body via %js-finish-let-bindings — without that the unbodied l fails to compile, the top-level handler-case drops the whole defun, and calls hit 'Undefined function'. Re-running the pass is idempotent: already-bodied lets in BODY-STMTS pass through unchanged." - (if param-patterns (%js-finish-let-bindings - (append + (if param-patterns + (%js-finish-let-bindings + (append (mapcar - (lambda (pp) - (multiple-value-bind (bindings _extras) (%js-emit-destructure-bindings (cdr pp) (make-ast-var :name (car pp))) - (declare (ignore _extras)) - (make-ast-let :bindings bindings :body nil :declarations (list :let)))) - param-patterns) + (lambda (pp) + (multiple-value-bind (bindings _extras) + (%js-emit-destructure-bindings (cdr pp) (make-ast-var :name (car pp))) + (declare (ignore _extras)) + (make-ast-let :bindings bindings :body nil :declarations (list :let)))) + param-patterns) body-stmts)) - body-stmts)) + body-stmts)) (defun %js-split-params-by-defaults (params optionals) "Split PARAMS into (values required optional-entries). OPTIONALS is the @@ -85,50 +86,47 @@ BODY-STMTS pass through unchanged." it — becomes an optional entry (sym default-ast nil); JS gives a missing argument `undefined', so a trailing parameter with no explicit default defaults to undefined. This keeps required params as the positional prefix." - (if optionals (let ((first-opt - (loop for p in params - when (assoc p optionals :test #'eq) - return p))) - (let ((required nil) - (opts nil) - (seen nil)) - (dolist (p params) - (when (eq p first-opt) - (setf seen t)) - (if seen (push - (list - p - (or - (cdr (assoc p optionals :test #'eq)) - (make-ast-quote :value +js-undefined+)) - nil) - opts) - (push p required))) - (values (nreverse required) (nreverse opts)))) - (values params nil))) + (if optionals + (let ((first-opt + (loop for p in params + when (assoc p optionals :test #'eq) + return p))) + (let ((required nil) + (opts nil) + (seen nil)) + (dolist (p params) + (when (eq p first-opt) + (setf seen t)) + (if seen + (push + (list p + (or (cdr (assoc p optionals :test #'eq)) + (make-ast-quote :value +js-undefined+)) + nil) + opts) + (push p required))) + (values (nreverse required) (nreverse opts)))) + (values params nil))) (defun %js-rest-binding (rest-sym body-forms) "When REST-SYM is non-nil, return (values rest-param-sym wrapped-body): the AST rest-param is a fresh gensym collecting the trailing args as a CL list, and the body is wrapped in a let binding REST-SYM to that list converted to a JS array (JS rest parameters are arrays). Otherwise (values nil BODY-FORMS)." - (if rest-sym (let ((raw (gensym "JS-REST-"))) - (values - raw - (list - (make-ast-let - :bindings - (list - (cons - rest-sym - (make-ast-call - :func - (make-ast-var :name '%js-list-to-array) - :args - (list (make-ast-var :name raw))))) - :body - body-forms)))) - (values nil body-forms))) + (if rest-sym + (let ((raw (gensym "JS-REST-"))) + (values raw + (list + (make-ast-let :bindings + (list + (cons rest-sym + (make-ast-call :func + (make-ast-var :name '%js-list-to-array) + :args + (list (make-ast-var :name raw))))) + :body + body-forms)))) + (values nil body-forms))) (defun %js-wrap-callable-body (body-forms generator-p async-p) "Wrap BODY-FORMS so calling the compiled defun returns the right runtime @@ -139,48 +137,70 @@ none: async function f(…) { … } -> (%js-async (lambda () ...)) A plain function returns BODY-FORMS unchanged." (cond - (generator-p (list (%js-call '%js-object-make-generator - (make-ast-lambda :params nil :body body-forms)))) - (async-p (list (%js-call '%js-async - (make-ast-lambda :params nil :body body-forms)))) + (generator-p + (list (%js-call '%js-object-make-generator (make-ast-lambda :params nil :body body-forms)))) + (async-p (list (%js-call '%js-async (make-ast-lambda :params nil :body body-forms)))) (t body-forms))) (defun js-parse-function-decl (stream &key async-p generator-p) - "Parse function [*] name (params) { body }. - Returns (values ast-defun rest). - ASYNC-P and GENERATOR-P affect the :js-async / :js-generator declaration metadata." - ;; Consume optional * for generators + "Parse function [*] name (params) { body } and return its AST." (let ((current stream)) - (when (and (eq (js-peek-type current) :T-OP) - (equal (js-peek-value current) "*")) + (when (and (eq (js-peek-type current) :T-OP) (equal (js-peek-value current) "*")) (setf generator-p t current (cdr current))) - ;; Function name (optional for expressions, but required for declarations) (let ((fn-name nil)) (when (eq (js-peek-type current) :T-IDENT) (multiple-value-bind (tok rest) (js-consume current) (setf fn-name (js-ident-sym (js-tok-value tok)) current rest))) - (multiple-value-bind (params rest optionals rest-sym param-patterns) - (%js-parse-param-list current) - (multiple-value-bind (body-ast rest2) (js-parse-block rest) - (let ((body-stmts (%js-prepend-param-destructuring - param-patterns (ast-progn-forms body-ast))) - (decls nil)) - (when async-p (push :js-async decls)) - (when generator-p (push :js-generator decls)) - (multiple-value-bind (required opts) - (%js-split-params-by-defaults params optionals) - (multiple-value-bind (rest-param body-forms) - (%js-rest-binding rest-sym (%js-callable-body body-stmts)) - (values (make-ast-defun - :name (or fn-name (gensym "JS-FN-")) - :params required - :optional-params opts - :rest-param rest-param - :declarations (nreverse decls) - :body (%js-wrap-callable-body body-forms generator-p async-p)) - rest2))))))))) + (let* ((first-pass (multiple-value-list (%js-parse-param-list current))) + (all-params (first first-pass))) + (multiple-value-bind (params rest optionals rest-sym param-patterns) + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append all-params cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (%js-parse-param-list current)) + (%js-consume-then (body-stream (js-expect :T-LBRACE rest)) + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append params + (when + (and fn-name + (or + (not cl-cc/javascript/statements:*js-gdi-mode*) + (plusp + cl-cc/javascript/statements:*js-gdi-function-depth*) + (plusp + cl-cc/javascript/statements:*js-gdi-lexical-scope-depth*))) + (list fn-name)) + cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (multiple-value-bind (body-stmts rest2) + (js-parse-function-body body-stream) + (let ((body-stmts + (%js-prepend-param-destructuring param-patterns body-stmts)) + (decls nil)) + (when async-p + (push :js-async decls)) + (when generator-p + (push :js-generator decls)) + (multiple-value-bind (required opts) + (%js-split-params-by-defaults params optionals) + (multiple-value-bind (rest-param body-forms) + (%js-rest-binding rest-sym (%js-callable-body body-stmts)) + (values + (make-ast-defun :name + (or fn-name (gensym "JS-FN-")) + :params + required + :optional-params + opts + :rest-param + rest-param + :declarations + (nreverse decls) + :body + (%js-wrap-callable-body body-forms + generator-p + async-p)) + rest2)))))))))))) ;;; ─── If Statement ──────────────────────────────────────────────────────────── (defun %js-parse-if-tail (stream) @@ -216,9 +236,7 @@ A plain function returns BODY-FORMS unchanged." (multiple-value-bind (cond-expr rest2) (js-call-parser-handler :expression rest) (setf rest2 (%js-consume-expected :T-RPAREN rest2)) (multiple-value-bind (then-ast rest3 else-ast) (%js-parse-if-tail rest2) - (values - (make-ast-if :cond (%js-truthy-call cond-expr) :then then-ast :else else-ast) - rest3))))) + (values (make-ast-if :cond (%js-truthy-call cond-expr) :then then-ast :else else-ast) rest3))))) ;;; ─── While Statement ───────────────────────────────────────────────────────── (defun js-parse-while-stmt (stream) @@ -226,19 +244,18 @@ A plain function returns BODY-FORMS unchanged." (let ((rest (%js-consume-expected :T-LPAREN stream))) (multiple-value-bind (cond-expr rest2) (js-call-parser-handler :expression rest) (setf rest2 (%js-consume-expected :T-RPAREN rest2)) - (with-js-loop-tags - (loop-tag end-tag "WHILE") - (multiple-value-bind (body-ast rest3) (%js-parse-stmt-body rest2) - (let ((body-stmts - (if (ast-progn-p body-ast) (ast-progn-forms body-ast) - (list body-ast)))) - (values - (%js-lower-while-with-tags - (%js-truthy-call cond-expr) - body-stmts - loop-tag - end-tag) - rest3))))))) + (with-js-loop-tags (loop-tag end-tag "WHILE") + (multiple-value-bind (body-ast rest3) (%js-parse-stmt-body rest2) + (let ((body-stmts + (if (ast-progn-p body-ast) + (ast-progn-forms body-ast) + (list body-ast)))) + (values + (%js-lower-while-with-tags (%js-truthy-call cond-expr) + body-stmts + loop-tag + end-tag) + rest3))))))) ;;; ─── Do-While Statement ────────────────────────────────────────────────────── (defun js-parse-do-while-stmt (stream) @@ -260,23 +277,24 @@ A plain function returns BODY-FORMS unchanged." body-stmts loop-tag end-tag) rest2)))))) + ;;; ─── Do-While Statement ────────────────────────────────────────────────────── (eval-when (:load-toplevel :execute) (register-js-parser-handler :function-rest-binding (function %js-rest-binding)) (register-js-parser-handler :function-split-params (function %js-split-params-by-defaults))) + ;;; ─── Do-While Statement ────────────────────────────────────────────────────── (eval-when (:load-toplevel :execute) (register-js-parser-handler '(:statement :T-FUNCTION) (function js-parse-function-decl)) - (register-js-parser-handler - :statement-async-function - (lambda (stream) (js-parse-function-decl stream :async-p t))) + (register-js-parser-handler :statement-async-function + (lambda (stream) + (js-parse-function-decl stream :async-p t))) (register-js-parser-handler '(:statement :T-IF) (function js-parse-if-stmt)) (register-js-parser-handler '(:statement :T-WHILE) (function js-parse-while-stmt)) - (register-js-parser-handler '(:statement :T-DO) (function js-parse-do-while-stmt))) + (register-js-parser-handler '(:statement :T-DO) (function js-parse-do-while-stmt)) + (register-js-parser-handler :function-declaration (function js-parse-function-decl))) ;;; ─── For Statement ─────────────────────────────────────────────────────────── ;;; See parser-stmt-control.lisp for: for-loop lowering, switch, break/continue, ;;; return, throw, try/catch/finally, debugger, using, js-parse-stmt dispatcher, ;;; top-level list parsers, and public entry points parse-js-source/parse-js-module. - -(eval-when (:load-toplevel :execute) (register-js-parser-handler :function-declaration (function js-parse-function-decl))) diff --git a/src/json/runtime-json.lisp b/src/json/runtime-json.lisp index 72ed993..d66eac1 100644 --- a/src/json/runtime-json.lisp +++ b/src/json/runtime-json.lisp @@ -27,7 +27,8 @@ ;;; ----------------------------------------------------------------------- ;;; Raw JSON wrapper (JSON.rawJSON / JSON.isRawJSON, ES2024) ;;; ----------------------------------------------------------------------- -(defstruct (js-raw-json (:constructor %js-make-raw-json (text)) (:conc-name js-raw-json-)) text) +(defstruct (js-raw-json (:constructor %js-make-raw-json (text)) (:conc-name js-raw-json-)) + text) (defun %js-json-raw-json-p (val) "True when VAL is a JSON.rawJSON wrapper." @@ -41,8 +42,11 @@ (json-kit:parse itself rejects trailing data, so no separate check is needed)." (and (stringp str) - (handler-case (progn (parse str) t) - (json-parse-error () nil)))) + (handler-case (progn + (parse str) + t) + (json-parse-error () + nil)))) (defun %js-json-raw-json (str) "Wrap STR as a raw JSON fragment after validating it." @@ -109,7 +113,7 @@ entirely, by simply never adding it to the rebuilt hash table below." ;; accessor FUNCTION, and its key was `__get_X`, already filtered out ;; as an "internal" key rather than recognized as a property). (let ((result (%js-make-ht))) - (loop for k across (%js-object-own-string-property-keys val) + (loop for k across (%js-object-own-string-property-keys val t) for v = (%js-get-prop val k) unless (%js-json-unrepresentable-p v) do (setf (gethash k result) (%js-json-stringify-normalize v fragments))) @@ -133,10 +137,14 @@ see docs/src/reference/compatibility.md." +js-undefined+ (let ((fragments (make-array 0 :adjustable t :fill-pointer 0))) (%js-json-splice-raw-fragments - (stringify (%js-json-stringify-normalize val fragments) - :null-value +js-null+ :false-value nil - :number-encoder #'%js-json-number-encoder) - fragments)))) + (stringify (%js-json-stringify-normalize val fragments) + :null-value + +js-null+ + :false-value + nil + :number-encoder + #'%js-json-number-encoder) + fragments)))) ;;; ----------------------------------------------------------------------- ;;; JSON.parse @@ -147,10 +155,10 @@ null/false/true value mapping applied directly through its own parser hooks. Invalid JSON raises a real JS SyntaxError (the hand-rolled parser this replaced silently returned `undefined` instead, which is not what JSON.parse does)." - (handler-case - (parse (%js-to-string str) :null-value +js-null+ :false-value nil :true-value t) + (handler-case (parse (%js-to-string str) :null-value +js-null+ :false-value nil :true-value t) (json-parse-error (e) (%js-throw - (%js-make-error-instance *js-syntax-error-class* - (format nil "Unexpected token in JSON at position ~D" - (json-parse-error-position e))))))) + (%js-make-error-instance *js-syntax-error-class* + (format nil + "Unexpected token in JSON at position ~D" + (json-parse-error-position e))))))) diff --git a/src/objects/package.lisp b/src/objects/package.lisp index 134b857..d7f9952 100644 --- a/src/objects/package.lisp +++ b/src/objects/package.lisp @@ -1,4 +1,4 @@ (defpackage #:cl-cc/javascript/objects (:use #:cl) - (:export #:%define-js-map-iterator #:%js-accessor-descriptor-p #:%js-add #:%js-array-extra-prop-get #:%js-array-extra-prop-set #:%js-array-flag #:%js-canonical-array-index-key-p #:%js-class-accessor-key #:%js-console-error #:%js-console-log #:%js-console-warn #:%js-deep-clone #:%js-delete #:%js-destructure-array #:%js-destructure-object #:%js-divide #:%js-finreg-register #:%js-finreg-unregister #:%js-float-infinity-p #:%js-float-nan-p #:%js-get-prop #:%js-ht-p #:%js-in #:%js-int-arg-or-default #:%js-internal-key-p #:%js-make-console #:%js-make-finalization-registry #:%js-make-ht #:%js-make-map #:%js-make-object #:%js-make-set #:%js-make-set-from-iterable #:%js-make-symbol #:%js-make-symbol-global #:%js-make-vec #:%js-make-weak-map #:%js-make-weak-ref #:%js-make-weak-set #:%js-map-clear #:%js-map-delete #:%js-map-entries #:%js-map-find-key #:%js-map-for-each #:%js-map-get #:%js-map-get-or-insert #:%js-map-get-or-insert-computed #:%js-map-has #:%js-map-keys #:%js-map-p #:%js-map-set #:%js-map-size #:%js-map-values #:%js-mod #:%js-nan-p #:%js-not-nullish #:%js-object-accessor-property-name #:%js-object-apply-fn #:%js-object-assign #:%js-object-call-with-this #:%js-object-callable-p #:%js-object-collect #:%js-object-create #:%js-object-entries #:%js-object-error-class #:%js-object-extensible-p #:%js-object-for-of #:%js-object-freeze #:%js-object-from-entries #:%js-object-frozen-p #:%js-object-funcall #:%js-object-get-own-property-names #:%js-object-get-own-property-symbols #:%js-object-get-prototype-of #:%js-object-group-by #:%js-object-group-into #:%js-object-has-own #:%js-object-instanceof-p #:%js-object-internal-flag #:%js-object-is #:%js-object-keys #:%js-object-list-to-array #:%js-object-make-aggregate-error #:%js-object-make-array #:%js-object-make-async #:%js-object-make-generator #:%js-object-method-ref #:%js-object-own-keys #:%js-object-own-property-keys #:%js-object-own-string-property-keys #:%js-object-own-symbol-property-keys #:%js-object-prevent-extensions #:%js-object-proto-accessor-lookup #:%js-object-proto-method-lookup #:%js-object-put-entry #:%js-object-seal #:%js-object-sealed-p #:%js-object-set-prototype-of #:%js-object-spread-set #:%js-object-values #:%js-object-without-keys #:%js-optional-call #:%js-optional-chain #:%js-optional-method-call #:%js-pow #:%js-register-object-aggregate-error-factory #:%js-register-object-array-factory #:%js-register-object-date-handler #:%js-register-object-error-class #:%js-register-object-for-of-handler #:%js-register-object-function-operation-handler #:%js-register-object-generator-operation-handler #:%js-register-object-iterator-factory #:%js-register-object-proxy-operation-handler #:%js-register-object-regex-clone-handler #:%js-same-value-zero #:%js-set-add #:%js-set-array-flag #:%js-set-clear #:%js-set-copy-all #:%js-set-delete #:%js-set-difference #:%js-set-entries #:%js-set-find-value #:%js-set-for-each #:%js-set-has #:%js-set-intersection #:%js-set-is-disjoint-from #:%js-set-is-subset-of #:%js-set-is-superset-of #:%js-set-keys #:%js-set-like-has #:%js-set-like-keys #:%js-set-like-keys-result-to-list #:%js-set-prop #:%js-set-size #:%js-set-symmetric-difference #:%js-set-union #:%js-strict-eq #:%js-string-prefix-p #:%js-structured-clone #:%js-symbol-as-key #:%js-symbol-async-iterator #:%js-symbol-description #:%js-symbol-for #:%js-symbol-from-storage-key #:%js-symbol-has-instance #:%js-symbol-iterator #:%js-symbol-key-for #:%js-symbol-p #:%js-symbol-species #:%js-symbol-storage-key-p #:%js-symbol-to-primitive #:%js-symbol-to-string #:%js-symbol-to-string-tag #:%js-template-string #:%js-this #:%js-to-number #:%js-to-property-key #:%js-to-string #:%js-truthy #:%js-vec-p #:%js-vm-closure-p #:%js-weak-map-delete #:%js-weak-map-get #:%js-weak-map-get-or-insert #:%js-weak-map-get-or-insert-computed #:%js-weak-map-has #:%js-weak-map-p #:%js-weak-map-set #:%js-weak-ref-deref #:%js-weak-set-add #:%js-weak-set-delete #:%js-weak-set-has #:%js-weak-set-p #:%make-js-bigint #:*js-array-extra-properties* #:*js-array-flags* #:*js-inf-float* #:*js-nan-float* #:*js-neg-inf-float* #:*js-symbol-global* #:*js-symbol-registry* #:+js-infinity+ #:+js-nan+ #:+js-neg-infinity+ #:+js-null+ #:+js-undefined+ #:define-js-console-output #:define-js-map-like-get-or-insert #:define-js-set-filter-op #:define-js-set-predicate #:define-js-weak-membership-ops #:define-js-well-known-symbols #:js-bigint #:js-bigint-p #:js-bigint-value #:js-finalization-registration #:js-finalization-registry #:js-finalization-registry-p #:js-map #:js-map-p #:js-set #:js-set-p #:js-symbol #:js-symbol-p #:js-weak-map #:js-weak-map-ht #:js-weak-map-p #:js-weak-ref #:js-weak-ref-p #:js-weak-set #:js-weak-set-ht #:js-weak-set-p)) + (:export #:%define-js-map-iterator #:%js-accessor-descriptor-p #:%js-add #:%js-array-extra-prop-get #:%js-array-extra-prop-set #:%js-array-flag #:%js-canonical-array-index-key-p #:%js-class-accessor-key #:%js-console-error #:%js-console-log #:%js-console-warn #:%js-deep-clone #:%js-delete #:%js-destructure-array #:%js-destructure-object #:%js-divide #:%js-finreg-register #:%js-finreg-unregister #:%js-float-infinity-p #:%js-float-nan-p #:%js-get-prop #:%js-ht-p #:%js-in #:%js-int-arg-or-default #:%js-internal-key-p #:%js-make-console #:%js-make-finalization-registry #:%js-make-ht #:%js-make-map #:%js-make-object #:%js-make-set #:%js-make-set-from-iterable #:%js-make-symbol #:%js-make-symbol-global #:%js-make-vec #:%js-make-weak-map #:%js-make-weak-ref #:%js-make-weak-set #:%js-map-clear #:%js-map-delete #:%js-map-entries #:%js-map-find-key #:%js-map-for-each #:%js-map-get #:%js-map-get-or-insert #:%js-map-get-or-insert-computed #:%js-map-has #:%js-map-keys #:%js-map-p #:%js-map-set #:%js-map-size #:%js-map-values #:%js-mod #:%js-nan-p #:%js-not-nullish #:%js-object-accessor-property-name #:%js-object-apply-fn #:%js-object-assign #:%js-object-call-with-this #:%js-object-callable-p #:%js-object-collect #:%js-object-create #:%js-object-entries #:%js-object-error-class #:%js-object-extensible-p #:%js-object-for-of #:%js-object-freeze #:%js-object-from-entries #:%js-object-frozen-p #:%js-object-funcall #:%js-object-get-own-property-names #:%js-object-get-own-property-symbols #:%js-object-get-prototype-of #:%js-object-group-by #:%js-object-group-into #:%js-object-has-own #:%js-object-instanceof-p #:%js-object-internal-flag #:%js-object-is #:%js-object-keys #:%js-object-list-to-array #:%js-object-make-aggregate-error #:%js-object-make-array #:%js-object-make-async #:%js-object-make-generator #:%js-object-method-ref #:%js-object-own-keys #:%js-object-own-property-keys #:%js-object-own-string-property-keys #:%js-object-own-symbol-property-keys #:%js-object-prevent-extensions #:%js-object-proto-accessor-lookup #:%js-object-proto-method-lookup #:%js-object-put-entry #:%js-object-seal #:%js-object-sealed-p #:%js-object-set-prototype-of #:%js-object-spread-set #:%js-object-values #:%js-object-without-keys #:%js-optional-call #:%js-optional-chain #:%js-optional-method-call #:%js-pow #:%js-register-object-aggregate-error-factory #:%js-register-object-array-factory #:%js-register-object-date-handler #:%js-register-object-error-class #:%js-register-object-for-of-handler #:%js-register-object-function-operation-handler #:%js-register-object-generator-operation-handler #:%js-register-object-iterator-factory #:%js-register-object-proxy-operation-handler #:%js-register-object-regex-clone-handler #:%js-same-value-zero #:%js-set-add #:%js-set-array-flag #:%js-set-clear #:%js-set-copy-all #:%js-set-delete #:%js-set-difference #:%js-set-entries #:%js-set-find-value #:%js-set-for-each #:%js-set-has #:%js-set-intersection #:%js-set-is-disjoint-from #:%js-set-is-subset-of #:%js-set-is-superset-of #:%js-set-keys #:%js-set-like-has #:%js-set-like-keys #:%js-set-like-keys-result-to-list #:%js-set-prop #:%js-set-size #:%js-set-symmetric-difference #:%js-set-union #:%js-strict-eq #:%js-string-prefix-p #:%js-structured-clone #:%js-symbol-as-key #:%js-symbol-async-iterator #:%js-symbol-description #:%js-symbol-for #:%js-symbol-from-storage-key #:%js-symbol-has-instance #:%js-symbol-iterator #:%js-symbol-key-for #:%js-symbol-p #:%js-symbol-species #:%js-symbol-storage-key-p #:%js-symbol-to-primitive #:%js-symbol-to-string #:%js-symbol-to-string-tag #:%js-template-string #:%js-this #:%js-to-number #:%js-to-property-key #:%js-to-string #:%js-truthy #:%js-vec-p #:%js-vm-closure-p #:%js-weak-map-delete #:%js-weak-map-get #:%js-weak-map-get-or-insert #:%js-weak-map-get-or-insert-computed #:%js-weak-map-has #:%js-weak-map-p #:%js-weak-map-set #:%js-weak-ref-deref #:%js-weak-set-add #:%js-weak-set-delete #:%js-weak-set-has #:%js-weak-set-p #:%make-js-bigint #:*js-array-extra-properties* #:*js-array-flags* #:*js-inf-float* #:*js-nan-float* #:*js-neg-inf-float* #:*js-symbol-global* #:*js-symbol-registry* #:+js-infinity+ #:+js-nan+ #:+js-neg-infinity+ #:+js-null+ #:+js-undefined+ #:define-js-console-output #:define-js-map-like-get-or-insert #:define-js-set-filter-op #:define-js-set-predicate #:define-js-weak-membership-ops #:define-js-well-known-symbols #:js-bigint #:js-bigint-p #:js-bigint-value #:js-finalization-registration #:js-finalization-registry #:js-finalization-registry-p #:js-map #:js-map-p #:js-set #:js-set-p #:js-symbol #:js-symbol-p #:js-weak-map #:js-weak-map-ht #:js-weak-map-p #:js-weak-ref #:js-weak-ref-p #:js-weak-set #:js-weak-set-ht #:js-weak-set-p #:%js-property-descriptor #:%js-property-value #:%js-set-property-descriptor #:%js-property-descriptor-keys #:%js-property-set-closure-descriptor #:%js-property-descriptor-object)) diff --git a/src/objects/runtime-object.lisp b/src/objects/runtime-object.lisp index 619469e..9128c41 100644 --- a/src/objects/runtime-object.lisp +++ b/src/objects/runtime-object.lisp @@ -53,85 +53,70 @@ all share, and %JS-OBJECT-OWN-STRING-PROPERTY-KEYS applies below." (every #'digit-char-p k) (or (string= k "0") (char/= (char k 0) #\0)))) -(defun %js-object-own-string-property-keys (obj) - "Return public own string property names for OBJ, translating accessor slots -back to their JS property names and filtering runtime-only keys. Canonical -array-index keys (see %JS-CANONICAL-ARRAY-INDEX-KEY-P) are moved to the -front, sorted numerically ascending; every other key keeps its encounter -order after them." +(defun %js-object-own-string-property-keys (obj &optional enumerable-only) + "Return public own string keys, including descriptor-backed properties. +Canonical array indices sort numerically before other keys in encounter order." (let ((result (make-array 0 :element-type t :adjustable t :fill-pointer 0)) (seen (%js-make-ht))) (labels ((add-key (key) (unless (%js-symbol-p key) - (let ((k (%js-to-string key))) - (unless (or - (%js-symbol-storage-key-p k) - (%js-internal-key-p k) - (nth-value 1 (gethash k seen))) - (setf (gethash k seen) t) - (vector-push-extend k result))))) + (let ((k (%js-to-string key))) + (unless (or (%js-symbol-storage-key-p k) + (%js-internal-key-p k) + (nth-value 1 (gethash k seen))) + (setf (gethash k seen) t) + (vector-push-extend k result))))) (add-accessor-key (slot-key) (let ((property-name (%js-object-accessor-property-name slot-key))) - (when property-name - (unless (nth-value 1 (gethash property-name seen)) - (setf (gethash property-name seen) t) - (vector-push-extend property-name result)))))) + (when property-name + (add-key property-name))))) (cond ((%js-object-proxy-p obj) - (dolist (key (%js-object-proxy-key-list (%js-object-proxy-own-keys obj))) - (add-key key))) + (dolist (key (%js-object-proxy-key-list (%js-object-proxy-own-keys obj))) + (add-key key))) ((%js-ht-p obj) - (maphash - (lambda (k v) - (declare (ignore v)) - (add-key k)) - obj) - (maphash - (lambda (k v) - (declare (ignore v)) - (add-accessor-key k)) - obj)))) - ;; Reorder in place: array-index keys first (numerically ascending), - ;; then every other key in its original encounter order. Rebuilt as the - ;; same adjustable, fill-pointered vector shape RESULT already was (not - ;; via CONCATENATE, whose fresh simple-vector result would break - ;; %JS-OBJECT-OWN-PROPERTY-KEYS's VECTOR-PUSH-EXTEND onto this return - ;; value) so every caller keeps working with it the same way. - (let* ((index-keys (sort (remove-if-not #'%js-canonical-array-index-key-p result) - #'< :key #'parse-integer)) - (other-keys (remove-if #'%js-canonical-array-index-key-p result)) + (maphash (lambda (key value) (declare (ignore value)) (add-key key)) obj) + (maphash (lambda (key value) (declare (ignore value)) (add-accessor-key key)) obj))) + (map nil (function add-key) (%js-property-descriptor-keys obj))) + (let* ((index-keys (sort (remove-if-not (function %js-canonical-array-index-key-p) result) + (function <) :key (function parse-integer))) + (other-keys (remove-if (function %js-canonical-array-index-key-p) result)) (ordered (make-array (length result) :element-type t - :adjustable t :fill-pointer 0))) - (map nil (lambda (k) (vector-push-extend k ordered)) index-keys) - (map nil (lambda (k) (vector-push-extend k ordered)) other-keys) - ordered))) + :adjustable t :fill-pointer 0))) + (map nil (lambda (key) (vector-push-extend key ordered)) index-keys) + (map nil (lambda (key) (vector-push-extend key ordered)) other-keys) + (if enumerable-only + (remove-if-not (lambda (key) (%js-property-enumerable-p obj key)) ordered) + ordered)))) (defun %js-object-own-symbol-property-keys (obj) "Return public own Symbol property keys for OBJ." (let ((result (make-array 0 :element-type t :adjustable t :fill-pointer 0)) (seen (%js-make-ht))) (labels ((add-symbol-key (key) - (let ((sym - (cond - ((%js-symbol-p key) key) - ((%js-symbol-storage-key-p key) (%js-symbol-from-storage-key key)) - (t +js-undefined+)))) - (when (and - (%js-symbol-p sym) - (not (nth-value 1 (gethash (%js-symbol-as-key sym) seen)))) - (setf (gethash (%js-symbol-as-key sym) seen) t) - (vector-push-extend sym result))))) + (let ((sym (cond + ((%js-symbol-p key) key) + ((%js-symbol-storage-key-p key) + (%js-symbol-from-storage-key key)) + (t +js-undefined+)))) + (when (and (%js-symbol-p sym) + (not (nth-value 1 + (gethash (%js-symbol-as-key sym) + seen)))) + (setf (gethash (%js-symbol-as-key sym) seen) t) + (vector-push-extend sym result))))) (cond ((%js-object-proxy-p obj) - (dolist (key (%js-object-proxy-key-list (%js-object-proxy-own-keys obj))) - (add-symbol-key key))) + (dolist (key (%js-object-proxy-key-list (%js-object-proxy-own-keys obj))) + (add-symbol-key key))) ((%js-ht-p obj) - (maphash - (lambda (k v) - (declare (ignore v)) - (add-symbol-key k)) - obj)))) - result)) + (maphash (lambda (key value) + (declare (ignore value)) + (add-symbol-key key)) + obj)) + ((%js-vm-closure-p obj) + (map nil (function add-symbol-key) (%js-property-descriptor-keys obj)))) + result))) (defun %js-object-own-property-keys (obj) "Return public own string and Symbol property keys for Reflect.ownKeys." @@ -146,14 +131,14 @@ order after them." ;;; Internal: iterate non-internal properties of OBJ, collecting (select-fn k v) ;;; into a fresh adjustable vector. Returns an empty array when OBJ is not a HT. (defun %js-object-collect (obj select-fn) - (if (or (%js-object-proxy-p obj) (%js-ht-p obj)) (let ((result (make-array 0 :element-type t :adjustable t :fill-pointer 0))) - (map - nil - (lambda (k) - (vector-push-extend (funcall select-fn k (%js-get-prop obj k)) result)) - (%js-object-own-string-property-keys obj)) - result) - (%js-object-make-array))) + (if (or (%js-object-proxy-p obj) (%js-ht-p obj) (%js-vm-closure-p obj)) + (let ((result (make-array 0 :element-type t :adjustable t :fill-pointer 0))) + (map nil + (lambda (key) + (vector-push-extend (funcall select-fn key (%js-get-prop obj key)) result)) + (%js-object-own-string-property-keys obj t)) + result) + (%js-object-make-array))) (defun %js-object-keys (obj) (%js-object-collect @@ -187,17 +172,13 @@ order after them." (defun %js-object-assign (target &rest sources) "Copy all enumerable own properties from SOURCES to TARGET." (dolist (src sources) - (when (or (%js-object-proxy-p src) (%js-ht-p src)) - (map - nil - (lambda (key) - (%js-set-prop target key (%js-get-prop src key))) - (%js-object-own-string-property-keys src)) - (map - nil - (lambda (key) - (%js-set-prop target key (%js-get-prop src key))) - (%js-object-own-symbol-property-keys src)))) + (when (or (%js-object-proxy-p src) (%js-ht-p src) (%js-vm-closure-p src)) + (map nil (lambda (key) (%js-set-prop target key (%js-get-prop src key))) + (%js-object-own-string-property-keys src t)) + (map nil (lambda (key) + (when (%js-property-enumerable-p src key) + (%js-set-prop target key (%js-get-prop src key)))) + (%js-object-own-symbol-property-keys src)))) target) (defun %js-object-spread-set (obj key value) @@ -230,58 +211,81 @@ follow a spread (the fold threads the object, and %js-set-prop returns the value obj) (defun %js-object-internal-flag (obj key default) - "Look up internal flag KEY. Arrays keep their flags in the separate -*JS-ARRAY-FLAGS* side table (see runtime-property.lisp) rather than as a -gethash on the object itself, since a JS array is a CL vector, not a -hash-table, and can't hold arbitrary string keys directly." + "Look up internal flag KEY. Arrays keep their flags in *JS-ARRAY-FLAGS* and VM closures use the identity-keyed integrity table because neither stores flags directly." (cond ((%js-ht-p obj) (multiple-value-bind (value present-p) (gethash key obj) (if present-p value default))) ((%js-vec-p obj) (%js-array-flag obj key default)) + ((%js-vm-closure-p obj) (%js-object-integrity-flag obj key default)) (t default))) (defun %js-object-extensible-p (obj) (and - (or (%js-ht-p obj) (%js-vec-p obj)) + (or (%js-ht-p obj) (%js-vec-p obj) (%js-vm-closure-p obj)) (not (null (%js-object-internal-flag obj "__extensible__" t))))) -(defun %js-object-sealed-p (obj) +(defun %js-vm-closure-integrity-level-p (obj frozen-p) (and - (or (%js-ht-p obj) (%js-vec-p obj)) - (not (null (%js-object-internal-flag obj "__sealed__" nil))))) + (not (%js-object-extensible-p obj)) + (every + (lambda (key) + (multiple-value-bind (descriptor found-p) (%js-property-descriptor obj key) + (and found-p + (not (getf descriptor :configurable)) + (or (not frozen-p) (member :get descriptor) + (member :set descriptor) (not (getf descriptor :writable)))))) + (%js-property-descriptor-keys obj)))) +(defun %js-object-sealed-p (obj) + (cond + ((%js-vm-closure-p obj) + (%js-vm-closure-integrity-level-p obj nil)) + ((or (%js-ht-p obj) (%js-vec-p obj)) + (not (null (%js-object-internal-flag obj "__sealed__" nil)))) + (t nil))) (defun %js-object-frozen-p (obj) - (and - (or (%js-ht-p obj) (%js-vec-p obj)) - (not (null (%js-object-internal-flag obj "__frozen__" nil))))) - + (cond + ((%js-vm-closure-p obj) + (%js-vm-closure-integrity-level-p obj t)) + ((or (%js-ht-p obj) (%js-vec-p obj)) + (not (null (%js-object-internal-flag obj "__frozen__" nil)))) + (t nil))) (defun %js-object-prevent-extensions (obj) (cond ((%js-ht-p obj) (setf (gethash "__extensible__" obj) nil)) - ((%js-vec-p obj) (%js-set-array-flag obj "__extensible__" nil))) + ((%js-vec-p obj) (%js-set-array-flag obj "__extensible__" nil)) + ((%js-vm-closure-p obj) + (%js-set-object-integrity-flag obj "__extensible__" nil))) obj) (defun %js-object-seal (obj) (%js-object-prevent-extensions obj) (cond ((%js-ht-p obj) (setf (gethash "__sealed__" obj) t)) - ((%js-vec-p obj) (%js-set-array-flag obj "__sealed__" t))) + ((%js-vec-p obj) (%js-set-array-flag obj "__sealed__" t)) + ((%js-vm-closure-p obj) + (%js-set-object-integrity-flag obj "__sealed__" t))) + (%js-seal-property-descriptors obj nil) obj) (defun %js-object-freeze (obj) (%js-object-seal obj) (cond ((%js-ht-p obj) (setf (gethash "__frozen__" obj) t)) - ((%js-vec-p obj) (%js-set-array-flag obj "__frozen__" t))) + ((%js-vec-p obj) (%js-set-array-flag obj "__frozen__" t)) + ((%js-vm-closure-p obj) + (%js-set-object-integrity-flag obj "__frozen__" t))) + (%js-seal-property-descriptors obj t) obj) (defun %js-object-has-own (obj key) "True if OBJ has own property KEY." (cond ((%js-object-proxy-p obj) - (not (eq (%js-object-proxy-get-own-property-descriptor obj key) +js-undefined+))) + (not (eq (%js-object-proxy-get-own-property-descriptor obj key) +js-undefined+))) ((%js-ht-p obj) (%js-object-proxy-own-property-or-accessor-present-p obj key)) + ((%js-vm-closure-p obj) (nth-value 1 (%js-property-descriptor obj key))) (t nil))) (defun %js-object-from-entries (iterable) @@ -294,4 +298,3 @@ hash-table, and can't hold arbitrary string keys directly." (v (%js-get-prop entry 1))) (%js-set-prop ht k v)))) ht)) - diff --git a/src/objects/runtime-property-descriptors.lisp b/src/objects/runtime-property-descriptors.lisp new file mode 100644 index 0000000..c93abf7 --- /dev/null +++ b/src/objects/runtime-property-descriptors.lisp @@ -0,0 +1,178 @@ +(in-package #:cl-cc/javascript/objects) + +(defvar *js-own-property-descriptors* + (make-hash-table :test #'eq)) +(defvar *js-own-property-descriptor-order* (make-hash-table :test (function eq))) + +(defvar *js-object-integrity-flags* (make-hash-table :test (function eq))) + +(defun %js-property-descriptor-table (object) + (or (gethash object *js-own-property-descriptors*) + (setf (gethash object *js-own-property-descriptors*) (make-hash-table + :test + #'equal)))) + +(defun %js-property-descriptor (object key) + (let ((table (gethash object *js-own-property-descriptors*))) + (if table + (gethash (%js-to-property-key key) table) + (values nil nil)))) + +(defun %js-set-property-descriptor (object key descriptor) + (let* ((normalized-key (%js-to-property-key key)) + (table (%js-property-descriptor-table object)) + (order (gethash object *js-own-property-descriptor-order*))) + (unless (nth-value 1 (gethash normalized-key table)) + (setf (gethash object *js-own-property-descriptor-order*) + (append order (list normalized-key)))) + (setf (gethash normalized-key table) descriptor))) + +(defun %js-remove-property-descriptor (object key) + (let* ((table (gethash object *js-own-property-descriptors*)) + (normalized-key (%js-to-property-key key))) + (when table + (remhash normalized-key table)) + (setf (gethash object *js-own-property-descriptor-order*) + (remove normalized-key + (gethash object *js-own-property-descriptor-order*) + :test (function equal))))) + +(defun %js-property-value (object key) + (multiple-value-bind (descriptor found-p) (%js-property-descriptor object key) + (if found-p + (values (getf descriptor :value) t) + (values nil nil)))) + +(defun %js-property-writable-p (object key) + (multiple-value-bind (descriptor found-p) (%js-property-descriptor object key) + (if found-p (getf descriptor :writable) (not (%js-object-frozen-p object))))) + +(defun %js-property-configurable-p (object key) + (multiple-value-bind (descriptor found-p) (%js-property-descriptor object key) + (if found-p (getf descriptor :configurable) (not (%js-object-sealed-p object))))) + +(defun %js-update-property-value (object key value) + (multiple-value-bind (descriptor found-p) (%js-property-descriptor object key) + (when found-p + (setf (getf descriptor :value) value) + (%js-set-property-descriptor object key descriptor)))) + +(defun %js-seal-property-descriptors (object freeze-p) + (let ((table (gethash object *js-own-property-descriptors*))) + (when table + (maphash + (lambda (key descriptor) + (declare (ignore key)) + (setf (getf descriptor :configurable) nil) + (when freeze-p + (setf (getf descriptor :writable) nil))) + table))) + object) +(defun %js-property-descriptor-keys (object) + (copy-list (gethash object *js-own-property-descriptor-order*))) +(defun %js-property-enumerable-p (object key) (multiple-value-bind (descriptor found-p) (%js-property-descriptor object key) (if found-p (getf descriptor :enumerable) t))) + +(defun %js-object-integrity-flag (object key default) (let ((flags (gethash object *js-object-integrity-flags*))) (if flags (gethash key flags default) default))) + +(defun %js-set-object-integrity-flag (object key value) + (let ((flags + (or (gethash object *js-object-integrity-flags*) + (setf (gethash object *js-object-integrity-flags*) + (make-hash-table :test (function equal)))))) + (setf (gethash key flags) value))) +(progn + (defun %js-property-accessor-descriptor-p (descriptor) + (or (member :get descriptor) (member :set descriptor))) + (defun %js-property-get-value (object key) + (multiple-value-bind (descriptor found-p) (%js-property-descriptor object key) + (if (not found-p) + (values nil nil) + (if (%js-property-accessor-descriptor-p descriptor) + (let ((getter (getf descriptor :get +js-undefined+))) + (values (if (eq getter +js-undefined+) + +js-undefined+ + (%js-object-call-with-this object getter nil)) + t)) + (values (getf descriptor :value) t))))) + (defun %js-property-set-value (object key value) + (multiple-value-bind (descriptor present-p) (%js-property-descriptor object key) + (cond + ((and present-p (%js-property-accessor-descriptor-p descriptor)) + (let ((setter (getf descriptor :set +js-undefined+))) + (unless (eq setter +js-undefined+) + (%js-object-call-with-this object setter (list value))))) + ((%js-property-writable-p object key) + (if present-p + (%js-update-property-value object key value) + (when (and (%js-vm-closure-p object) (%js-object-extensible-p object)) + (%js-set-property-descriptor object key + (list :value value :writable t + :enumerable t :configurable t))))))) + value) + (defun %js-property-descriptor-attribute (descriptor key supplied-p value + old-descriptor old-found-p default) + (if supplied-p value + (if old-found-p (getf old-descriptor key default) default))) + (defun %js-property-set-closure-descriptor (object key descriptor old-descriptor + old-found-p old-property-p) + (let* ((old-accessor-p (and old-found-p + (%js-property-accessor-descriptor-p old-descriptor))) + (value (gethash "value" descriptor)) + (has-value-p (nth-value 1 (gethash "value" descriptor))) + (writable (gethash "writable" descriptor)) + (has-writable-p (nth-value 1 (gethash "writable" descriptor))) + (getter (gethash "get" descriptor)) + (has-getter-p (nth-value 1 (gethash "get" descriptor))) + (setter (gethash "set" descriptor)) + (has-setter-p (nth-value 1 (gethash "set" descriptor))) + (enumerable (gethash "enumerable" descriptor)) + (has-enumerable-p (nth-value 1 (gethash "enumerable" descriptor))) + (configurable (gethash "configurable" descriptor)) + (has-configurable-p (nth-value 1 (gethash "configurable" descriptor))) + (accessor-p + (or has-getter-p has-setter-p + (and old-accessor-p + (not (or has-value-p has-writable-p))))) + (attributes + (list :enumerable + (%js-property-descriptor-attribute + descriptor :enumerable has-enumerable-p enumerable old-descriptor + old-found-p old-property-p) + :configurable + (%js-property-descriptor-attribute + descriptor :configurable has-configurable-p configurable old-descriptor + old-found-p + (and old-property-p (not (%js-object-sealed-p object))))))) + (%js-set-property-descriptor + object key + (if accessor-p + (append (list :get (if has-getter-p getter + (if old-accessor-p + (getf old-descriptor :get +js-undefined+) + +js-undefined+)) + :set (if has-setter-p setter + (if old-accessor-p + (getf old-descriptor :set +js-undefined+) + +js-undefined+))) + attributes) + (append (list :value (if has-value-p value + (if old-found-p + (getf old-descriptor :value +js-undefined+) + +js-undefined+)) + :writable + (%js-property-descriptor-attribute + descriptor :writable has-writable-p writable old-descriptor + old-found-p + (and old-property-p + (not (%js-object-frozen-p object))))) + attributes))))) + (defun %js-property-descriptor-object (descriptor) + (if (%js-property-accessor-descriptor-p descriptor) + (%js-make-object "get" (getf descriptor :get +js-undefined+) + "set" (getf descriptor :set +js-undefined+) + "enumerable" (getf descriptor :enumerable) + "configurable" (getf descriptor :configurable)) + (%js-make-object "value" (getf descriptor :value +js-undefined+) + "writable" (getf descriptor :writable) + "enumerable" (getf descriptor :enumerable) + "configurable" (getf descriptor :configurable))))) diff --git a/src/objects/runtime-property.lisp b/src/objects/runtime-property.lisp index e503d37..3d80b41 100644 --- a/src/objects/runtime-property.lisp +++ b/src/objects/runtime-property.lisp @@ -18,8 +18,9 @@ (defun %js-to-property-key (key) "Coerce KEY to the runtime storage key for a JS property." - (if (%js-symbol-p key) (%js-symbol-as-key key) - (%js-to-string key))) + (if (%js-symbol-p key) + (%js-symbol-as-key key) + (%js-to-string key))) (defun %js-class-accessor-key (prefix raw-key) "Build a __get_/__set_-prefixed prototype key for a COMPUTED class accessor @@ -31,7 +32,8 @@ applied via a runtime string-concat instead of being baked into a compile-time ast-quote string." (concatenate 'string prefix (%js-to-property-key raw-key))) -(defvar *js-array-extra-properties* (make-hash-table :test #'eq) +(defvar *js-array-extra-properties* + (make-hash-table :test #'eq) "Side table for non-index, non-\"length\" string-keyed properties set on a JS array. This runtime represents JS arrays as plain CL adjustable vectors (see %js-vec-p), which have no slot to carry arbitrary named properties the @@ -45,18 +47,20 @@ extra-property write.") "Look up a non-index property KEY previously set on array ARR via %JS-ARRAY-EXTRA-PROP-SET. Returns (values value found-p)." (let ((table (gethash arr *js-array-extra-properties*))) - (if table (gethash key table) - (values nil nil)))) + (if table + (gethash key table) + (values nil nil)))) (defun %js-array-extra-prop-set (arr key value) "Set a non-index, non-\"length\" property KEY on array ARR to VALUE, in a lazily-created per-array side table (see *JS-ARRAY-EXTRA-PROPERTIES*)." - (let ((table (or (gethash arr *js-array-extra-properties*) - (setf (gethash arr *js-array-extra-properties*) - (make-hash-table :test #'equal))))) + (let ((table + (or (gethash arr *js-array-extra-properties*) + (setf (gethash arr *js-array-extra-properties*) (make-hash-table :test #'equal))))) (setf (gethash key table) value))) -(defvar *js-array-flags* (make-hash-table :test #'eq) +(defvar *js-array-flags* + (make-hash-table :test #'eq) "Side table for internal, non-JS-visible array flags (__frozen__/__sealed__/__extensible__, mirroring the plain hash-table keys Object.freeze/seal/preventExtensions already use for ordinary objects) -- @@ -71,15 +75,17 @@ if never set." (let ((table (gethash arr *js-array-flags*))) (if table (multiple-value-bind (value present-p) (gethash key table) - (if present-p value default)) + (if present-p + value + default)) default))) (defun %js-set-array-flag (arr key value) "Set internal flag KEY on array ARR to VALUE, in a lazily-created per-array side table (see *JS-ARRAY-FLAGS*)." - (let ((table (or (gethash arr *js-array-flags*) - (setf (gethash arr *js-array-flags*) - (make-hash-table :test #'equal))))) + (let ((table + (or (gethash arr *js-array-flags*) + (setf (gethash arr *js-array-flags*) (make-hash-table :test #'equal))))) (setf (gethash key table) value))) (defun %js-object-put-entry (ht k v) @@ -87,16 +93,17 @@ per-array side table (see *JS-ARRAY-FLAGS*)." internal __get_K / __set_K slot (so a getter and setter on the same key both survive and are dispatched by %js-get-prop / %js-set-prop); anything else is a plain own property." - (if (%js-accessor-descriptor-p v) (let ((kind (gethash "kind" v)) - (fn (gethash "fn" v))) - (setf (gethash - (concatenate - 'string - (if (equal kind "set") "__set_" - "__get_") - k) - ht) fn)) - (setf (gethash k ht) v)) + (if (%js-accessor-descriptor-p v) + (let ((kind (gethash "kind" v)) + (fn (gethash "fn" v))) + (setf (gethash + (concatenate 'string + (if (equal kind "set") + "__set_" + "__get_") + k) + ht) fn)) + (setf (gethash k ht) v)) v) (defun %js-get-prop (obj key) @@ -111,10 +118,11 @@ plain own property." (if (< idx (length obj)) (aref obj idx) +js-undefined+))) - ;; An own extra property (arr.foo = 1) shadows an inherited - ;; Array.prototype method of the same name, same as real JS. - (t (multiple-value-bind (val found) (%js-array-extra-prop-get obj k) - (if found val (%js-object-method-ref obj k)))))) + (t + (multiple-value-bind (val found) (%js-array-extra-prop-get obj k) + (if found + val + (%js-object-method-ref obj k)))))) ((stringp obj) (cond ((string= k "length") (length obj)) @@ -129,26 +137,27 @@ plain own property." (%js-object-proxy-get obj k obj) (let ((getter (gethash (concatenate 'string "__get_" k) obj))) (if getter - ;; Accessor property (get v(){...} / Object.defineProperty getter): - ;; invoke the getter with `this' = OBJ and return its result. (%js-object-call-with-this obj getter nil) (multiple-value-bind (val found) (gethash k obj) (cond - ;; An own callable property is a method: return it bound to OBJ so - ;; `this' inside an object-literal method (let o={m(){return this.x}}) - ;; resolves to the receiver, matching o.m() semantics. ((and found (%js-object-callable-p val)) - (let ((method val) (receiver obj)) - (lambda (&rest args) (%js-object-call-with-this receiver method args)))) + (let ((method val) + (receiver obj)) + (lambda (&rest args) + (%js-object-call-with-this receiver method args)))) (found val) - (t (%js-object-proto-method-lookup obj k)))))))) + (t + (multiple-value-bind (value found-p) (%js-property-value obj k) + (if found-p + value + (%js-object-proto-method-lookup obj k)))))))))) ((eq obj +js-null+) (error "JS TypeError: Cannot read properties of null")) ((eq obj +js-undefined+) (error "JS TypeError: Cannot read properties of undefined")) - ;; All remaining types (Number/Symbol/Promise/Map/WeakMap/WeakSet/etc.) - ;; delegate to the method resolver. Struct types like js-promise, js-map, - ;; js-weak-map returned +js-undefined+ before this fix — so promise.then / - ;; map.get / weakmap.set all failed at the call site. - (t (%js-object-method-ref obj k))))) + (t + (multiple-value-bind (value found-p) (%js-property-get-value obj k) + (if found-p + value + (%js-object-method-ref obj k))))))) (defun %js-set-prop (obj key value) "Set property KEY on JS object/array." @@ -157,57 +166,46 @@ plain own property." ((%js-vec-p obj) (cond ((string= k "length") - ;; Growing or shrinking .length either adds new indices (blocked - ;; while non-extensible, i.e. sealed or frozen) or deletes existing - ;; ones (also blocked while sealed or frozen -- deletion needs - ;; [[Configurable]], same as %js-delete's object branch above). (unless (or (%js-object-sealed-p obj) (%js-object-frozen-p obj)) (let ((new-len (truncate value))) (adjust-array obj new-len :fill-pointer new-len)))) ((every #'digit-char-p k) (let ((idx (parse-integer k))) (if (< idx (length obj)) - ;; Overwriting an existing element's value stays writable - ;; while merely sealed -- only frozen blocks it. - (unless (%js-object-frozen-p obj) - (setf (aref obj idx) value)) - ;; Growing the array by writing past its current end is - ;; adding a new index: blocked once non-extensible. - (unless (or (%js-object-frozen-p obj) - (not (%js-object-extensible-p obj))) - (adjust-array obj (1+ idx) :fill-pointer (1+ idx) - :initial-element +js-undefined+) + (unless (or (%js-object-frozen-p obj) (not (%js-property-writable-p obj k))) + (setf (aref obj idx) value) + (%js-update-property-value obj k value)) + (unless (or (%js-object-frozen-p obj) (not (%js-object-extensible-p obj))) + (adjust-array obj (1+ idx) :fill-pointer (1+ idx) :initial-element +js-undefined+) (setf (aref obj idx) value))))) - ;; A non-index, non-"length" key: an ordinary named property, same - ;; as `arr.foo = 1' in real JS. See *js-array-extra-properties*. (t (let ((present-p (nth-value 1 (%js-array-extra-prop-get obj k)))) - (unless (or (%js-object-frozen-p obj) - (not (or present-p (%js-object-extensible-p obj)))) - (%js-array-extra-prop-set obj k value)))))) + (unless + (or (%js-object-frozen-p obj) + (not (%js-property-writable-p obj k)) + (not (or present-p (%js-object-extensible-p obj)))) + (%js-array-extra-prop-set obj k value) + (%js-update-property-value obj k value)))))) ((%js-ht-p obj) (cond - ((%js-object-proxy-p obj) - (%js-object-proxy-set obj k value obj)) - ;; Defining an accessor (object-literal get/set, or assignment of an - ;; accessor descriptor): route the fn to __get_K/__set_K so a getter and - ;; setter on the same key coexist instead of overwriting each other. - ((%js-accessor-descriptor-p value) - (%js-object-put-entry obj k value)) - ;; Plain write to a key that has a setter (own, or inherited from the - ;; class prototype): invoke it with `this' = OBJ. + ((%js-object-proxy-p obj) (%js-object-proxy-set obj k value obj)) + ((%js-accessor-descriptor-p value) (%js-object-put-entry obj k value)) (t - (let ((setter (or (gethash (concatenate 'string "__set_" k) obj) - (%js-object-proto-accessor-lookup obj (concatenate 'string "__set_" k))))) + (let ((setter + (or (gethash (concatenate 'string "__set_" k) obj) + (%js-object-proto-accessor-lookup obj (concatenate 'string "__set_" k))))) (if setter (%js-object-call-with-this obj setter (list value)) (multiple-value-bind (_old present-p) (gethash k obj) (declare (ignore _old)) - (unless (or (%js-object-frozen-p obj) - (not (or present-p (%js-object-extensible-p obj)))) - (setf (gethash k obj) value)))))))) - (t nil))) - value) + (unless + (or (%js-object-frozen-p obj) + (not (%js-property-writable-p obj k)) + (not (or present-p (%js-object-extensible-p obj)))) + (setf (gethash k obj) value) + (%js-update-property-value obj k value)))))))) + (t (%js-property-set-value obj k value))) + value)) (defun %js-delete (obj key) "JS delete operator." @@ -215,41 +213,71 @@ plain own property." (cond ((%js-object-proxy-p obj) (%js-object-proxy-delete-property obj k)) ((%js-ht-p obj) - (unless (and - (or (%js-object-sealed-p obj) (%js-object-frozen-p obj)) - (nth-value 1 (gethash k obj))) - (remhash k obj) - t)) - (t t)))) + (if (nth-value 1 (gethash k obj)) + (if (or (not (%js-property-configurable-p obj k)) + (%js-object-sealed-p obj) + (%js-object-frozen-p obj)) + nil + (progn + (remhash k obj) + (%js-remove-property-descriptor obj k) + t)) + t)) + ((%js-vec-p obj) + (multiple-value-bind (value found-p) (%js-array-extra-prop-get obj k) + (declare (ignore value)) + (if found-p + (if (or (not (%js-property-configurable-p obj k)) + (%js-object-sealed-p obj) + (%js-object-frozen-p obj)) + nil + (progn + (let ((table (gethash obj *js-array-extra-properties*))) + (when table + (remhash k table))) + (%js-remove-property-descriptor obj k) + t)) + t))) + (t + (multiple-value-bind (_descriptor found-p) (%js-property-descriptor obj k) + (declare (ignore _descriptor)) + (if (and found-p (not (%js-property-configurable-p obj k))) + nil + (progn + (%js-remove-property-descriptor obj k) + t))))))) (defun %js-in (key obj) "JS 'key in obj'." (let ((k (%js-to-property-key key))) (cond ((%js-object-proxy-p obj) (%js-object-proxy-has obj k)) - ((%js-ht-p obj) (nth-value 1 (gethash k obj))) + ((%js-ht-p obj) + (or (nth-value 1 (gethash k obj)) (nth-value 1 (%js-property-descriptor obj k)))) ((%js-vec-p obj) - (or - (string= k "length") - (and (every #'digit-char-p k) (< (parse-integer k) (length obj))) - (nth-value 1 (%js-array-extra-prop-get obj k)))) - (t nil)))) + (or (string= k "length") + (and (every #'digit-char-p k) (< (parse-integer k) (length obj))) + (nth-value 1 (%js-array-extra-prop-get obj k)))) + (t (nth-value 1 (%js-property-descriptor obj k)))))) (defun %js-optional-chain (obj key) "Return nil if OBJ is null/undefined, else %js-get-prop." - (if (%js-not-nullish obj) (%js-get-prop obj key) - +js-undefined+)) + (if (%js-not-nullish obj) + (%js-get-prop obj key) + +js-undefined+)) (defun %js-optional-call (func &rest args) "Call FUNC with ARGS unless FUNC is null/undefined." - (if (%js-not-nullish func) (apply func args) - +js-undefined+)) + (if (%js-not-nullish func) + (apply func args) + +js-undefined+)) (defun %js-optional-method-call (obj key &rest args) "obj?.method(args) — short-circuit to undefined when OBJ is null/undefined." - (if (%js-not-nullish obj) (let ((method (%js-get-prop obj key))) - (apply #'%js-object-funcall method args)) - +js-undefined+)) + (if (%js-not-nullish obj) + (let ((method (%js-get-prop obj key))) + (apply #'%js-object-funcall method args)) + +js-undefined+)) ;;; ----------------------------------------------------------------------- ;;; Control flow / exceptions and iteration protocol diff --git a/src/proxies/package.lisp b/src/proxies/package.lisp index 95ccdd7..ec04656 100644 --- a/src/proxies/package.lisp +++ b/src/proxies/package.lisp @@ -10,6 +10,7 @@ #:%js-object-get-prototype-of #:%js-object-own-keys #:%js-object-prevent-extensions #:%js-object-sealed-p #:%js-object-set-prototype-of #:%js-set-prop #:%js-to-property-key #:%js-to-string #:%js-ht-p #:%js-make-ht #:%js-truthy - #:%js-vec-p #:+js-undefined+ #:%js-register-object-proxy-operation-handler ) + #:%js-vec-p + #:%js-vm-closure-p #:+js-undefined+ #:%js-register-object-proxy-operation-handler ) (:export #:%js-make-proxy-object #:%js-object-accessor-property-descriptor #:%js-object-apply-property-descriptor #:%js-object-data-property-descriptor #:%js-object-define-properties #:%js-object-define-property #:%js-object-define-property-allowed-p #:%js-object-descriptor-slot-key #:%js-object-get-own-property-descriptor #:%js-object-get-own-property-descriptors #:%js-object-own-property-or-accessor-present-p #:%js-proxy-call-trap #:%js-proxy-define-property #:%js-proxy-delete-property #:%js-proxy-get #:%js-proxy-get-own-property-descriptor #:%js-proxy-handler #:%js-proxy-has #:%js-proxy-key-list #:%js-proxy-object-p #:%js-proxy-own-keys #:%js-proxy-set #:%js-proxy-target #:%js-proxy-trap #:%js-reflect-apply #:%js-reflect-construct #:%js-reflect-define-property #:%js-reflect-delete-property #:%js-reflect-get #:%js-reflect-get-own-property-descriptor #:%js-reflect-has #:%js-reflect-prevent-extensions #:%js-reflect-set #:%js-reflect-set-prototype-of)) diff --git a/src/proxies/runtime-builtins-object-descriptors.lisp b/src/proxies/runtime-builtins-object-descriptors.lisp new file mode 100644 index 0000000..c042978 --- /dev/null +++ b/src/proxies/runtime-builtins-object-descriptors.lisp @@ -0,0 +1,284 @@ +(in-package #:cl-cc/javascript/proxies) + +(progn + (defun %js-object-descriptor-update-compatible-p (obj key descriptor) + (let* ((k (%js-to-property-key key)) + (getter-key (%js-object-descriptor-slot-key "__get_" key)) + (setter-key (%js-object-descriptor-slot-key "__set_" key)) + (old-descriptor + (nth-value 0 + (cl-cc/javascript/objects:%js-property-descriptor obj k))) + (has-old-descriptor + (nth-value 1 + (cl-cc/javascript/objects:%js-property-descriptor obj k))) + (old-property-p (%js-object-own-property-or-accessor-present-p obj k)) + (old-getter (cond + ((%js-ht-p obj) + (gethash getter-key obj +js-undefined+)) + ((and has-old-descriptor (member :get old-descriptor)) + (getf old-descriptor :get)) + (t +js-undefined+))) + (old-setter (cond + ((%js-ht-p obj) + (gethash setter-key obj +js-undefined+)) + ((and has-old-descriptor (member :set old-descriptor)) + (getf old-descriptor :set)) + (t +js-undefined+))) + (has-old-getter (or (and (%js-ht-p obj) + (nth-value 1 (gethash getter-key obj))) + (and (cl-cc/javascript/objects:%js-vm-closure-p obj) + has-old-descriptor + (member :get old-descriptor)))) + (has-old-setter (or (and (%js-ht-p obj) + (nth-value 1 (gethash setter-key obj))) + (and (cl-cc/javascript/objects:%js-vm-closure-p obj) + has-old-descriptor + (member :set old-descriptor)))) + (value (gethash "value" descriptor)) + (has-value-p (nth-value 1 (gethash "value" descriptor))) + (writable (gethash "writable" descriptor)) + (has-writable-p (nth-value 1 (gethash "writable" descriptor))) + (enumerable (gethash "enumerable" descriptor)) + (has-enumerable-p (nth-value 1 (gethash "enumerable" descriptor))) + (configurable (gethash "configurable" descriptor)) + (has-configurable-p (nth-value 1 (gethash "configurable" descriptor))) + (getter (gethash "get" descriptor)) + (has-getter-p (nth-value 1 (gethash "get" descriptor))) + (setter (gethash "set" descriptor)) + (has-setter-p (nth-value 1 (gethash "set" descriptor))) + (new-data-p (or has-value-p has-writable-p)) + (new-accessor-p (or has-getter-p has-setter-p)) + (old-accessor-p (or has-old-getter has-old-setter)) + (old-value + (if has-old-descriptor + (getf old-descriptor :value) + (if (%js-ht-p obj) + (gethash k obj +js-undefined+) + +js-undefined+))) + (old-writable + (if has-old-descriptor + (getf old-descriptor :writable) + (and old-property-p (not (%js-object-frozen-p obj))))) + (old-enumerable + (if has-old-descriptor + (getf old-descriptor :enumerable) + old-property-p)) + (old-configurable + (if has-old-descriptor + (getf old-descriptor :configurable) + (and old-property-p (not (%js-object-sealed-p obj)))))) + (and (not (and new-data-p new-accessor-p)) + (or (not old-property-p) + old-configurable + (and (or (not has-configurable-p) + (not (%js-truthy configurable))) + (or (not has-enumerable-p) + (eql (%js-truthy enumerable) old-enumerable)) + (or (not (or new-data-p new-accessor-p)) + (eq new-accessor-p old-accessor-p)) + (if old-accessor-p + (and (or (not has-getter-p) + (cl-cc/javascript/objects:%js-object-is + old-getter getter)) + (or (not has-setter-p) + (cl-cc/javascript/objects:%js-object-is + old-setter setter))) + (or old-writable + (and (or (not has-writable-p) + (not (%js-truthy writable))) + (or (not has-value-p) + (cl-cc/javascript/objects:%js-object-is + old-value value)))))))))) + (defun %js-object-apply-property-descriptor (obj key descriptor) + (when (and (%js-object-define-property-allowed-p obj key descriptor) + (%js-object-descriptor-update-compatible-p obj key descriptor)) + (let* ((k (%js-to-property-key key)) + (getter-key (%js-object-descriptor-slot-key "__get_" key)) + (setter-key (%js-object-descriptor-slot-key "__set_" key)) + (old-descriptor + (nth-value 0 + (cl-cc/javascript/objects:%js-property-descriptor + obj k))) + (has-old-descriptor + (nth-value 1 + (cl-cc/javascript/objects:%js-property-descriptor + obj k))) + (old-property-p (%js-object-own-property-or-accessor-present-p obj k)) + (old-value + (multiple-value-bind (value found-p) + (if has-old-descriptor + (values (getf old-descriptor :value) t) + (if (%js-ht-p obj) + (gethash k obj) + (cl-cc/javascript/objects:%js-property-value obj k))) + (if found-p value +js-undefined+))) + (value (gethash "value" descriptor)) + (has-value-p (nth-value 1 (gethash "value" descriptor))) + (writable (gethash "writable" descriptor)) + (has-writable-p (nth-value 1 (gethash "writable" descriptor))) + (enumerable (gethash "enumerable" descriptor)) + (has-enumerable-p (nth-value 1 (gethash "enumerable" descriptor))) + (configurable (gethash "configurable" descriptor)) + (has-configurable-p + (nth-value 1 (gethash "configurable" descriptor)))) + (when (and (%js-ht-p obj) + (or has-value-p has-writable-p)) + (remhash getter-key obj) + (remhash setter-key obj) + (when has-value-p + (setf (gethash k obj) value))) + (if (cl-cc/javascript/objects:%js-vm-closure-p obj) + (cl-cc/javascript/objects:%js-property-set-closure-descriptor + obj k descriptor old-descriptor has-old-descriptor old-property-p) + (cl-cc/javascript/objects:%js-set-property-descriptor + obj k + (list :value (if has-value-p value old-value) + :writable (if has-writable-p writable + (if has-old-descriptor + (getf old-descriptor :writable) + (and old-property-p + (not (%js-object-frozen-p obj))))) + :enumerable (if has-enumerable-p enumerable + (if has-old-descriptor + (getf old-descriptor :enumerable) + old-property-p)) + :configurable (if has-configurable-p configurable + (if has-old-descriptor + (getf old-descriptor :configurable) + (and old-property-p + (not (%js-object-sealed-p obj)))))))) + (multiple-value-bind (getter has-getter-p) + (gethash "get" descriptor) + (when (and has-getter-p (%js-ht-p obj)) + (setf (gethash getter-key obj) getter))) + (multiple-value-bind (setter has-setter-p) + (gethash "set" descriptor) + (when (and has-setter-p (%js-ht-p obj)) + (setf (gethash setter-key obj) setter)))) + t))) + +(defun %js-object-descriptor-slot-key (prefix key) + (concatenate 'string prefix (%js-to-string key))) + +(defun %js-object-own-property-or-accessor-present-p (obj key) + (let* ((k (%js-to-property-key key)) + (getter-key (%js-object-descriptor-slot-key "__get_" key)) + (setter-key (%js-object-descriptor-slot-key "__set_" key))) + (or + (nth-value 1 (cl-cc/javascript/objects:%js-property-descriptor obj k)) + (and (%js-ht-p obj) + (or (nth-value 1 (gethash k obj)) + (nth-value 1 (gethash getter-key obj)) + (nth-value 1 (gethash setter-key obj))))))) + +(defun %js-object-define-property-allowed-p (obj key descriptor) + (and + (or (%js-ht-p obj) + (cl-cc/javascript/objects:%js-vm-closure-p obj)) + (%js-ht-p descriptor) + (or + (%js-object-own-property-or-accessor-present-p obj key) + (%js-object-extensible-p obj)))) + +(defun %js-object-data-property-descriptor (obj key value) + (multiple-value-bind (attributes found-p) + (cl-cc/javascript/objects:%js-property-descriptor obj key) + (%js-make-object + "value" value + "writable" (and (not (%js-object-frozen-p obj)) + (if found-p (getf attributes :writable) t)) + "enumerable" (if found-p (getf attributes :enumerable) t) + "configurable" (and (not (%js-object-sealed-p obj)) + (if found-p (getf attributes :configurable) t))))) + +(defun %js-object-accessor-property-descriptor (obj key) + (let* ((descriptor + (%js-make-object "enumerable" t "configurable" (not (%js-object-sealed-p obj)))) + (getter-key (%js-object-descriptor-slot-key "__get_" key)) + (setter-key (%js-object-descriptor-slot-key "__set_" key))) + (multiple-value-bind (getter has-getter-p) (gethash getter-key obj) + (when has-getter-p + (setf (gethash "get" descriptor) getter))) + (multiple-value-bind (setter has-setter-p) (gethash setter-key obj) + (when has-setter-p + (setf (gethash "set" descriptor) setter))) + descriptor)) + +(defun %js-reflect-define-property (target key descriptor) + (cond + ((%js-proxy-object-p target) (%js-proxy-define-property target key descriptor)) + (t (%js-object-apply-property-descriptor target key descriptor)))) + +(defun %js-reflect-get-own-property-descriptor (target key) + (%js-object-get-own-property-descriptor target key)) + +(defun %js-object-define-property (obj key descriptor) + (unless (%js-reflect-define-property obj key descriptor) + (error "JS TypeError: Cannot define property ~A" (%js-to-string key))) + obj) + +(defun %js-object-define-properties (obj props) + (when (and (%js-ht-p obj) (%js-ht-p props)) + (maphash + (lambda (k v) + (when (%js-ht-p v) + (%js-object-define-property obj k v))) + props)) + obj) + +(defun %js-object-get-own-property-descriptor (obj key) + (cond + ((%js-proxy-object-p obj) (%js-proxy-get-own-property-descriptor obj key)) + ((%js-ht-p obj) + (let ((k (%js-to-property-key key))) + (multiple-value-bind (val found) (gethash k obj) + (cond + (found (%js-object-data-property-descriptor obj k val)) + ((%js-object-own-property-or-accessor-present-p obj k) (if (or (nth-value 1 (gethash (%js-object-descriptor-slot-key "__get_" k) obj)) (nth-value 1 (gethash (%js-object-descriptor-slot-key "__set_" k) obj))) (%js-object-accessor-property-descriptor obj k) (%js-object-data-property-descriptor obj k (cl-cc/javascript/objects:%js-property-value obj k)))) + (t +js-undefined+))))) + (t + (multiple-value-bind (attributes found-p) + (cl-cc/javascript/objects:%js-property-descriptor obj key) + (if found-p + (cl-cc/javascript/objects:%js-property-descriptor-object attributes) + +js-undefined+))))) + +(defun %js-object-get-own-property-descriptors (obj) + (let ((result (%js-make-ht))) + (cond + ((%js-proxy-object-p obj) + (dolist (key (%js-proxy-key-list (%js-proxy-own-keys obj))) + (let ((descriptor (%js-object-get-own-property-descriptor obj key))) + (unless (eq descriptor +js-undefined+) + (setf (gethash (%js-to-string key) result) descriptor))))) + ((%js-ht-p obj) + (maphash + (lambda (key value) + (unless (%js-internal-key-p key) + (setf (gethash key result) + (%js-object-data-property-descriptor obj key value)))) + obj) + (maphash + (lambda (key value) + (declare (ignore value)) + (let ((property-name (%js-object-accessor-property-name key))) + (when (and property-name + (not (nth-value 1 (gethash property-name result)))) + (setf (gethash property-name result) + (%js-object-accessor-property-descriptor obj property-name))))) + obj) + (map nil + (lambda (key) + (unless (nth-value 1 (gethash key result)) + (let ((descriptor (%js-object-get-own-property-descriptor obj key))) + (unless (eq descriptor +js-undefined+) + (setf (gethash key result) descriptor))))) + (cl-cc/javascript/objects:%js-property-descriptor-keys obj))) + ((cl-cc/javascript/objects:%js-vm-closure-p obj) + (map nil + (lambda (key) + (let ((descriptor (%js-object-get-own-property-descriptor obj key))) + (unless (eq descriptor +js-undefined+) + (setf (gethash (%js-to-property-key key) result) descriptor)))) + (cl-cc/javascript/objects:%js-object-own-property-keys obj)))) + result)) diff --git a/src/proxies/runtime-builtins-object.lisp b/src/proxies/runtime-builtins-object.lisp index bfbda85..c859ad0 100644 --- a/src/proxies/runtime-builtins-object.lisp +++ b/src/proxies/runtime-builtins-object.lisp @@ -8,14 +8,16 @@ ;;; Reflect / Object property-descriptor helpers (for runtime-builtins-table.lisp) ;;; ----------------------------------------------------------------------- (defun %js-reflect-get (target key &optional receiver) - (if (%js-proxy-object-p target) (%js-proxy-get target key (or receiver target)) - (%js-get-prop target key))) + (if (%js-proxy-object-p target) + (%js-proxy-get target key (or receiver target)) + (%js-get-prop target key))) (defun %js-reflect-set (target key value &optional receiver) - (if (%js-proxy-object-p target) (%js-proxy-set target key value (or receiver target)) - (progn - (%js-set-prop target key value) - t))) + (if (%js-proxy-object-p target) + (%js-proxy-set target key value (or receiver target)) + (progn + (%js-set-prop target key value) + t))) (defun %js-reflect-has (target key) (%js-in key target)) @@ -30,75 +32,6 @@ (declare (ignore new-target)) (%js-new target (coerce args 'list))) -(defun %js-object-descriptor-slot-key (prefix key) - (concatenate 'string prefix (%js-to-string key))) - -(defun %js-object-own-property-or-accessor-present-p (obj key) - (let* ((k (%js-to-property-key key)) - (getter-key (%js-object-descriptor-slot-key "__get_" key)) - (setter-key (%js-object-descriptor-slot-key "__set_" key))) - (or - (nth-value 1 (gethash k obj)) - (nth-value 1 (gethash getter-key obj)) - (nth-value 1 (gethash setter-key obj))))) - -(defun %js-object-define-property-allowed-p (obj key descriptor) - (and - (%js-ht-p obj) - (%js-ht-p descriptor) - (not (%js-object-frozen-p obj)) - (or - (%js-object-own-property-or-accessor-present-p obj key) - (%js-object-extensible-p obj)))) - -(defun %js-object-apply-property-descriptor (obj key descriptor) - (when (%js-object-define-property-allowed-p obj key descriptor) - (let* ((k (%js-to-property-key key)) - (getter-key (%js-object-descriptor-slot-key "__get_" key)) - (setter-key (%js-object-descriptor-slot-key "__set_" key))) - (multiple-value-bind (val has-value-p) (gethash "value" descriptor) - (when has-value-p - (setf (gethash k obj) val))) - (multiple-value-bind (getter has-getter-p) (gethash "get" descriptor) - (when has-getter-p - (setf (gethash getter-key obj) getter))) - (multiple-value-bind (setter has-setter-p) (gethash "set" descriptor) - (when has-setter-p - (setf (gethash setter-key obj) setter)))) - t)) - -(defun %js-object-data-property-descriptor (obj value) - (%js-make-object - "value" - value - "writable" - (not (%js-object-frozen-p obj)) - "enumerable" - t - "configurable" - (not (%js-object-sealed-p obj)))) - -(defun %js-object-accessor-property-descriptor (obj key) - (let* ((descriptor - (%js-make-object "enumerable" t "configurable" (not (%js-object-sealed-p obj)))) - (getter-key (%js-object-descriptor-slot-key "__get_" key)) - (setter-key (%js-object-descriptor-slot-key "__set_" key))) - (multiple-value-bind (getter has-getter-p) (gethash getter-key obj) - (when has-getter-p - (setf (gethash "get" descriptor) getter))) - (multiple-value-bind (setter has-setter-p) (gethash setter-key obj) - (when has-setter-p - (setf (gethash "set" descriptor) setter))) - descriptor)) - -(defun %js-reflect-define-property (target key descriptor) - (cond - ((%js-proxy-object-p target) (%js-proxy-define-property target key descriptor)) - (t (%js-object-apply-property-descriptor target key descriptor)))) - -(defun %js-reflect-get-own-property-descriptor (target key) - (%js-object-get-own-property-descriptor target key)) - (defun %js-reflect-set-prototype-of (target proto) (when (%js-ht-p target) (let ((before (%js-object-get-prototype-of target))) @@ -106,66 +39,15 @@ (or (eq before proto) (eq (%js-object-get-prototype-of target) proto))))) (defun %js-reflect-prevent-extensions (target) - (when (%js-ht-p target) + (when (or (%js-ht-p target) (%js-vec-p target) (%js-vm-closure-p target)) (%js-object-prevent-extensions target) t)) -(defun %js-object-define-property (obj key descriptor) - (unless (%js-reflect-define-property obj key descriptor) - (error "JS TypeError: Cannot define property ~A" (%js-to-string key))) - obj) - -(defun %js-object-define-properties (obj props) - (when (and (%js-ht-p obj) (%js-ht-p props)) - (maphash - (lambda (k v) - (when (%js-ht-p v) - (%js-object-define-property obj k v))) - props)) - obj) - -(defun %js-object-get-own-property-descriptor (obj key) - (cond - ((%js-proxy-object-p obj) (%js-proxy-get-own-property-descriptor obj key)) - ((%js-ht-p obj) - (let ((k (%js-to-property-key key))) - (multiple-value-bind (val found) (gethash k obj) - (cond - (found (%js-object-data-property-descriptor obj val)) - ((%js-object-own-property-or-accessor-present-p obj k) - (%js-object-accessor-property-descriptor obj k)) - (t +js-undefined+))))) - (t +js-undefined+))) - -(defun %js-object-get-own-property-descriptors (obj) - (let ((result (%js-make-ht))) - (cond - ((%js-proxy-object-p obj) - (dolist (key (%js-proxy-key-list (%js-proxy-own-keys obj))) - (let ((descriptor (%js-object-get-own-property-descriptor obj key))) - (unless (eq descriptor +js-undefined+) - (setf (gethash (%js-to-string key) result) descriptor))))) - ((%js-ht-p obj) - (maphash - (lambda (k v) - (unless (%js-internal-key-p k) - (setf (gethash k result) (%js-object-data-property-descriptor obj v)))) - obj) - (maphash - (lambda (k v) - (declare (ignore v)) - (let ((property-name (%js-object-accessor-property-name k))) - (when (and property-name (not (nth-value 1 (gethash property-name result)))) - (setf (gethash property-name result) (%js-object-accessor-property-descriptor obj property-name))))) - obj))) - result)) - (defun %js-proxy-object-p (obj) "True when OBJ is a runtime Proxy wrapper." - (and - (%js-ht-p obj) - (nth-value 1 (gethash "__proxy-target__" obj)) - (nth-value 1 (gethash "__proxy-handler__" obj)))) + (and (%js-ht-p obj) + (nth-value 1 (gethash "__proxy-target__" obj)) + (nth-value 1 (gethash "__proxy-handler__" obj)))) (defun %js-proxy-target (proxy) (gethash "__proxy-target__" proxy)) @@ -182,8 +64,9 @@ (defun %js-proxy-call-trap (proxy name &rest args) (let ((trap (%js-proxy-trap proxy name))) - (if trap (values (apply #'%js-funcall trap args) t) - (values +js-undefined+ nil)))) + (if trap + (values (apply #'%js-funcall trap args) t) + (values +js-undefined+ nil)))) (defun %js-proxy-key-list (keys) (cond @@ -193,62 +76,60 @@ (defun %js-proxy-get (proxy key &optional receiver) (let ((target (%js-proxy-target proxy))) - (multiple-value-bind (result trapped) (%js-proxy-call-trap proxy "get" target (%js-to-string key) (or receiver proxy)) - (if trapped result - (%js-get-prop target key))))) + (multiple-value-bind (result trapped) + (%js-proxy-call-trap proxy "get" target (%js-to-string key) (or receiver proxy)) + (if trapped + result + (%js-get-prop target key))))) (defun %js-proxy-set (proxy key value &optional receiver) (let ((target (%js-proxy-target proxy))) - (multiple-value-bind (result trapped) (%js-proxy-call-trap - proxy - "set" - target - (%js-to-string key) - value - (or receiver proxy)) - (if trapped (%js-truthy result) - (progn - (%js-set-prop target key value) - t))))) + (multiple-value-bind (result trapped) + (%js-proxy-call-trap proxy "set" target (%js-to-string key) value (or receiver proxy)) + (if trapped + (%js-truthy result) + (progn + (%js-set-prop target key value) + t))))) (defun %js-proxy-has (proxy key) (let ((target (%js-proxy-target proxy))) - (multiple-value-bind (result trapped) (%js-proxy-call-trap proxy "has" target (%js-to-string key)) - (if trapped (%js-truthy result) - (%js-in key target))))) + (multiple-value-bind (result trapped) + (%js-proxy-call-trap proxy "has" target (%js-to-string key)) + (if trapped + (%js-truthy result) + (%js-in key target))))) (defun %js-proxy-delete-property (proxy key) (let ((target (%js-proxy-target proxy))) - (multiple-value-bind (result trapped) (%js-proxy-call-trap proxy "deleteProperty" target (%js-to-string key)) - (if trapped (%js-truthy result) - (%js-delete target key))))) + (multiple-value-bind (result trapped) + (%js-proxy-call-trap proxy "deleteProperty" target (%js-to-string key)) + (if trapped + (%js-truthy result) + (%js-delete target key))))) (defun %js-proxy-own-keys (proxy) (let ((target (%js-proxy-target proxy))) (multiple-value-bind (result trapped) (%js-proxy-call-trap proxy "ownKeys" target) - (if trapped result - (%js-object-own-keys target))))) + (if trapped + result + (%js-object-own-keys target))))) (defun %js-proxy-define-property (proxy key descriptor) (let ((target (%js-proxy-target proxy))) - (multiple-value-bind (result trapped) (%js-proxy-call-trap - proxy - "defineProperty" - target - (%js-to-string key) - descriptor) - (if trapped (%js-truthy result) - (%js-reflect-define-property target key descriptor))))) + (multiple-value-bind (result trapped) + (%js-proxy-call-trap proxy "defineProperty" target (%js-to-string key) descriptor) + (if trapped + (%js-truthy result) + (%js-reflect-define-property target key descriptor))))) (defun %js-proxy-get-own-property-descriptor (proxy key) (let ((target (%js-proxy-target proxy))) - (multiple-value-bind (result trapped) (%js-proxy-call-trap - proxy - "getOwnPropertyDescriptor" - target - (%js-to-string key)) - (if trapped result - (%js-object-get-own-property-descriptor target key))))) + (multiple-value-bind (result trapped) + (%js-proxy-call-trap proxy "getOwnPropertyDescriptor" target (%js-to-string key)) + (if trapped + result + (%js-object-get-own-property-descriptor target key))))) (defun %js-make-proxy-object (target handler) "Proxy constructor: stores target+handler and routes common traps at runtime." diff --git a/src/statements/package.lisp b/src/statements/package.lisp index 6a8dad2..c17b2d6 100644 --- a/src/statements/package.lisp +++ b/src/statements/package.lisp @@ -20,5 +20,5 @@ #:register-js-source-parser #:js-parser-handler #:js-call-parser-handler #:js-skip-semis #:register-js-parser-handler #:*js-contextual-keyword-token-types*) - (:export #:%js-binding-sym #:%js-binding-to-sym #:%js-consume-expected #:%js-default-access #:%js-destructure-sub-bindings #:%js-emit-array-element-bindings #:%js-emit-array-pattern-bindings #:%js-emit-array-rest-binding #:%js-emit-destructure-bindings #:%js-emit-named-property-bindings #:%js-emit-object-pattern-bindings #:%js-emit-rest-property-binding #:%js-for-in #:%js-iter-keys #:%js-lower-do-while-with-tags #:%js-lower-for-c-style #:%js-lower-for-of-in #:%js-lower-switch #:%js-lower-while-with-tags #:%js-make-tagbody #:%js-parse-all-stmts #:%js-parse-array-binding-pattern #:%js-parse-binding-pattern #:%js-parse-for-c-style-declared-stmt #:%js-parse-for-in-of-stmt #:%js-parse-for-in-stmt #:%js-parse-for-of-stmt #:%js-parse-object-binding-pattern #:%js-parse-pattern-default #:%js-parse-stmt-body #:%js-parse-switch-body #:%js-truthy-call #:%js-try-catch-finally #:*js-break-targets* #:*js-continue-targets* #:*js-label-break-targets* #:*js-label-continue-targets* #:*js-loop-break-target* #:*js-loop-continue-target* #:*js-stmt-parsers* #:define-js-stmt-parser #:js-parse-block #:js-parse-for-stmt #:js-parse-stmt #:js-parse-stmt-list #:js-parse-switch-stmt #:js-parse-var-decl #:with-js-loop-tags)) + (:export #:%js-binding-sym #:%js-binding-to-sym #:%js-consume-expected #:%js-default-access #:%js-destructure-sub-bindings #:%js-emit-array-element-bindings #:%js-emit-array-pattern-bindings #:%js-emit-array-rest-binding #:%js-emit-destructure-bindings #:%js-emit-named-property-bindings #:%js-emit-object-pattern-bindings #:%js-emit-rest-property-binding #:%js-for-in #:%js-iter-keys #:%js-lower-do-while-with-tags #:%js-lower-for-c-style #:%js-lower-for-of-in #:%js-lower-switch #:%js-lower-while-with-tags #:%js-make-tagbody #:%js-parse-all-stmts #:%js-parse-array-binding-pattern #:%js-parse-binding-pattern #:%js-parse-for-c-style-declared-stmt #:%js-parse-for-in-of-stmt #:%js-parse-for-in-stmt #:%js-parse-for-of-stmt #:%js-parse-object-binding-pattern #:%js-parse-pattern-default #:%js-parse-stmt-body #:%js-parse-switch-body #:%js-truthy-call #:%js-try-catch-finally #:*js-break-targets* #:*js-continue-targets* #:*js-label-break-targets* #:*js-label-continue-targets* #:*js-loop-break-target* #:*js-loop-continue-target* #:*js-stmt-parsers* #:define-js-stmt-parser #:js-parse-block #:js-parse-for-stmt #:js-parse-stmt #:js-parse-stmt-list #:js-parse-switch-stmt #:js-parse-var-decl #:with-js-loop-tags #:*js-gdi-mode* #:*js-gdi-lower-var-declarations* #:*js-gdi-function-depth* #:*js-gdi-lexical-scope-depth* #:*js-gdi-collect-global-lexical-bindings* #:*js-gdi-global-lexical-bindings*)) diff --git a/src/statements/parser-stmt-control.lisp b/src/statements/parser-stmt-control.lisp index 306e352..e291562 100644 --- a/src/statements/parser-stmt-control.lisp +++ b/src/statements/parser-stmt-control.lisp @@ -16,116 +16,180 @@ INIT-AST is the already-parsed init form (or NIL for no-init). Returns (values ast rest)." (let* ((rest2 (%js-consume-expected :T-SEMI current)) (cond-expr - (if (eq (js-peek-type rest2) :T-SEMI) (make-ast-quote :value t) - (multiple-value-bind (e r) (js-call-parser-handler :expression rest2) - (setf rest2 r) - e))) + (if (eq (js-peek-type rest2) :T-SEMI) + (make-ast-quote :value t) + (multiple-value-bind (e r) (js-call-parser-handler :expression rest2) + (setf rest2 r) + e))) (rest3 (%js-consume-expected :T-SEMI rest2)) (update-expr - (if (eq (js-peek-type rest3) :T-RPAREN) (make-ast-quote :value nil) - (multiple-value-bind (e r) (js-call-parser-handler :expression rest3) - (setf rest3 r) - e))) + (if (eq (js-peek-type rest3) :T-RPAREN) + (make-ast-quote :value nil) + (multiple-value-bind (e r) (js-call-parser-handler :expression rest3) + (setf rest3 r) + e))) (rest4 (%js-consume-expected :T-RPAREN rest3))) - (with-js-loop-tags - (loop-tag end-tag "FOR") - (multiple-value-bind (body-ast rest5) (%js-parse-stmt-body rest4) - (let* ((body-stmts - (if (ast-progn-p body-ast) (ast-progn-forms body-ast) - (list body-ast))) - (loop-ast - (%js-lower-while-with-tags - (%js-truthy-call cond-expr) - (append body-stmts (list update-expr)) - loop-tag - end-tag))) - (values - (if init-ast (make-ast-progn :forms (list init-ast loop-ast)) - loop-ast) - rest5)))))) + (with-js-loop-tags (loop-tag end-tag "FOR") + (multiple-value-bind (body-ast rest5) (%js-parse-stmt-body rest4) + (let* ((body-stmts + (if (ast-progn-p body-ast) + (ast-progn-forms body-ast) + (list body-ast))) + (loop-ast + (%js-lower-while-with-tags (%js-truthy-call cond-expr) + (append body-stmts (list update-expr)) + loop-tag + end-tag))) + (values + (if init-ast + (make-ast-progn :forms (list init-ast loop-ast)) + loop-ast) + rest5)))))) -(defun %js-lower-for-of-in (binding iter-expr body-fn-name loop-tag end-tag &optional await-p) - "Shared lowering for for-in and for-of loops. -ITER-EXPR is the call that produces the iteration list. -BINDING is either a plain symbol (simple) or an (:array-pattern/:object-pattern …) -destructuring pattern — in the latter case we emit full destructuring bindings inside -the loop so `for (let [a,b] of pairs)' correctly unpacks each element. -AWAIT-P (for-await-of only) wraps each element access in a %js-await call, so a -per-iteration promise (what a real async iterator yields) is unwrapped before the -loop body sees it — this runtime's promises are already simplified to always-settled -synchronously (see runtime-promise.lisp's header), so unwrapping is itself synchronous. -Returns a closure that accepts the parsed body-ast." +(defun %js-lower-for-of-in (binding iter-expr + body-fn-name + loop-tag + end-tag + &optional + await-p + global-var-p) + "Lower a for-in/of loop body, writing top-level var bindings globally." (declare (ignore body-fn-name)) - (let ((var-sym (%js-binding-to-sym binding)) + (let ((var-sym (%js-binding-to-sym binding)) (iter-sym (gensym "FOR-ITER-"))) (lambda (body-ast) - (let* ((body-stmts (if (ast-progn-p body-ast) - (ast-progn-forms body-ast) - (list body-ast))) - (raw-elem-access (make-ast-call - :func (make-ast-var :name 'car) - :args (list (make-ast-var :name iter-sym)))) - (elem-access (if await-p - (make-ast-call :func (make-ast-var :name '%js-await) - :args (list raw-elem-access)) - raw-elem-access)) - ;; For destructuring patterns emit all inner bindings inside the loop. - ;; %js-emit-destructure-bindings returns ((gensym . source) name1 name2 …). - ;; The first binding is (gensym . (var gensym)) — a self-reference placeholder; - ;; we replace its RHS with the actual (car iter-sym) element access. + (let* ((body-stmts + (if (ast-progn-p body-ast) + (ast-progn-forms body-ast) + (list body-ast))) + (raw-elem-access + (make-ast-call :func + (make-ast-var :name (quote car)) + :args + (list (make-ast-var :name iter-sym)))) + (elem-access + (if await-p + (make-ast-call :func (make-ast-var :name '%js-await) :args (list raw-elem-access)) + raw-elem-access)) (loop-bindings (if (listp binding) - (multiple-value-bind (dest-bindings _) + (multiple-value-bind (dest-bindings extras) (%js-emit-destructure-bindings binding (make-ast-var :name var-sym)) - (declare (ignore _)) + (declare (ignore extras)) (cons (cons var-sym elem-access) (rest dest-bindings))) (list (cons var-sym elem-access))))) - (let* ((iter-advance (make-ast-setq - :var iter-sym - :value (make-ast-call - :func (make-ast-var :name 'cdr) - :args (list (make-ast-var :name iter-sym))))) + (let* ((iter-advance + (make-ast-setq :var + iter-sym + :value + (make-ast-call :func + (make-ast-var :name (quote cdr)) + :args + (list (make-ast-var :name iter-sym))))) (combined-body (append body-stmts (list iter-advance))) - ;; For destructuring, build nested single-binding lets so each binding - ;; sees all earlier ones (let* semantics). %js-emit-destructure-bindings - ;; returns bindings in dependency order, so folding from the inside out - ;; is correct for any nesting depth. (inner-form - (if (listp binding) - (let ((r combined-body)) - (dolist (b (reverse loop-bindings) (first r)) - (setf r (list (make-ast-let :bindings (list b) :body r))))) - (make-ast-let :bindings loop-bindings :body combined-body)))) - (make-ast-let - :bindings (list (cons iter-sym iter-expr)) - :body (list (%js-lower-while-with-tags - (%js-truthy-call (make-ast-var :name iter-sym)) - (list inner-form) - loop-tag end-tag)))))))) + (if global-var-p + (let ((forms combined-body)) + (dolist (binding-pair (reverse loop-bindings)) + (let ((name (car binding-pair)) + (value (cdr binding-pair))) + (when + (and (symbolp name) + (eq (symbol-package name) (find-package :cl-cc/javascript))) + (setf forms (cons + (js-call-parser-handler :gdi-global-write-ast name value) + forms))) + (setf forms (list + (make-ast-let :bindings (list binding-pair) :body forms))))) + (make-ast-progn :forms forms)) + (if (listp binding) + (let ((forms combined-body)) + (dolist (binding-pair (reverse loop-bindings)) + (setf forms (list + (make-ast-let :bindings (list binding-pair) :body forms)))) + (first forms)) + (make-ast-let :bindings loop-bindings :body combined-body))))) + (make-ast-let :bindings + (list (cons iter-sym iter-expr)) + :body + (list + (%js-lower-while-with-tags (%js-truthy-call (make-ast-var :name iter-sym)) + (list inner-form) + loop-tag + end-tag)))))))) (defun %js-parse-for-in-of-stmt (binding kind rest2 tag-prefix wrap-fn-name &optional await-p) - "Shared parse+lower for 'for (KIND BINDING in/of EXPR) body'. REST2 points at -'in'/'of'. TAG-PREFIX (\"FOR-IN\"/\"FOR-OF\") is passed straight through to -WITH-JS-LOOP-TAGS. WRAP-FN-NAME is %js-iter-keys (for-in) or %js-iter-values -(for-of/for-await-of). AWAIT-P is passed straight through to -%js-lower-for-of-in — see its docstring. Returns (values ast rest)." + "Parse and lower a declared for-in/of loop." (multiple-value-bind (expr rest3) (js-call-parser-handler :expression (cdr rest2)) (setf rest3 (%js-consume-expected :T-RPAREN rest3)) - (with-js-loop-tags - (loop-tag end-tag tag-prefix) - (multiple-value-bind (body-ast rest4) (%js-parse-stmt-body rest3) - (let ((lower - (funcall - (%js-lower-for-of-in - binding - (make-ast-call :func (make-ast-var :name wrap-fn-name) :args (list expr)) - nil - loop-tag - end-tag - await-p) - body-ast))) - (setf (ast-let-declarations lower) (list kind)) - (values lower rest4)))))) + (let ((shadow-names + (when (member kind (list :let :const) :test (function eq)) + (multiple-value-bind (bindings extras) + (%js-emit-destructure-bindings binding (make-ast-quote :value :js-undefined)) + (declare (ignore extras)) + (loop for binding-pair in bindings + for name = (car binding-pair) + when (and (symbolp name) + (eq (symbol-package name) (find-package :cl-cc/javascript))) + collect name))))) + (with-js-loop-tags (loop-tag end-tag tag-prefix) + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append + (when *js-gdi-mode* + shadow-names) + cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (multiple-value-bind (body-ast rest4) (%js-parse-stmt-body rest3) + (let* ((gdi-var-p + (and *js-gdi-mode* + (zerop *js-gdi-function-depth*) + (eq kind :var))) + (global-var-p (and gdi-var-p *js-gdi-lower-var-declarations*)) + (lower + (funcall + (%js-lower-for-of-in binding + (make-ast-call :func + (make-ast-var :name + wrap-fn-name) + :args + (list expr)) + nil + loop-tag + end-tag + await-p + global-var-p) + body-ast))) + (if gdi-var-p + (multiple-value-bind (declared-bindings extras) + (%js-emit-destructure-bindings binding + (make-ast-quote :value + :js-undefined)) + (declare (ignore extras)) + (setf (ast-let-declarations lower) nil) + (values + (make-ast-progn :forms + (cons + (make-ast-let :bindings + (remove-if-not + (lambda (declaration-binding) + (let ((name + (car + declaration-binding))) + (and (symbolp name) + (eq + (symbol-package + name) + (find-package + :cl-cc/javascript))))) + declared-bindings) + :declarations + (list :var) + :body + nil) + (list lower))) + rest4)) + (progn + (setf (ast-let-declarations lower) (list kind)) + (values lower rest4)))))))))) (defun %js-parse-for-in-stmt (binding kind rest2) "Parse and lower 'for (KIND BINDING in obj) body'. REST2 points at 'in'. @@ -139,25 +203,50 @@ points at 'of'. Returns (values ast rest)." (%js-parse-for-in-of-stmt binding kind rest2 "FOR-OF" '%js-iter-values await-p)) (defun %js-parse-for-c-style-declared-stmt (binding kind rest2) - "Parse and lower 'for (KIND BINDING [= init] ; cond ; update) body'. -REST2 points just past the binding (at '=' or ';'). Returns (values ast rest)." - (let ((init-val (make-ast-quote :value nil)) - (rest-at-semi rest2)) + "Parse and lower a declared C-style for loop." + (let* ((shadow-names + (when (member kind (list :let :const) :test (function eq)) + (multiple-value-bind (bindings extras) + (%js-emit-destructure-bindings binding (make-ast-quote :value :js-undefined)) + (declare (ignore extras)) + (loop for binding-pair in bindings + for name = (car binding-pair) + when (and (symbolp name) + (eq (symbol-package name) (find-package :cl-cc/javascript))) + collect name)))) + (cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append + (when *js-gdi-mode* + shadow-names) + cl-cc/javascript/syntax:*js-gdi-shadowed-names*)) + (var-sym (%js-binding-to-sym binding)) + (init-val (make-ast-quote :value nil)) + (has-init nil) + (rest-at-semi rest2)) (when (and (eq (js-peek-type rest2) :T-OP) (equal (js-peek-value rest2) "=")) - (multiple-value-bind (e r) (js-call-parser-handler :expression (cdr rest2)) - (setf init-val e - rest-at-semi r))) - (let ((init-bindings - (make-ast-let - :bindings - (list (cons (%js-binding-to-sym binding) init-val)) - :declarations - (list kind) - :body - nil))) - (multiple-value-bind (loop-ast rest6) (%js-lower-for-c-style rest-at-semi nil) - (setf (ast-let-body init-bindings) (list loop-ast)) - (values init-bindings rest6))))) + (multiple-value-bind (expr rest) (js-call-parser-handler :expression (cdr rest2)) + (setf init-val expr + has-init t + rest-at-semi rest))) + (if (and *js-gdi-mode* + *js-gdi-lower-var-declarations* + (zerop *js-gdi-function-depth*) + (eq kind :var)) + (multiple-value-bind (loop-ast rest) (%js-lower-for-c-style rest-at-semi nil) + (values + (if has-init + (make-ast-progn :forms + (list (js-call-parser-handler :gdi-global-write-ast var-sym init-val) + loop-ast)) + loop-ast) + rest)) + (multiple-value-bind (bindings extras) (%js-emit-destructure-bindings binding init-val) + (declare (ignore extras)) + (let ((init-bindings + (make-ast-let :bindings bindings :declarations (list kind) :body nil))) + (multiple-value-bind (loop-ast rest) (%js-lower-for-c-style rest-at-semi nil) + (setf (ast-let-body init-bindings) (list loop-ast)) + (values init-bindings rest))))))) (defun js-parse-for-stmt (stream) "Handle for(init;cond;update){}, for(var x in obj){}, diff --git a/src/statements/parser-stmt-dispatch.lisp b/src/statements/parser-stmt-dispatch.lisp index 868c6e2..7cd626e 100644 --- a/src/statements/parser-stmt-dispatch.lisp +++ b/src/statements/parser-stmt-dispatch.lisp @@ -3,14 +3,12 @@ ;;;; Main statement dispatcher and statement-list parser. ;;;; ;;;; Load order: after parser-stmt-flow.lisp. - (in-package #:cl-cc/javascript/statements) ;;; ─── Main Statement Dispatcher ─────────────────────────────────────────────── ;;; ;;; Consults *js-stmt-parsers* for simple token-type dispatch. Complex cases ;;; requiring lookahead or multi-step processing are handled inline. - (defun js-parse-stmt (stream) "Main statement dispatcher. Returns (values ast rest)." (setf stream (js-skip-semis stream)) @@ -19,76 +17,85 @@ (let ((type (js-peek-type stream)) (value (js-peek-value stream))) (cond - ;; Braced block — not in table (no keyword to consume before block) - ((eq type :T-LBRACE) - (js-parse-block stream)) - ;; async function / async arrow — requires 2-token lookahead - ((and (eq type :T-ASYNC) - (eq (js-peek-type (cdr stream)) :T-FUNCTION)) - (js-call-parser-handler :statement-async-function (cddr stream))) - ;; decorated class declaration — requires parsing decorators first - ((eq type :T-AT) - (js-call-parser-handler :statement-decorated-class stream)) - ;; using x = expr (ES2025 contextual keyword) — requires ident lookahead - ((and (eq type :T-USING) - (eq (js-peek-type (cdr stream)) :T-IDENT)) - (js-call-parser-handler (list :statement :T-USING) (cdr stream))) - ;; import(...) and import.meta are expressions even at statement start. - ;; Other leading import forms remain module import declarations. - ((and (eq type :T-IMPORT) - (member (js-peek-type (cdr stream)) '(:T-LPAREN :T-DOT))) - (multiple-value-bind (expr rest) (js-call-parser-handler :expression stream) - (values expr (js-skip-semis rest)))) - ;; Labelled statement: ident : stmt — requires colon lookahead - ;; break LABEL → (return-from label-block); continue LABEL → (go continue-tag) - ((and (eq type :T-IDENT) - (eq (js-peek-type (cdr stream)) :T-COLON)) - (let* ((label-name (if (stringp value) value (string-downcase (symbol-name value)))) - (label-block (intern (concatenate 'string "JS-LABEL-" label-name) :keyword)) - (label-continue-tag (gensym (concatenate 'string "LABEL-" label-name "-CONTINUE-"))) - (rest (cddr stream))) - ;; Register this label's break target (the block exit) so `break LABEL` - ;; can emit (return-from label-block). Register a continue tag too for - ;; `continue LABEL` inside nested loops. - (setf (gethash label-name *js-label-break-targets*) label-block - (gethash label-name *js-label-continue-targets*) label-continue-tag) - (unwind-protect - (multiple-value-bind (stmt rest2) (js-parse-stmt rest) - (values (make-ast-block - :name label-block - :body (list stmt)) - rest2)) - (remhash label-name *js-label-break-targets*) - (remhash label-name *js-label-continue-targets*)))) - ;; Table-driven dispatch: token-type → registered parser - (t - (let ((parser (or (gethash type *js-stmt-parsers*) - (js-parser-handler (list :statement type))))) - (if parser - (funcall parser (cdr stream)) ; pass stream after keyword - ;; Expression statement (assignments, calls, etc.) - (multiple-value-bind (expr rest) (js-call-parser-handler :expression stream) - (values expr (js-skip-semis rest))))))))) + ;; Braced block — not in table (no keyword to consume before block) + ((eq type :T-LBRACE) + (js-parse-block stream)) + ;; async function / async arrow — requires 2-token lookahead + ((and (eq type :T-ASYNC) + (eq (js-peek-type (cdr stream)) :T-FUNCTION)) + (js-call-parser-handler :statement-async-function (cddr stream))) + ;; decorated class declaration — requires parsing decorators first + ((eq type :T-AT) + (multiple-value-bind (ast rest) + (js-call-parser-handler :statement-decorated-class stream) + (%js-gdi-record-global-class ast) + (values ast rest))) + ;; using x = expr (ES2025 contextual keyword) — requires ident lookahead + ((and (eq type :T-USING) + (eq (js-peek-type (cdr stream)) :T-IDENT)) + (js-call-parser-handler (list :statement :T-USING) (cdr stream))) + ;; import(...) and import.meta are expressions even at statement start. + ;; Other leading import forms remain module import declarations. + ((and (eq type :T-IMPORT) + (member (js-peek-type (cdr stream)) '(:T-LPAREN :T-DOT))) + (multiple-value-bind (expr rest) (js-call-parser-handler :expression stream) + (values expr (js-skip-semis rest)))) + ;; Labelled statement: ident : stmt — requires colon lookahead + ;; break LABEL → (return-from label-block); continue LABEL → (go continue-tag) + ((and (eq type :T-IDENT) + (eq (js-peek-type (cdr stream)) :T-COLON)) + (let* ((label-name (if (stringp value) value (string-downcase (symbol-name value)))) + (label-block (intern (concatenate 'string "JS-LABEL-" label-name) :keyword)) + (label-continue-tag (gensym (concatenate 'string "LABEL-" label-name "-CONTINUE-"))) + (rest (cddr stream))) + ;; Register this label's break target (the block exit) so `break LABEL` + ;; can emit (return-from label-block). Register a continue tag too for + ;; `continue LABEL` inside nested loops. + (setf (gethash label-name *js-label-break-targets*) label-block + (gethash label-name *js-label-continue-targets*) label-continue-tag) + (unwind-protect + (multiple-value-bind (stmt rest2) (js-parse-stmt rest) + (values (make-ast-block + :name label-block + :body (list stmt)) + rest2)) + (remhash label-name *js-label-break-targets*) + (remhash label-name *js-label-continue-targets*)))) + ;; Table-driven dispatch: token-type → registered parser + (t + (let ((parser (or (gethash type *js-stmt-parsers*) + (js-parser-handler (list :statement type))))) + ;; Registered parsers receive the stream after the leading keyword. + (if parser + (multiple-value-bind (ast rest) + (funcall parser (cdr stream)) + (%js-gdi-record-global-class ast) + (values ast rest)) + (multiple-value-bind (expr rest) + (js-call-parser-handler :expression stream) + (values expr (js-skip-semis rest))))))))) ;;; ─── Top-Level Statement List Parser ──────────────────────────────────────── - (defun %js-parse-all-stmts (stream) - "Parse all statements until EOF. - Returns (values ast-list rest)." + "Parse all script statements until EOF, optionally preserving top-level declarations for GDI. +Returns (values ast-list rest)." (let ((stmts nil) (current stream)) - (loop - (setf current (js-skip-semis current)) - (when (js-at-eof-p current) - (return)) - (multiple-value-bind (stmt rest) (js-parse-stmt current) - (when stmt (push stmt stmts)) - ;; Safety guard: a statement parser must consume at least one token. - ;; If REST did not advance past CURRENT, signal rather than spin forever. - (when (eq rest current) - (error "JS parse error: no progress at ~S" (js-peek current))) - (setf current rest))) - (values (%js-finish-let-bindings (nreverse stmts)) current))) + (loop (setf current (js-skip-semis current)) (when (js-at-eof-p current) + (return)) (multiple-value-bind (stmt rest) + (js-parse-stmt current) + (when stmt + (push stmt stmts)) + (when (eq rest current) + (error + "JS parse error: no progress at ~S" + (js-peek current))) + (setf current rest))) + (values + (if *js-gdi-mode* + (nreverse stmts) + (%js-finish-let-bindings (nreverse stmts))) + current))) (defun js-parse-stmt-list (stream) "Parse statements until a closing } (which is consumed) or EOF. @@ -114,6 +121,12 @@ via fboundp." (declare (ignore _)) (values (%js-finish-let-bindings (nreverse stmts)) rest)))) +(defun %js-parse-function-body-statement-list (stream) + (let ((*js-gdi-function-depth* (1+ *js-gdi-function-depth*))) + (js-call-parser-handler :statement-list stream))) + (eval-when (:load-toplevel :execute) (register-js-source-parser (function %js-parse-all-stmts)) - (register-js-parser-handler :statement-list (function js-parse-stmt-list))) + (register-js-parser-handler :statement-list (function js-parse-stmt-list)) + (register-js-parser-handler :function-body-statement-list + (function %js-parse-function-body-statement-list))) diff --git a/src/statements/parser-stmt-switch.lisp b/src/statements/parser-stmt-switch.lisp index 7f8eb05..05d0d75 100644 --- a/src/statements/parser-stmt-switch.lisp +++ b/src/statements/parser-stmt-switch.lisp @@ -58,46 +58,46 @@ "Lower switch(expr){case x:...; default:...} to a let/tagbody dispatch form." (let* ((value-sym (gensym "SWITCH-VAL-")) (default-tag - (when default-body - (gensym "SWITCH-DEFAULT-"))) + (when default-body + (gensym "SWITCH-DEFAULT-"))) (case-labels - (loop repeat (length cases) - collect (gensym "SWITCH-CASE-"))) + (loop repeat (length cases) + collect (gensym "SWITCH-CASE-"))) (dispatch-forms - (append + (append + (loop for case in cases + for label in case-labels + collect (make-ast-if :cond + (make-ast-call :func + (make-ast-var :name '%js-strict-eq) + :args + (list (make-ast-var :name value-sym) + (car case))) + :then + (make-ast-go :tag label) + :else + (make-ast-quote :value nil))) + (list (make-ast-go :tag (or default-tag break-tag))))) + (case-forms (loop for case in cases for label in case-labels - collect (make-ast-if - :cond - (make-ast-call - :func - (make-ast-var :name '%js-strict-eq) - :args - (list (make-ast-var :name value-sym) (car case))) - :then - (make-ast-go :tag label) - :else - (make-ast-quote :value nil))) - (list (make-ast-go :tag (or default-tag break-tag))))) - (case-forms - (loop for case in cases - for label in case-labels - append (cons label (cdr case)))) + append (cons label (cdr case)))) (default-forms - (when default-body - (cons default-tag default-body)))) - (make-ast-let - :bindings - (list (cons value-sym switch-expr)) - :body - (list - (make-ast-block - :name - nil - :body - (list - (%js-make-tagbody - (append dispatch-forms case-forms default-forms (list break-tag))))))))) + (when default-body + (cons default-tag default-body)))) + (make-ast-let :bindings + (list (cons value-sym switch-expr)) + :body + (list + (make-ast-block :name + nil + :body + (list + (%js-make-tagbody + (append dispatch-forms + case-forms + default-forms + (list break-tag))))))))) (defun js-parse-switch-stmt (stream) "Parse switch(expr){case x:...; default:...}. @@ -107,7 +107,29 @@ (multiple-value-bind (switch-expr rest2) (js-call-parser-handler :expression rest) (setf rest2 (%js-consume-expected :T-RPAREN rest2)) (let* ((break-tag (gensym "SWITCH-END-")) + (*js-gdi-lexical-scope-depth* (1+ *js-gdi-lexical-scope-depth*)) (*js-loop-break-target* break-tag) (*js-break-targets* (cons break-tag *js-break-targets*))) - (multiple-value-bind (cases default-body rest3) (%js-parse-switch-body rest2 break-tag) + (multiple-value-bind (cases default-body rest3) + (if cl-cc/javascript/syntax:*js-gdi-global-reference-mode* + (multiple-value-bind (raw-cases raw-default-body raw-rest) + (let ((cl-cc/javascript/syntax:*js-gdi-global-reference-mode* nil) + (cl-cc/javascript/syntax:*js-gdi-global-lexical-names* nil) + (cl-cc/javascript/syntax:*js-gdi-global-var-names* nil)) + (%js-parse-switch-body rest2 break-tag)) + (declare (ignore raw-rest)) + (let* ((switch-lexical-names + (remove-duplicates + (append + (%js-gdi-block-lexical-names + (loop for case in raw-cases + append (cdr case))) + (%js-gdi-block-lexical-names raw-default-body)) + :test + (function eq))) + (cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append switch-lexical-names + cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (%js-parse-switch-body rest2 break-tag))) + (%js-parse-switch-body rest2 break-tag)) (values (%js-lower-switch switch-expr cases default-body break-tag) rest3)))))) diff --git a/src/statements/parser-stmt.lisp b/src/statements/parser-stmt.lisp index 122f1cb..7be16ef 100644 --- a/src/statements/parser-stmt.lisp +++ b/src/statements/parser-stmt.lisp @@ -7,32 +7,59 @@ ;;;; All loop constructs are lowered at parse time rather than emitting ;;;; symbolic :while/:for calls, because the compiler resolves the pre-built ;;;; AST directly without a macro expansion pass for frontend ASTs. - (in-package #:cl-cc/javascript/statements) ;;; ─── Token Stream Helpers ──────────────────────────────────────────────────── ;;; %js-consume-expected and js-skip-semis are in parser-stmt-binding.lisp. ;;; js-tok-type, js-tok-value, js-peek*, js-consume, js-expect, js-at-eof-p, ;;; js-ident-sym, and js-try-consume are defined in parser.lisp (loaded first). - ;;; ─── Dynamic Variables for Loop/Switch Control Flow ───────────────────────── +(progn + (defvar *js-gdi-mode* + nil) + (defvar *js-gdi-lower-var-declarations* + nil) + (defvar *js-gdi-function-depth* + 0) + (defvar *js-gdi-lexical-scope-depth* + 0) + (defvar *js-gdi-collect-global-lexical-bindings* + nil) + (defvar *js-gdi-global-lexical-bindings* + nil) + (defun %js-gdi-record-global-class (node) + (when + (and *js-gdi-collect-global-lexical-bindings* + (zerop *js-gdi-lexical-scope-depth*) + (zerop *js-gdi-function-depth*)) + (cond + ((cl-cc/ast:ast-defclass-p node) + (push (cons (cl-cc/ast:ast-defclass-name node) :class) *js-gdi-global-lexical-bindings*)) + ((cl-cc/ast:ast-progn-p node) + (dolist (form (cl-cc/ast:ast-progn-forms node)) + (%js-gdi-record-global-class form))))) + node) + (defvar *js-loop-continue-target* + nil + "Dynamically bound innermost loop continue target tag (gensym).")) -(defvar *js-loop-continue-target* nil - "Dynamically bound innermost loop continue target tag (gensym).") - -(defvar *js-loop-break-target* nil +(defvar *js-loop-break-target* + nil "Dynamically bound innermost loop/switch break target tag (gensym).") - -(defvar *js-break-targets* nil +(defvar *js-break-targets* + nil "Stack of break targets for nested loops/switch, innermost first.") -(defvar *js-continue-targets* nil +(defvar *js-continue-targets* + nil "Stack of continue targets for nested loops, innermost first.") -(defvar *js-label-break-targets* (make-hash-table :test #'equal) +(defvar *js-label-break-targets* + (make-hash-table :test #'equal) "Maps JS label name strings to their break target tags (for labeled break).") -(defvar *js-label-continue-targets* (make-hash-table :test #'equal) +(defvar *js-label-continue-targets* + (make-hash-table :test #'equal) "Maps JS label name strings to their continue target tags (for labeled continue).") (defmacro with-js-loop-tags ((loop-tag end-tag prefix) &body body) @@ -50,10 +77,10 @@ concatenated at runtime rather than required to be a macroexpansion-time constant, letting one caller share this macro across a family of loops that picks its own prefix per call (see %js-parse-for-in-of-stmt)." `(let* ((,loop-tag (gensym (concatenate 'string ,prefix "-"))) - (,end-tag (gensym (concatenate 'string ,prefix "-END-"))) + (,end-tag (gensym (concatenate 'string ,prefix "-END-"))) (*js-loop-continue-target* ,loop-tag) - (*js-loop-break-target* ,end-tag) - (*js-break-targets* (cons ,end-tag *js-break-targets*)) + (*js-loop-break-target* ,end-tag) + (*js-break-targets* (cons ,end-tag *js-break-targets*)) (*js-continue-targets* (cons ,loop-tag *js-continue-targets*))) ,@body)) @@ -62,24 +89,28 @@ picks its own prefix per call (see %js-parse-for-in-of-stmt)." ;;; Each define-js-stmt-parser call registers a handler for one token type. ;;; The handler receives STREAM positioned AFTER the keyword token was consumed. ;;; js-parse-stmt consults this table first before falling back to complex cases. - -(defvar *js-stmt-parsers* (make-hash-table) +(defvar *js-stmt-parsers* + (make-hash-table) "Maps token type keywords to (lambda (after-keyword-stream)) statement parsers.") (defmacro define-js-stmt-parser (token-type (stream) &body body) "Register a statement parser for TOKEN-TYPE in *js-stmt-parsers*. STREAM is positioned AFTER the keyword token; BODY must return (values ast rest)." - `(setf (gethash ,token-type *js-stmt-parsers*) - (lambda (,stream) ,@body))) + `(setf (gethash ,token-type *js-stmt-parsers*) (lambda (,stream) + ,@body))) ;;; Simple token-type → parser registrations (consume keyword, parse body) -(define-js-stmt-parser :T-VAR (s) (js-parse-var-decl s :var)) -(define-js-stmt-parser :T-LET (s) (js-parse-var-decl s :let)) -(define-js-stmt-parser :T-CONST (s) (js-parse-var-decl s :const)) -(define-js-stmt-parser :T-FOR (s) (js-parse-for-stmt s)) -(define-js-stmt-parser :T-SWITCH (s) (js-parse-switch-stmt s)) -;;; ─── Loop Lowering Helpers ─────────────────────────────────────────────────── +(define-js-stmt-parser :T-VAR (s) (js-parse-var-decl s :var)) + +(define-js-stmt-parser :T-LET (s) (js-parse-var-decl s :let)) + +(define-js-stmt-parser :T-CONST (s) (js-parse-var-decl s :const)) + +(define-js-stmt-parser :T-FOR (s) (js-parse-for-stmt s)) +(define-js-stmt-parser :T-SWITCH (s) (js-parse-switch-stmt s)) + +;;; ─── Loop Lowering Helpers ─────────────────────────────────────────────────── (defun %js-make-tagbody (items) "Build an AST-TAGBODY from a flat list of tags (symbols) and form AST nodes. Symbols start new tag sections; AST nodes accumulate under the current tag." @@ -93,7 +124,8 @@ picks its own prefix per call (see %js-parse-for-in-of-stmt)." (if (symbolp item) (progn (flush) - (setf current-tag item current-forms nil)) + (setf current-tag item + current-forms nil)) (progn (unless current-tag (setf current-tag (gensym "TAGBODY-"))) @@ -103,54 +135,91 @@ picks its own prefix per call (see %js-parse-for-in-of-stmt)." (defun %js-lower-while-with-tags (cond-expr body loop-tag end-tag) "Lower while with caller-supplied LOOP-TAG (continue) and END-TAG (break)." - (make-ast-block :name nil - :body (list (%js-make-tagbody - (append (list loop-tag - (make-ast-if - :cond cond-expr - :then (make-ast-quote :value nil) - :else (make-ast-return-from - :name nil - :value (make-ast-quote :value nil)))) - body - (list (make-ast-go :tag loop-tag) - end-tag)))))) + (make-ast-block :name + nil + :body + (list + (%js-make-tagbody + (append + (list loop-tag + (make-ast-if :cond + cond-expr + :then + (make-ast-quote :value nil) + :else + (make-ast-return-from :name + nil + :value + (make-ast-quote :value nil)))) + body + (list (make-ast-go :tag loop-tag) end-tag)))))) (defun %js-lower-do-while-with-tags (cond-expr body loop-tag end-tag) "Lower do{body}while(cond) with caller-supplied LOOP-TAG and END-TAG." - (make-ast-block :name nil - :body (list (%js-make-tagbody - (append (list loop-tag) - body - (list (make-ast-if - :cond cond-expr - :then (make-ast-go :tag loop-tag) - :else (make-ast-quote :value nil)) - end-tag)))))) + (make-ast-block :name + nil + :body + (list + (%js-make-tagbody + (append (list loop-tag) + body + (list + (make-ast-if :cond + cond-expr + :then + (make-ast-go :tag loop-tag) + :else + (make-ast-quote :value nil)) + end-tag)))))) (defun %js-truthy-call (expr) "Wrap EXPR in a %js-truthy coercion call." - (make-ast-call :func (make-ast-var :name '%js-truthy) - :args (list expr))) + (make-ast-call :func (make-ast-var :name '%js-truthy) :args (list expr))) ;;; ─── Block Parsing ─────────────────────────────────────────────────────────── - -(defun js-parse-block (stream) - "Parse { stmt... } and return (values ast-progn rest). - The returned AST is an ast-progn wrapping all collected statements." - (with-js-parse-depth - (let ((current (%js-consume-expected :T-LBRACE stream)) - (stmts nil)) - (loop - (setf current (js-skip-semis current)) - (when (or (js-at-eof-p current) - (eq (js-peek-type current) :T-RBRACE)) - (return)) - (multiple-value-bind (stmt rest) (js-parse-stmt current) - (when stmt (push stmt stmts)) - (setf current rest))) - (values (make-ast-progn :forms (%js-finish-let-bindings (nreverse stmts))) - (%js-consume-expected :T-RBRACE current))))) +(progn + (defun %js-gdi-block-lexical-names (forms) + (loop for form in forms + append (cond + ((and (cl-cc/ast:ast-let-p form) + (intersection (cl-cc/ast:ast-let-declarations form) + '(:let :const) + :test + #'eq)) (mapcar #'car (cl-cc/ast:ast-let-bindings form))) + ((cl-cc/ast:ast-defun-p form) (list (cl-cc/ast:ast-defun-name form))) + ((cl-cc/ast:ast-defclass-p form) (list (cl-cc/ast:ast-defclass-name form))) + (t nil)))) + (defun %js-parse-block-statements (stream) + (let ((current stream) + (stmts nil)) + (loop (setf current (js-skip-semis current)) (when + (or (js-at-eof-p current) + (eq (js-peek-type current) :T-RBRACE)) + (return)) (multiple-value-bind (stmt rest) + (js-parse-stmt current) + (when stmt + (push stmt stmts)) + (setf current rest))) + (multiple-value-bind (_ rest) (js-expect :T-RBRACE current) + (declare (ignore _)) + (values (nreverse stmts) rest)))) + (defun js-parse-block (stream) + "Parse { stmt... } and return (values ast-progn rest)." + (with-js-parse-depth + (let ((*js-gdi-lexical-scope-depth* (1+ *js-gdi-lexical-scope-depth*)) + (body-stream (%js-consume-expected :T-LBRACE stream))) + (multiple-value-bind (stmts rest) + (if cl-cc/javascript/syntax:*js-gdi-global-reference-mode* + (multiple-value-bind (raw-forms raw-rest) + (let ((cl-cc/javascript/syntax:*js-gdi-global-reference-mode* nil)) + (%js-parse-block-statements body-stream)) + (declare (ignore raw-rest)) + (let ((cl-cc/javascript/syntax:*js-gdi-shadowed-names* + (append (%js-gdi-block-lexical-names raw-forms) + cl-cc/javascript/syntax:*js-gdi-shadowed-names*))) + (%js-parse-block-statements body-stream))) + (%js-parse-block-statements body-stream)) + (values (make-ast-progn :forms (%js-finish-let-bindings stmts)) rest)))))) (defun %js-parse-stmt-body (stream) "Parse either a braced block or a single statement. @@ -163,61 +232,69 @@ picks its own prefix per call (see %js-parse-for-in-of-stmt)." ;;; All binding helpers (%js-binding-sym, %js-parse-binding-pattern, etc.) ;;; and token helpers (%js-consume-expected, js-skip-semis) are in ;;; parser-stmt-binding.lisp (loaded before this file). - ;;; ─── Variable Declaration Parsing ─────────────────────────────────────────── - (defun js-parse-var-decl (stream kind) - "Parse var/let/const declaration(s). - KIND is :VAR :LET or :CONST. - Handles: x, x = expr, {a,b}=obj, [a,b]=arr, and comma-separated lists. - Returns (values ast rest)." + "Parse var/let/const declarations and return the declaration AST and rest." (let ((current stream) - ;; Each declarator's bindings list is pushed here whole and flattened - ;; once after the loop, instead of repeated (setf all-bindings - ;; (append all-bindings bindings)) — quadratic in the number of - ;; comma-separated declarators. (binding-chunks nil)) - (loop - ;; Parse one declarator - (multiple-value-bind (binding rest) (%js-parse-binding-pattern current) - (setf current rest) - ;; A declarator with no initializer (`let x;') is undefined, NOT nil/false. - ;; Binding it to nil made `typeof x' report "boolean" and `x === undefined' - ;; false; the runtime undefined sentinel is :js-undefined. - (let ((init-expr (make-ast-quote :value :js-undefined))) - ;; Optional initializer: = expr - (when (and current - (eq (js-peek-type current) :T-OP) - (equal (js-peek-value current) "=")) - (setf current (cdr current)) - ;; Use assignment-expr (NOT js-parse-expr) so the initializer stops at - ;; the comma separating declarators — otherwise `const a = 1, b = 2` - ;; parses `1, b = 2` as one comma-expression and drops the b binding. - (multiple-value-bind (expr rest2) (js-call-parser-handler :assignment-expression current) - (setf init-expr expr - current rest2))) - ;; Expand binding into bindings list - (multiple-value-bind (bindings _extras) - (%js-emit-destructure-bindings binding init-expr) - (declare (ignore _extras)) - (push bindings binding-chunks)))) - ;; More declarators? - (if (and current (eq (js-peek-type current) :T-COMMA)) - (setf current (cdr current)) - (return))) + (loop (multiple-value-bind (binding rest) (%js-parse-binding-pattern current) + (setf current rest) + (let ((init-expr + (make-ast-quote :value + (if (and *js-gdi-mode* + (zerop *js-gdi-function-depth*) + (eq kind :var)) + :js-gdi-no-initializer + :js-undefined)))) + (when + (and current + (eq (js-peek-type current) :T-OP) + (equal (js-peek-value current) "=")) + (setf current (cdr current)) + (multiple-value-bind (expr rest2) + (js-call-parser-handler :assignment-expression current) + (setf init-expr expr + current rest2))) + (multiple-value-bind (bindings extras) + (%js-emit-destructure-bindings binding init-expr) + (declare (ignore extras)) + (push bindings binding-chunks)))) (if (and current + (eq (js-peek-type current) :T-COMMA)) + (setf current (cdr current)) + (return))) (setf current (js-skip-semis current)) - (let ((all-bindings (apply #'append (nreverse binding-chunks)))) - ;; A single empty-bodied let carrying all bindings. ast-let binds in PARALLEL, - ;; but JS declarations are sequential (let*) — `let a = 1, b = a + 1' and - ;; destructuring (a = tmp[0] must see tmp = init) both depend on it. The - ;; block-finishing pass %js-finish-let-bindings expands a multi-binding - ;; empty-bodied let into nested single-binding lets, giving that sequential - ;; scoping (and scoping the bindings over the rest of the block). - (values (make-ast-let :bindings all-bindings :body nil - :declarations (list kind)) - current)))) - + (let ((all-bindings (apply (function append) (nreverse binding-chunks)))) + (when + (and *js-gdi-collect-global-lexical-bindings* + (zerop *js-gdi-lexical-scope-depth*) + (zerop *js-gdi-function-depth*) + (member kind (quote (:let :const)) :test (function eq))) + (dolist (binding all-bindings) + (let ((name (car binding))) + (when (and (symbolp name) (eq (symbol-package name) (find-package :cl-cc/javascript))) + (push (cons name kind) *js-gdi-global-lexical-bindings*))))) + (values + (if (and *js-gdi-mode* + *js-gdi-lower-var-declarations* + (zerop *js-gdi-function-depth*) + (eq kind :var)) + (let ((tail nil)) + (dolist (binding (reverse all-bindings)) + (let ((name (car binding)) + (value (cdr binding))) + (if (eq (symbol-package name) (find-package :cl-cc/javascript)) + (unless + (and (cl-cc/ast:ast-quote-p value) + (eq (cl-cc/ast:ast-quote-value value) :js-gdi-no-initializer)) + (setf tail (cons (js-call-parser-handler :gdi-global-write-ast name value) + tail))) + (setf tail (list (make-ast-let :bindings (list binding) :body tail)))))) + (if tail + (make-ast-progn :forms tail) + (make-ast-quote :value :js-undefined))) + (make-ast-let :bindings all-bindings :body nil :declarations (list kind))) + current)))) ;;; Function declaration + if/while/do-while parsers -> see parser-stmt-fn.lisp - -(eval-when (:load-toplevel :execute) (register-js-parser-handler :var-declaration (function js-parse-var-decl))) +(eval-when (:load-toplevel :execute) + (register-js-parser-handler :var-declaration (function js-parse-var-decl))) diff --git a/src/statements/runtime-control.lisp b/src/statements/runtime-control.lisp index aa31c1a..4f5f24e 100644 --- a/src/statements/runtime-control.lisp +++ b/src/statements/runtime-control.lisp @@ -3,7 +3,6 @@ ;;;; Statement control-flow helpers extracted from runtime.lisp. ;;;; Includes try/catch/finally and for-in lowering. ;;;; Load order: directly after runtime.lisp. - (in-package #:cl-cc/javascript/statements) (defun %js-try-catch-finally (try-thunk catch-thunk finally-thunk) @@ -14,11 +13,10 @@ raw CL:FUNCALL which cannot call a vm-closure." (let ((result +js-undefined+)) (unwind-protect - (handler-case - (setf result (%js-object-funcall try-thunk)) - (js-exception (c) - (when catch-thunk - (setf result (%js-object-funcall catch-thunk (js-exception-value c)))))) + (handler-case (setf result (%js-object-funcall try-thunk)) + (js-exception (c) + (when catch-thunk + (setf result (%js-object-funcall catch-thunk (js-exception-value c)))))) (when finally-thunk (%js-object-funcall finally-thunk))) result)) @@ -26,7 +24,6 @@ ;;; ----------------------------------------------------------------------- ;;; Iteration protocol ;;; ----------------------------------------------------------------------- - (defun %js-for-in (obj body-fn) "Execute BODY-FN for each enumerable string key in OBJ, in the same order Object.keys/values/entries use: array-index keys numerically ascending @@ -37,7 +34,7 @@ accessor (getter/setter) property enumerates under its real property name plain data property) -- internal runtime keys (__proto__, __class__, the __get_X/__set_X storage keys themselves) are still excluded." (when (%js-ht-p obj) - (loop for k across (%js-object-own-string-property-keys obj) + (loop for k across (%js-object-own-string-property-keys obj t) do (%js-object-funcall body-fn k))) +js-undefined+) @@ -45,5 +42,7 @@ __get_X/__set_X storage keys themselves) are still excluded." "Collect OBJ's enumerable string keys into a fresh CL list — the 1-arg companion to %js-for-in, used by the for-in loop lowering (see %js-iter-values)." (let ((acc nil)) - (%js-for-in obj (lambda (k) (push k acc))) + (%js-for-in obj + (lambda (k) + (push k acc))) (nreverse acc))) diff --git a/src/syntax/package.lisp b/src/syntax/package.lisp index c38354c..feba6d7 100644 --- a/src/syntax/package.lisp +++ b/src/syntax/package.lisp @@ -1,7 +1,2 @@ -(defpackage #:cl-cc/javascript/syntax - (:use #:cl) - (:import-from #:cl-cc/ast - #:ast-let-bindings #:ast-let-body #:ast-let-declarations #:ast-let-p - #:make-ast-block #:make-ast-call #:make-ast-let #:make-ast-var ) - (:export #:%js-callable-body #:%js-consume-then #:%js-finish-let-bindings #:%js-lex-hash-token #:%js-lex-slash-token #:%js-lex-string-escape-char #:*js-keywords* #:*js-operator-tokens* #:*js-parse-depth* #:+js-max-operator-length+ #:define-builder-table #:js-alnum-p #:js-alpha-p #:js-at-eof-p #:js-at-op-p #:js-consume #:js-digit-p #:js-expect #:js-hex-digit-p #:js-id-continue-p #:js-id-start-p #:js-ident-sym #:js-peek #:js-peek-type #:js-peek-value #:js-regex-follows-p #:js-tok-type #:js-tok-value #:js-whitespace-p #:lex-js-identifier #:lex-js-operator #:lex-js-private-ident #:lex-js-string #:make-js-token #:parse-js-module #:parse-js-source #:skip-js-block-comment #:skip-js-line-comment #:skip-js-whitespace-and-comments #:tokenize-js-source #:with-js-parse-depth #:js-lexer-extension-handler #:js-call-lexer-extension #:register-js-lexer-extension #:js-parse-source-tokens #:register-js-source-parser #:register-js-parser-handler #:js-parser-handler #:js-call-parser-handler #:js-skip-semis #:%js-call #:*js-contextual-keyword-token-types*)) +(defpackage #:cl-cc/javascript/syntax (:use #:cl) (:import-from #:cl-cc/ast #:ast-let-bindings #:ast-let-body #:ast-let-declarations #:ast-let-p #:make-ast-block #:make-ast-call #:make-ast-let #:make-ast-var) (:export #:%js-callable-body #:%js-consume-then #:%js-finish-let-bindings #:%js-lex-hash-token #:%js-lex-slash-token #:%js-lex-string-escape-char #:*js-keywords* #:*js-operator-tokens* #:*js-parse-depth* #:*js-gdi-global-reference-mode* #:*js-gdi-shadowed-names* #:*js-gdi-global-lexical-names* #:*js-gdi-global-var-names* #:+js-max-operator-length+ #:define-builder-table #:js-alnum-p #:js-alpha-p #:js-at-eof-p #:js-at-op-p #:js-consume #:js-digit-p #:js-expect #:js-hex-digit-p #:js-id-continue-p #:js-id-start-p #:js-ident-sym #:js-peek #:js-peek-type #:js-peek-value #:js-regex-follows-p #:js-tok-type #:js-tok-value #:js-whitespace-p #:lex-js-identifier #:lex-js-operator #:lex-js-private-ident #:lex-js-string #:make-js-token #:parse-js-module #:parse-js-source #:skip-js-block-comment #:skip-js-line-comment #:skip-js-whitespace-and-comments #:tokenize-js-source #:with-js-parse-depth #:js-lexer-extension-handler #:js-call-lexer-extension #:register-js-lexer-extension #:js-parse-source-tokens #:register-js-source-parser #:register-js-parser-handler #:js-parser-handler #:js-call-parser-handler #:js-skip-semis #:%js-call #:*js-contextual-keyword-token-types*)) diff --git a/src/syntax/parser.lisp b/src/syntax/parser.lisp index e351aa6..39f01f6 100644 --- a/src/syntax/parser.lisp +++ b/src/syntax/parser.lisp @@ -14,11 +14,9 @@ ;;;; parser-expr.lisp, parser-class.lisp, and parser-module.lisp. Binding- ;;;; pattern parsing lives in parser-stmt-binding.lisp ;;;; (%js-parse-binding-pattern and friends). - (in-package #:cl-cc/javascript/syntax) ;;; ─── Token Accessors ──────────────────────────────────────────────────────── - (defun js-tok-type (tok) "Return the :type field of a token plist." (getf tok :type)) @@ -28,18 +26,19 @@ (getf tok :value)) ;;; ─── Stream Peek / Consume ────────────────────────────────────────────────── - (defun js-peek (stream) "Return the first token of STREAM without consuming it, or NIL if empty." (car stream)) (defun js-peek-type (stream) "Return the :type of the first token in STREAM, or NIL if STREAM is empty." - (when stream (getf (car stream) :type))) + (when stream + (getf (car stream) :type))) (defun js-peek-value (stream) "Return the :value of the first token in STREAM, or NIL if STREAM is empty." - (when stream (getf (car stream) :value))) + (when stream + (getf (car stream) :value))) (defun js-at-op-p (stream op) "True when the first token in STREAM is the operator token spelled OP. @@ -47,15 +46,13 @@ An operator is two facts about one token — type :T-OP and a particular spelling — and every caller that cares needs both, so testing them separately is a conjunction repeated at each site rather than one question asked once." - (and (eq (js-peek-type stream) :T-OP) - (string= (js-peek-value stream) op))) + (and (eq (js-peek-type stream) :T-OP) (string= (js-peek-value stream) op))) (defun js-consume (stream) "Return (values first-token rest-of-stream). Does not error on empty stream." (values (car stream) (cdr stream))) ;;; ─── Expect / Try-consume ─────────────────────────────────────────────────── - (defun js-expect (type stream &optional value) "Consume a token of TYPE (optionally matching VALUE) from STREAM. Returns (values token rest-stream). Signals an error on mismatch." @@ -63,8 +60,7 @@ Returns (values token rest-stream). Signals an error on mismatch." (eq (js-peek-type stream) type) (or (null value) (equal (js-peek-value stream) value))) (js-consume stream) - (error "JS parse error: expected ~S~@[ ~S~] but got ~S" - type value (js-peek stream)))) + (error "JS parse error: expected ~S~@[ ~S~] but got ~S" type value (js-peek stream)))) (defun js-at-eof-p (stream) "Return T when STREAM is exhausted or its first token is :T-EOF." @@ -88,11 +84,21 @@ no further use for the token value itself." ;;; bound, so pathologically nested input (e.g. "((((((…))))))" or "[[[[…]]]]") ;;; could exhaust the control stack (CWE-674 DoS) when parsing untrusted source. ;;; with-js-parse-depth bounds the recursion and errors gracefully instead. - -(defvar *js-parse-depth* 0 - "Current expression/statement recursion depth during parsing.") - -(defparameter *js-max-parse-depth* 2500 +(progn + (defvar *js-gdi-global-reference-mode* + nil) + (defvar *js-gdi-shadowed-names* + nil) + (defvar *js-gdi-global-lexical-names* + nil) + (defvar *js-gdi-global-var-names* + nil) + (defvar *js-parse-depth* + 0 + "Current expression/statement recursion depth during parsing.")) + +(defparameter *js-max-parse-depth* + 2500 "Maximum expression/statement nesting depth before a graceful parse error.") (defmacro with-js-parse-depth (&body body) @@ -113,25 +119,25 @@ by the expression side (parser-expr-primary.lisp) and the binding-pattern side (parser-stmt-binding.lisp) so the two can't silently drift apart.") ;;; ─── Name Helpers ─────────────────────────────────────────────────────────── - (defun js-ident-sym (str) "Convert a JS identifier string STR to an interned CL symbol in :cl-cc/javascript. Accepts both strings and symbols. Preserves CASE — JavaScript is case-sensitive, so `a'/`A', `foo'/`Foo', and a lowercase instance var vs its Class name must be distinct symbols. Must stay in sync with %js-binding-sym (binding side) and the parser-class.lisp copy." - (intern (if (stringp str) str (symbol-name str)) - :cl-cc/javascript)) + (intern + (if (stringp str) + str + (symbol-name str)) + :cl-cc/javascript)) ;;; ─── Forward Reference Declarations ──────────────────────────────────────── - (declaim (ftype (function (t) (values list t)) js-parse-source-tokens)) ;;; ─── Top-Level Entry Points ───────────────────────────────────────────────── ;;; ;;; The actual statement-parsing work is delegated to %js-parse-all-stmts, ;;; which is implemented in parser-stmt.lisp (loaded after this file). - (defun parse-js-source (source) "Parse a JavaScript SOURCE string and return a list of top-level AST nodes." (let ((tokens (tokenize-js-source source))) @@ -192,5 +198,4 @@ function'. A NIL/empty body passes through unchanged." (defun %js-call (name &rest args) "Build an AST call to a JS runtime helper NAME with ARGS." - (make-ast-call :func (make-ast-var :name name) - :args args)) + (make-ast-call :func (make-ast-var :name name) :args args)) diff --git a/t/backend/gdi-instantiation-execution-test.lisp b/t/backend/gdi-instantiation-execution-test.lisp new file mode 100644 index 0000000..5e45c9c --- /dev/null +++ b/t/backend/gdi-instantiation-execution-test.lisp @@ -0,0 +1,443 @@ +(in-package #:cl-cc/javascript/backend/test) + +(defun %register-backend-gdi-instantiation-tests () + + (it-sequential "js-gdi-own-property-descriptors-include-sidecar-only-properties" + (let ((object (%js-make-object))) + (%js-object-define-property + object "sidecarOnly" (%js-make-object "enumerable" nil)) + (let* ((descriptors + (cl-cc/javascript/proxies:%js-object-get-own-property-descriptors + object)) + (descriptor (%js-get-prop descriptors "sidecarOnly"))) + (expect (not (eq descriptor +js-undefined+)) :to-be-truthy) + (expect (%js-get-prop descriptor "value") :to-equal +js-undefined+) + (expect (%js-get-prop descriptor "enumerable") :to-equal nil) + (expect (%js-get-prop descriptor "configurable") :to-equal nil)))) + ;; Test262: test/language/global-code/decl-func.js + (it-sequential "js-gdi-last-function-declaration-wins" + (let* ((forms + (cl-cc/javascript:parse-js-source + "function selected(){return 1;} function selected(value){return value;}")) + (selected + (cl-cc/javascript/backend::%js-gdi-selected-functions forms))) + (expect (length selected) :to-equal 1) + (expect (length (cl-cc/ast:ast-defun-params (first selected))) + :to-equal 1))) + ;; Test262: test/language/global-code/decl-func.js + (it-sequential "js-gdi-function-order-and-existing-global-property-deletion" + (let* ((forms + (cl-cc/javascript:parse-js-source + "function first(){return 1;} function second(){return 2;}")) + (selected + (cl-cc/javascript/backend::%js-gdi-selected-functions forms))) + (expect (mapcar (lambda (function) + (symbol-name (cl-cc/ast:ast-defun-name function))) + selected) + :to-equal (list "first" "second"))) + (let* ((state (%js-gdi-test-state)) + (name (%js-gdi-test-name "preexistingGlobal"))) + (let ((cl-cc/vm:*vm-state* state)) + (setf (gethash name (cl-cc/vm:vm-global-vars state)) 97) + (let ((global (cl-cc/javascript/backend::%js-gdi-global-object))) + (%js-object-define-property + global "preexistingGlobal" + (%js-make-object "value" 97 "writable" t "enumerable" t "configurable" t)) + (cl-cc/javascript/backend::%js-gdi-prepare nil nil (list name)) + (cl-cc/javascript/backend::%js-gdi-create-global-vars (list name) nil) + (expect (cl-cc/javascript/backend::%js-gdi-global-read name) :to-equal 97) + (expect (cl-cc/javascript/objects:%js-delete global "preexistingGlobal") :to-equal t) + (expect (cl-cc/javascript/backend::%js-gdi-global-typeof name) :to-equal "undefined") + (expect + (%js-gdi-test-error-p + (lambda () (cl-cc/javascript/backend::%js-gdi-global-read name)) + "ReferenceError") + :to-be-truthy) + (expect (nth-value 1 (gethash name (cl-cc/vm:vm-global-vars state))) + :to-equal nil))))) + ;; Test262: test/language/global-code/decl-var.js + (it-sequential "js-gdi-var-collector-recurses-blocks-but-stops-at-functions" + (let* ((forms + (cl-cc/javascript:parse-js-source + "if(true){var visibleVar;} function nested(){var hiddenVar;}")) + (names + (mapcar (function symbol-name) + (cl-cc/javascript/backend::%js-gdi-var-names forms)))) + (expect names :to-equal (list "visibleVar")))) + ;; Test262: test/language/global-code/script-decl-lex.js + (it-sequential "js-gdi-global-lexical-collector-respects-scope-boundaries" + (let ((source + (concatenate 'string + "let lexicalName=1; const constantName=2; " + "function nested(){let localName=3;} " + "if(true){let blockName=4;} " + "for(let loopName=0;loopName<1;loopName++){} " + "switch(1){case 1:let caseName=1;} " + "class Declared{}"))) + (let ((cl-cc/javascript/statements:*js-gdi-mode* t) + (cl-cc/javascript/statements:*js-gdi-function-depth* 0) + (cl-cc/javascript/statements:*js-gdi-lexical-scope-depth* 0) + (cl-cc/javascript/statements:*js-gdi-collect-global-lexical-bindings* t) + (cl-cc/javascript/statements:*js-gdi-global-lexical-bindings* nil) + (cl-cc/javascript/syntax:*js-gdi-global-reference-mode* nil)) + (cl-cc/javascript:parse-js-source source) + (let* ((bindings + (nreverse cl-cc/javascript/statements:*js-gdi-global-lexical-bindings*)) + (names (mapcar (lambda (binding) (symbol-name (car binding))) bindings)) + (kinds (mapcar (function cdr) bindings))) + (expect names :to-equal (list "lexicalName" "constantName" "Declared")) + (expect kinds :to-equal (list :let :const :class)))))) + ;; Test262: test/language/global-code/decl-func.js + (it-sequential "js-gdi-script-form-builder-includes-declarations" + (let* ((forms + (cl-cc/javascript/backend:js-program-forms + "var lifted=1; let lexical=2; function selected(value){return value;}")) + (functions (remove-if-not (function cl-cc/ast:ast-defun-p) forms))) + (expect forms :to-be-truthy) + (expect (mapcar (function cl-cc/ast:ast-defun-name) functions) + :to-equal (list (%js-gdi-test-name "selected"))) + (expect (some (function cl-cc/ast:ast-defvar-p) forms) + :to-be-truthy))) + ;; Test262: test/language/global-code/decl-var.js + ;; Test262 algorithm analogue: test/language/global-code/decl-var.js + (it-sequential "js-gdi-var-preserves-restricted-global-values" + (let* ((state (%js-gdi-test-state)) + (undefined-name (%js-gdi-test-name "undefined")) + (infinity-name (%js-gdi-test-name "Infinity")) + (nan-name (%js-gdi-test-name "NaN"))) + (let ((cl-cc/vm:*vm-state* state)) + (let ((global (cl-cc/javascript/backend::%js-gdi-global-object))) + (%js-object-define-property + global "undefined" + (%js-make-object "value" +js-undefined+ + "writable" nil "enumerable" nil "configurable" nil)) + (%js-object-define-property + global "Infinity" + (%js-make-object "value" cl-cc/javascript/objects:*js-inf-float* + "writable" nil "enumerable" nil "configurable" nil)) + (%js-object-define-property + global "NaN" + (%js-make-object "value" cl-cc/javascript/objects:*js-nan-float* + "writable" nil "enumerable" nil "configurable" nil)) + (cl-cc/javascript/backend::%js-gdi-prepare + nil nil (list undefined-name infinity-name nan-name)) + (cl-cc/javascript/backend::%js-gdi-create-global-vars + (list undefined-name infinity-name nan-name) nil) + (expect (eq (cl-cc/javascript/backend::%js-gdi-global-read undefined-name) + +js-undefined+) + :to-be-truthy) + (expect (= (cl-cc/javascript/backend::%js-gdi-global-read infinity-name) + cl-cc/javascript/objects:*js-inf-float*) + :to-be-truthy) + (expect (cl-cc/javascript/objects:%js-float-nan-p + (cl-cc/javascript/backend::%js-gdi-global-read nan-name)) + :to-be-truthy) + (dolist (name (list undefined-name infinity-name nan-name)) + (let ((descriptor + (%js-object-get-own-property-descriptor global (symbol-name name)))) + (expect (%js-get-prop descriptor "writable") :to-equal nil) + (expect (%js-get-prop descriptor "enumerable") :to-equal nil) + (expect (%js-get-prop descriptor "configurable") :to-equal nil))))))) + ;; Test262: test/language/global-code/decl-func.js + ;; Test262 algorithm analogue: test/language/global-code/decl-func.js + (it-sequential "js-gdi-function-declarations-reject-restricted-prelude-globals" + (let* ((state (%js-gdi-test-state)) + (restricted-names + (list (%js-gdi-test-name "undefined") + (%js-gdi-test-name "Infinity") + (%js-gdi-test-name "NaN"))) + (case-varied-names + (list (%js-gdi-test-name "Undefined") + (%js-gdi-test-name "infinity") + (%js-gdi-test-name "nan")))) + (let ((cl-cc/vm:*vm-state* state)) + (dolist (name restricted-names) + (expect (%js-gdi-test-error-p + (lambda () + (cl-cc/javascript/backend::%js-gdi-prepare + nil (list name) nil)) + "TypeError") + :to-be-truthy)) + (expect (cl-cc/javascript/backend::%js-gdi-prepare + nil case-varied-names nil) + :to-equal +js-undefined+)))) + ;; Related Test262 cases: test/language/statements/class/scope-name-lex-open-heritage.js and test/language/statements/class/scope-name-lex-open-no-heritage.js. + (it-sequential "js-gdi-class-heritage-and-named-expression-shadowing" + (labels ((descendants (node) + (cons node + (mapcan (function descendants) + (cl-cc/ast:ast-children node)))) + (named-defclass (name forms) + (find-if + (lambda (node) + (and (cl-cc/ast:ast-defclass-p node) + (eq (cl-cc/ast:ast-defclass-name node) name))) + (mapcan (function descendants) forms))) + (gdi-global-read-for-name-p (nodes name) + (some + (lambda (node) + (and (cl-cc/ast:ast-call-p node) + (cl-cc/ast:ast-var-p + (cl-cc/ast:ast-call-func node)) + (string= "%JS-GDI-GLOBAL-READ" + (symbol-name + (cl-cc/ast:ast-var-name + (cl-cc/ast:ast-call-func node)))) + (let ((argument + (first (cl-cc/ast:ast-call-args node)))) + (and (cl-cc/ast:ast-quote-p argument) + (eq (cl-cc/ast:ast-quote-value argument) + name))))) + nodes)) + (ast-var-for-name-p (nodes name) + (some + (lambda (node) + (and (cl-cc/ast:ast-var-p node) + (eq (cl-cc/ast:ast-var-name node) name))) + nodes))) + (let* ((child-name (%js-gdi-test-name "Child")) + (base-name (%js-gdi-test-name "Base")) + (forms + (cl-cc/javascript/backend:js-program-forms + "class Child extends Base {}")) + (child (named-defclass child-name forms))) + (expect child :to-be-truthy) + (when child + (expect (member base-name + (cl-cc/ast:ast-defclass-superclasses child) + :test (function eq)) + :to-be-truthy) + (let ((metaclass (cl-cc/ast:ast-defclass-metaclass child))) + (expect metaclass :to-be-truthy) + (when metaclass + (expect (gdi-global-read-for-name-p + (descendants metaclass) base-name) + :to-be-truthy))))) + (let* ((inner-name (%js-gdi-test-name "Inner")) + (forms + (cl-cc/javascript/backend:js-program-forms + "const C = class Inner extends Inner { method() { return Inner; } };")) + (inner (named-defclass inner-name forms))) + (expect inner :to-be-truthy) + (when inner + (let* ((heritage + (first + (cl-cc/ast:ast-call-args + (cl-cc/ast:ast-defclass-metaclass inner)))) + (heritage-nodes (descendants heritage)) + (method-nodes + (mapcan (lambda (slot) + (let ((initform (cl-cc/ast:ast-slot-initform slot))) + (when initform (descendants initform)))) + (cl-cc/ast:ast-defclass-slots inner)))) + (expect (cl-cc/ast:ast-var-p heritage) :to-be-truthy) + (when (cl-cc/ast:ast-var-p heritage) + (expect (eq (cl-cc/ast:ast-var-name heritage) inner-name) :to-be-truthy)) + (expect (not (gdi-global-read-for-name-p heritage-nodes inner-name)) + :to-be-truthy) + (expect (ast-var-for-name-p method-nodes inner-name) :to-be-truthy) + (expect (not (gdi-global-read-for-name-p method-nodes inner-name)) + :to-be-truthy)))))) + ;; Related Test262 case: test/language/expressions/arrow-function/dflt-params-ref-later.js. + (it-sequential "js-gdi-arrow-later-parameter-default-remains-local" + (labels ((descendants (node) + (cons node + (mapcan (function descendants) + (cl-cc/ast:ast-children node)))) + (global-read-for-name-p (nodes name) + (some (lambda (node) + (and (cl-cc/ast:ast-call-p node) + (cl-cc/ast:ast-var-p (cl-cc/ast:ast-call-func node)) + (string= "%JS-GDI-GLOBAL-READ" + (symbol-name + (cl-cc/ast:ast-var-name + (cl-cc/ast:ast-call-func node)))) + (let ((argument + (first (cl-cc/ast:ast-call-args node)))) + (and (cl-cc/ast:ast-quote-p argument) + (eq (cl-cc/ast:ast-quote-value argument) + name))))) + nodes)) + (var-ref-for-name-p (nodes name) + (some (lambda (node) + (and (cl-cc/ast:ast-var-p node) + (eq (cl-cc/ast:ast-var-name node) name))) + nodes))) + (let* ((a (%js-gdi-test-name "a")) + (b (%js-gdi-test-name "b")) + (forms + (cl-cc/javascript/backend:js-program-forms + "const f=(a=b,b=1)=>a;")) + (arrow-lambda + (find-if (lambda (node) + (and (cl-cc/ast:ast-lambda-p node) + (equal + (mapcar (function first) + (cl-cc/ast:ast-lambda-optional-params node)) + (list a b)))) + (mapcan (function descendants) forms)))) + (expect arrow-lambda :to-be-truthy) + (when arrow-lambda + (let* ((optionals + (cl-cc/ast:ast-lambda-optional-params arrow-lambda)) + (a-default (second (assoc a optionals :test (function eq)))) + (b-default (second (assoc b optionals :test (function eq)))) + (lambda-nodes (descendants arrow-lambda)) + (body-nodes + (mapcan (function descendants) + (cl-cc/ast:ast-lambda-body arrow-lambda)))) + (expect (and (cl-cc/ast:ast-var-p a-default) + (eq (cl-cc/ast:ast-var-name a-default) b)) + :to-be-truthy) + (expect (cl-cc/ast:ast-int-p b-default) :to-be-truthy) + (expect (var-ref-for-name-p body-nodes a) :to-be-truthy) + (expect (not (global-read-for-name-p lambda-nodes a)) + :to-be-truthy) + (expect (not (global-read-for-name-p lambda-nodes b)) + :to-be-truthy)))))) + ;; Related Test262 cases: test/language/statements/function/scope-paramsbody-var-close.js and test/language/statements/try/scope-catch-block-var-none.js. + (it-sequential "js-gdi-function-local-try-var-remains-local" + (labels ((descendants (node) + (cons node + (mapcan (function descendants) + (cl-cc/ast:ast-children node)))) + (global-read-for-name-p (nodes name) + (some + (lambda (node) + (and (cl-cc/ast:ast-call-p node) + (cl-cc/ast:ast-var-p + (cl-cc/ast:ast-call-func node)) + (string= "%JS-GDI-GLOBAL-READ" + (symbol-name + (cl-cc/ast:ast-var-name + (cl-cc/ast:ast-call-func node)))) + (let ((argument + (first (cl-cc/ast:ast-call-args node)))) + (and (cl-cc/ast:ast-quote-p argument) + (eq (cl-cc/ast:ast-quote-value argument) + name))))) + nodes)) + (var-ref-for-name-p (nodes name) + (some + (lambda (node) + (and (cl-cc/ast:ast-var-p node) + (eq (cl-cc/ast:ast-var-name node) name))) + nodes))) + (let* ((local-name (%js-gdi-test-name "localTryVar")) + (forms + (cl-cc/javascript/backend:js-program-forms + "function container(){try { var localTryVar=1; } finally {} return localTryVar;}")) + (function-node + (find-if + (lambda (node) + (and (cl-cc/ast:ast-defun-p node) + (eq (cl-cc/ast:ast-defun-name node) + (%js-gdi-test-name "container")))) + (mapcan (function descendants) forms)))) (expect function-node :to-be-truthy) (when function-node + (let ((function-nodes (descendants function-node))) + (expect (var-ref-for-name-p function-nodes local-name) + :to-be-truthy) + (expect (not (global-read-for-name-p function-nodes local-name)) + :to-be-truthy)))))) + ;; Related Test262 cases: test/language/statements/switch/scope-lex-open-case.js and test/language/statements/switch/scope-lex-close-case.js. + (it-sequential "js-gdi-switch-case-lexical-references-remain-local" + (labels ((descendants (node) + (cons node + (mapcan (function descendants) + (cl-cc/ast:ast-children node)))) + (global-read-for-name-p (nodes name) + (some + (lambda (node) + (and (cl-cc/ast:ast-call-p node) + (cl-cc/ast:ast-var-p + (cl-cc/ast:ast-call-func node)) + (string= "%JS-GDI-GLOBAL-READ" + (symbol-name + (cl-cc/ast:ast-var-name + (cl-cc/ast:ast-call-func node)))) + (let ((argument + (first (cl-cc/ast:ast-call-args node)))) + (and (cl-cc/ast:ast-quote-p argument) + (eq (cl-cc/ast:ast-quote-value argument) name))))) + nodes)) + (var-ref-for-name-p (nodes name) + (some + (lambda (node) + (and (cl-cc/ast:ast-var-p node) + (eq (cl-cc/ast:ast-var-name node) name))) + nodes))) + (let* ((case-name (%js-gdi-test-name "caseLocal")) + (forms + (cl-cc/javascript/backend:js-program-forms + "switch(1){case 1:let caseLocal=1;break;case 2:caseLocal;}")) + (nodes (mapcan (function descendants) forms))) + (expect (var-ref-for-name-p nodes case-name) :to-be-truthy) + (expect (not (global-read-for-name-p nodes case-name)) + :to-be-truthy)))) + ;; Related Test262 case: test/language/global-code/decl-func.js. + (it-sequential "js-gdi-top-level-function-self-reference-is-global" + (labels ((descendants (node) + (cons node + (mapcan (function descendants) + (cl-cc/ast:ast-children node)))) + (global-read-for-name-p (nodes name) + (some + (lambda (node) + (and (cl-cc/ast:ast-call-p node) + (cl-cc/ast:ast-var-p + (cl-cc/ast:ast-call-func node)) + (string= "%JS-GDI-GLOBAL-READ" + (symbol-name + (cl-cc/ast:ast-var-name + (cl-cc/ast:ast-call-func node)))) + (let ((argument + (first (cl-cc/ast:ast-call-args node)))) + (and (cl-cc/ast:ast-quote-p argument) + (eq (cl-cc/ast:ast-quote-value argument) + name))))) + nodes)) + (var-reference-for-name-p (nodes name) + (some + (lambda (node) + (and (cl-cc/ast:ast-var-p node) + (eq (cl-cc/ast:ast-var-name node) name))) + nodes))) + (let* ((global-name (%js-gdi-test-name "globalFunction")) + (global-forms + (cl-cc/javascript/backend:js-program-forms + "function globalFunction(){return globalFunction;}")) + (global-function + (find-if + (lambda (node) + (and (cl-cc/ast:ast-defun-p node) + (eq (cl-cc/ast:ast-defun-name node) global-name))) + (mapcan (function descendants) global-forms)))) + (expect global-function :to-be-truthy) + (when global-function + (expect + (global-read-for-name-p + (mapcan (function descendants) + (cl-cc/ast:ast-defun-body global-function)) + global-name) + :to-be-truthy))) + (let* ((inner-name (%js-gdi-test-name "innerFunction")) + (nested-forms + (cl-cc/javascript/backend:js-program-forms + (concatenate 'string + "function outerFunction(){" + "function innerFunction(){return innerFunction;}}"))) + (inner-function + (find-if + (lambda (node) + (and (cl-cc/ast:ast-defun-p node) + (eq (cl-cc/ast:ast-defun-name node) inner-name))) + (mapcan (function descendants) nested-forms)))) + (expect inner-function :to-be-truthy) + (when inner-function + (let ((inner-body-nodes + (mapcan (function descendants) + (cl-cc/ast:ast-defun-body inner-function)))) + (expect (var-reference-for-name-p inner-body-nodes inner-name) + :to-be-truthy) + (expect (not (global-read-for-name-p inner-body-nodes inner-name)) + :to-be-truthy))))))) diff --git a/t/backend/gdi-instantiation-test.lisp b/t/backend/gdi-instantiation-test.lisp new file mode 100644 index 0000000..7e63f53 --- /dev/null +++ b/t/backend/gdi-instantiation-test.lisp @@ -0,0 +1,500 @@ +(in-package #:cl-cc/javascript/backend/test) +(defun %js-gdi-test-state () + (let ((state (cl-cc/vm:make-vm-state))) + (cl-cc/javascript/backend:%seed-js-globals state) + (setf (gethash (cl-cc/javascript/syntax:js-ident-sym "globalThis") + (cl-cc/vm:vm-global-vars state)) (%js-make-object)) + state)) + +(defun %js-gdi-test-name (name) + (cl-cc/javascript/syntax:js-ident-sym name)) + +(defun %js-gdi-test-error-p (thunk expected-name) + (handler-case (progn + (funcall thunk) + nil) + (cl-cc/javascript/errors:js-exception (condition) + (string= expected-name + (%js-get-prop (cl-cc/javascript/errors:js-exception-value condition) "name"))))) + +(defun %register-backend-gdi-tests () + ;; Test262: test/language/global-code/decl-var.js + (it-sequential "js-gdi-var-creates-nonconfigurable-global-property" + (let* ((state (%js-gdi-test-state)) + (name (%js-gdi-test-name "value"))) + (let ((cl-cc/vm:*vm-state* state)) + (cl-cc/javascript/backend::%js-gdi-prepare nil nil (list name)) + (cl-cc/javascript/backend::%js-gdi-create-global-vars (list name) nil) + (expect (cl-cc/javascript/backend::%js-gdi-global-read name) + :to-equal +js-undefined+) + (cl-cc/javascript/backend::%js-gdi-global-write name 7) + (let* ((global (cl-cc/javascript/backend::%js-gdi-global-object)) + (descriptor (%js-object-get-own-property-descriptor global "value"))) + (expect (%js-get-prop descriptor "value") :to-equal 7) + (expect (%js-get-prop descriptor "writable") :to-equal t) + (expect (%js-get-prop descriptor "enumerable") :to-equal t) + (expect (%js-get-prop descriptor "configurable") :to-equal nil) + (expect (gethash name (cl-cc/vm:vm-global-vars state)) :to-equal 7))))) + ;; Test262: test/language/global-code/decl-var.js + (it-sequential "js-gdi-global-deletion-clears-vm-mirrors" + (let* ((state (%js-gdi-test-state)) + (read-name (%js-gdi-test-name "deletedAssignmentGlobalRead")) + (typeof-name (%js-gdi-test-name "deletedAssignmentGlobalTypeof"))) + (let ((cl-cc/vm:*vm-state* state)) + (let ((global (cl-cc/javascript/backend::%js-gdi-global-object))) + (cl-cc/javascript/backend::%js-gdi-global-write read-name 41) + (expect (gethash read-name (cl-cc/vm:vm-global-vars state)) :to-equal 41) + (expect + (cl-cc/javascript/objects:%js-delete global (symbol-name read-name)) + :to-equal t) + (expect + (%js-gdi-test-error-p + (lambda () (cl-cc/javascript/backend::%js-gdi-global-read read-name)) + "ReferenceError") + :to-be-truthy) + (expect (nth-value 1 (gethash read-name (cl-cc/vm:vm-global-vars state))) + :to-equal nil) + (cl-cc/javascript/backend::%js-gdi-global-write typeof-name 43) + (expect + (cl-cc/javascript/objects:%js-delete global (symbol-name typeof-name)) + :to-equal t) + (expect (cl-cc/javascript/backend::%js-gdi-global-typeof typeof-name) + :to-equal "undefined") + (expect (nth-value 1 (gethash typeof-name (cl-cc/vm:vm-global-vars state))) + :to-equal nil)))) + (let* ((state (%js-gdi-test-state)) + (name (%js-gdi-test-name "console"))) + (let ((cl-cc/vm:*vm-state* state)) + (setf (gethash name (cl-cc/vm:vm-global-vars state)) 97) + (cl-cc/javascript/backend::%js-gdi-initialize-prelude-global-properties + (list name)) + (let ((global (cl-cc/javascript/backend::%js-gdi-global-object))) + (expect (cl-cc/javascript/backend::%js-gdi-global-read name) :to-equal 97) + (expect + (cl-cc/javascript/objects:%js-delete global (symbol-name name)) + :to-equal t) + (expect (cl-cc/javascript/backend::%js-gdi-global-typeof name) + :to-equal "undefined") + (expect + (%js-gdi-test-error-p + (lambda () (cl-cc/javascript/backend::%js-gdi-global-read name)) + "ReferenceError") + :to-be-truthy) + (expect (nth-value 1 (gethash name (cl-cc/vm:vm-global-vars state))) + :to-equal nil) + (setf (gethash name (cl-cc/vm:vm-global-vars state)) 97) + (cl-cc/javascript/backend::%js-gdi-initialize-prelude-global-properties + (list name)) + (expect (cl-cc/javascript/backend::%js-gdi-global-typeof name) + :to-equal "undefined") + (expect + (%js-gdi-test-error-p + (lambda () (cl-cc/javascript/backend::%js-gdi-global-read name)) + "ReferenceError") + :to-be-truthy) + (expect (nth-value 1 (gethash name (cl-cc/vm:vm-global-vars state))) + :to-equal nil)))) + (let* ((state (%js-gdi-test-state)) + (name (%js-gdi-test-name "deletedThenRedeclared"))) + (let ((cl-cc/vm:*vm-state* state)) + (cl-cc/javascript/backend::%js-gdi-global-write name 41) + (let ((global (cl-cc/javascript/backend::%js-gdi-global-object))) + (expect + (cl-cc/javascript/objects:%js-delete global (symbol-name name)) + :to-equal t)) + (expect (gethash name (cl-cc/vm:vm-global-vars state)) :to-equal 41) + (cl-cc/javascript/backend::%js-gdi-prepare nil nil (list name)) + (cl-cc/javascript/backend::%js-gdi-create-global-vars (list name) nil) + (expect (cl-cc/javascript/backend::%js-gdi-global-read name) + :to-equal +js-undefined+) + (expect (cl-cc/javascript/backend::%js-gdi-global-typeof name) + :to-equal "undefined")))) + ;; Sloppy global writes ignore failed property-set operations. + (it-sequential "js-gdi-sloppy-global-writes-fail-silently" + (let* ((state (%js-gdi-test-state)) + (locked-name (%js-gdi-test-name "locked")) + (new-name (%js-gdi-test-name "createdByAssignment"))) + (let ((cl-cc/vm:*vm-state* state)) + (let ((global (cl-cc/javascript/backend::%js-gdi-global-object))) + (%js-object-define-property + global "locked" + (%js-make-object "value" 11 "writable" nil + "enumerable" t "configurable" t)) + (expect (cl-cc/javascript/backend::%js-gdi-global-write + locked-name 12) + :to-equal 12) + (expect (cl-cc/javascript/backend::%js-gdi-global-read locked-name) + :to-equal 11) + (expect (cl-cc/javascript/backend::%js-gdi-global-write new-name 5) + :to-equal 5) + (expect (cl-cc/javascript/backend::%js-gdi-global-read new-name) + :to-equal 5) + (let ((descriptor + (%js-object-get-own-property-descriptor + global "createdByAssignment"))) + (expect (%js-get-prop descriptor "writable") :to-equal t) + (expect (%js-get-prop descriptor "enumerable") :to-equal t) + (expect (%js-get-prop descriptor "configurable") :to-equal t)))))) + ;; Test262: test/language/global-code/decl-var.js + (it-sequential "js-gdi-var-no-initializer-preserves-existing-value" + (labels ((descendants (node) + (cons node + (mapcan (function descendants) + (cl-cc/ast:ast-children node)))) + (global-write-for-name-p (forms name) + (some + (lambda (node) + (and (cl-cc/ast:ast-call-p node) + (cl-cc/ast:ast-var-p + (cl-cc/ast:ast-call-func node)) + (string= "%JS-GDI-GLOBAL-WRITE" + (symbol-name + (cl-cc/ast:ast-var-name + (cl-cc/ast:ast-call-func node)))) + (let ((argument + (first (cl-cc/ast:ast-call-args node)))) + (and (cl-cc/ast:ast-quote-p argument) + (eq (cl-cc/ast:ast-quote-value argument) name))))) + (mapcan (function descendants) forms)))) + (let* ((state (%js-gdi-test-state)) + (name (%js-gdi-test-name "persistent")) + (no-initializer + (cl-cc/javascript/backend:js-program-forms "var persistent;")) + (explicit-undefined + (cl-cc/javascript/backend:js-program-forms + "var persistent = undefined;"))) + (let ((cl-cc/vm:*vm-state* state)) + (cl-cc/javascript/backend::%js-gdi-prepare nil nil (list name)) + (cl-cc/javascript/backend::%js-gdi-create-global-vars (list name) nil) + (cl-cc/javascript/backend::%js-gdi-global-write name 17) + (cl-cc/javascript/backend::%js-gdi-prepare nil nil (list name)) + (cl-cc/javascript/backend::%js-gdi-create-global-vars (list name) nil) + (expect (cl-cc/javascript/backend::%js-gdi-global-read name) + :to-equal 17) + (expect (not (global-write-for-name-p no-initializer name)) + :to-be-truthy) + (expect (global-write-for-name-p explicit-undefined name) + :to-be-truthy) + (cl-cc/javascript/backend::%js-gdi-global-write + name +js-undefined+) + (expect (eq (cl-cc/javascript/backend::%js-gdi-global-read name) + +js-undefined+) + :to-be-truthy))))) + ;; Test262: test/language/global-code/decl-var.js + (it-sequential "js-gdi-var-name-blocks-later-global-lexical-declaration" + (let* ((state (%js-gdi-test-state)) + (name (%js-gdi-test-name "Math"))) + (let ((cl-cc/vm:*vm-state* state)) + (let* ((global (cl-cc/javascript/backend::%js-gdi-global-object)) + (value (%js-make-object))) + (%js-object-define-property + global "Math" + (%js-make-object "value" value "writable" t + "enumerable" nil "configurable" t)) + (setf (gethash name (cl-cc/vm:vm-global-vars state)) value) + (cl-cc/javascript/backend::%js-gdi-prepare nil nil (list name)) + (cl-cc/javascript/backend::%js-gdi-create-global-vars (list name) nil) + (expect (cl-cc/javascript/backend::%js-gdi-global-var-declared-p name) + :to-be-truthy) + (expect (eq (cl-cc/javascript/backend::%js-gdi-global-read name) value) + :to-be-truthy) + (expect + (%js-gdi-test-error-p + (lambda () + (cl-cc/javascript/backend::%js-gdi-prepare + (list (cons name :let)) nil nil)) + "SyntaxError") + :to-be-truthy) + (expect (gethash name + (cl-cc/javascript/backend::%js-gdi-lexical-environment nil)) + :to-equal nil))))) + ;; Test262: test/language/global-code/script-decl-lex.js + (it-sequential "js-gdi-global-lexical-tdz-and-const-immutability" + (let* ((state (%js-gdi-test-state)) + (name (%js-gdi-test-name "fixed"))) + (let ((cl-cc/vm:*vm-state* state)) + (cl-cc/javascript/backend::%js-gdi-prepare + (list (cons name :const)) nil nil) + (expect (eq (%js-object-get-own-property-descriptor + (cl-cc/javascript/backend::%js-gdi-global-object) + "fixed") + +js-undefined+) + :to-be-truthy) + (expect (%js-gdi-test-error-p + (lambda () + (cl-cc/javascript/backend::%js-gdi-global-read name)) + "ReferenceError") + :to-be-truthy) + (cl-cc/javascript/backend::%js-gdi-initialize-lexical name 2) + (expect (cl-cc/javascript/backend::%js-gdi-global-read name) + :to-equal 2) + (expect (%js-gdi-test-error-p + (lambda () + (cl-cc/javascript/backend::%js-gdi-global-write name 3)) + "TypeError") + :to-be-truthy)))) + ;; Test262: test/language/global-code/script-decl-lex.js + (it-sequential "js-gdi-rejects-lexical-shadowing-of-restricted-prelude-globals" + (let ((state (%js-gdi-test-state))) + (let ((cl-cc/vm:*vm-state* state)) + (dolist (name (list (%js-gdi-test-name "undefined") + (%js-gdi-test-name "Infinity") + (%js-gdi-test-name "NaN"))) + (expect (%js-gdi-test-error-p + (lambda () + (cl-cc/javascript/backend::%js-gdi-prepare + (list (cons name :let)) nil nil)) + "SyntaxError") + :to-be-truthy)) + (expect (cl-cc/javascript/backend::%js-gdi-prepare + (list (cons (%js-gdi-test-name "Undefined") :let) + (cons (%js-gdi-test-name "infinity") :let) + (cons (%js-gdi-test-name "nan") :let)) + nil nil) + :to-equal +js-undefined+)))) + ;; Test262: test/language/global-code/script-decl-lex.js + (it-sequential "js-gdi-global-lexical-persists-across-scripts" + (let* ((state (%js-gdi-test-state)) + (name (%js-gdi-test-name "crossScript")) + (global-name (%js-gdi-test-name "globalThis")) + (new-var (%js-gdi-test-name "afterGlobalThisWrite")) + (replacement (%js-make-object))) + (let ((cl-cc/vm:*vm-state* state)) + (cl-cc/javascript/backend::%js-gdi-prepare + (list (cons name :let)) nil nil) + (cl-cc/javascript/backend::%js-gdi-initialize-lexical name 1) + (let ((global (cl-cc/javascript/backend::%js-gdi-global-object))) + (setf (gethash global-name (cl-cc/vm:vm-global-vars state)) + replacement) + (expect (eq (cl-cc/javascript/backend::%js-gdi-global-object) + global) + :to-be-truthy) + (cl-cc/javascript/backend::%js-gdi-prepare nil nil (list new-var)) + (cl-cc/javascript/backend::%js-gdi-create-global-vars + (list new-var) nil) + (expect (not (eq (%js-object-get-own-property-descriptor + global "afterGlobalThisWrite") + +js-undefined+)) + :to-be-truthy) + (expect (eq (%js-object-get-own-property-descriptor + replacement "afterGlobalThisWrite") + +js-undefined+) + :to-be-truthy)) + (cl-cc/javascript/backend::%js-gdi-prepare nil nil nil) + (expect (cl-cc/javascript/backend::%js-gdi-global-read name) + :to-equal 1) + (cl-cc/javascript/backend::%js-gdi-global-write name 2) + (expect (cl-cc/javascript/backend::%js-gdi-global-read name) + :to-equal 2)))) + ;; Test262: test/language/global-code/script-decl-lex-var.js + (it-sequential "js-gdi-preflight-rejects-duplicate-and-cross-script-conflicts" + (let* ((state (%js-gdi-test-state)) + (name (%js-gdi-test-name "priorLexical")) + (duplicate (%js-gdi-test-name "duplicateLexical"))) + (let ((cl-cc/vm:*vm-state* state)) + (cl-cc/javascript/backend::%js-gdi-prepare + (list (cons name :let)) nil nil) + (expect (%js-gdi-test-error-p + (lambda () + (cl-cc/javascript/backend::%js-gdi-prepare + nil nil (list name))) + "SyntaxError") + :to-be-truthy) + (expect (%js-gdi-test-error-p + (lambda () + (cl-cc/javascript/backend::%js-gdi-prepare + (list (cons duplicate :let) + (cons duplicate :const)) + nil nil)) + "SyntaxError") + :to-be-truthy) + (expect (gethash duplicate + (cl-cc/javascript/backend::%js-gdi-lexical-environment nil)) + :to-equal nil) + (expect (%js-gdi-test-error-p + (lambda () + (cl-cc/javascript/backend::%js-gdi-prepare + (list (cons duplicate :let)) nil (list duplicate))) + "SyntaxError") + :to-be-truthy)))) + ;; Test262: test/language/global-code/script-decl-lex-restricted-global.js and test/language/global-code/decl-func.js + (it-sequential "js-gdi-restricted-global-properties" + (let* ((state (%js-gdi-test-state)) + (global nil) + (lexical-name (%js-gdi-test-name "restrictedLexical")) + (function-name (%js-gdi-test-name "blockedFunction")) + (allowed-name (%js-gdi-test-name "allowedFunction")) + (function (%js-make-object))) + (let ((cl-cc/vm:*vm-state* state)) + (setf global (cl-cc/javascript/backend::%js-gdi-global-object)) + (%js-object-define-property + global "restrictedLexical" + (%js-make-object "value" 1 "configurable" nil)) + (%js-object-define-property + global "blockedFunction" + (%js-make-object "value" 1 "writable" nil + "enumerable" nil "configurable" nil)) + (%js-object-define-property + global "allowedFunction" + (%js-make-object "value" 1 "writable" t + "enumerable" t "configurable" nil)) + (expect (%js-gdi-test-error-p + (lambda () + (cl-cc/javascript/backend::%js-gdi-prepare + (list (cons lexical-name :let)) nil nil)) + "SyntaxError") + :to-be-truthy) + (expect (%js-gdi-test-error-p + (lambda () + (cl-cc/javascript/backend::%js-gdi-prepare + nil (list function-name) nil)) + "TypeError") + :to-be-truthy) + (setf (gethash allowed-name (cl-cc/vm:vm-function-registry state)) + function) + (cl-cc/javascript/backend::%js-gdi-prepare + nil (list allowed-name) nil) + (cl-cc/javascript/backend::%js-gdi-create-global-functions + (list (cons allowed-name 0))) + (progn + (expect (eq (%js-get-prop global "allowedFunction") function) + :to-be-truthy) + (expect (eq (gethash allowed-name (cl-cc/vm:vm-global-vars state)) function) + :to-be-truthy)) + (expect (%js-get-prop + (%js-object-get-own-property-descriptor + global "allowedFunction") + "configurable") + :to-equal nil)))) + ;; Test262: test/language/global-code/decl-var.js + (it-sequential "js-gdi-var-and-function-preflight-on-nonextensible-global" + (let* ((state (%js-gdi-test-state)) + (existing-name (%js-gdi-test-name "existingProperty")) + (configurable-name (%js-gdi-test-name "configurableProperty")) + (builtin-name (%js-gdi-test-name "Math")) + (missing-var (%js-gdi-test-name "newProperty")) + (missing-function (%js-gdi-test-name "newFunction")) + (builtin (%js-make-object "PI" 3))) + (let ((cl-cc/vm:*vm-state* state)) + (let ((global (cl-cc/javascript/backend::%js-gdi-global-object))) + (%js-object-define-property + global "existingProperty" + (%js-make-object "value" 4 "writable" nil + "enumerable" nil "configurable" nil)) + (%js-object-define-property + global "configurableProperty" + (%js-make-object "value" 5 "writable" t + "enumerable" nil "configurable" t)) + (setf (gethash builtin-name (cl-cc/vm:vm-global-vars state)) builtin) + (cl-cc/javascript/backend::%js-gdi-prepare + nil nil (list builtin-name)) + (cl-cc/javascript/backend::%js-gdi-create-global-vars + (list builtin-name) nil) + (expect (eq (cl-cc/javascript/backend::%js-gdi-global-read + builtin-name) + builtin) + :to-be-truthy) + (expect (%js-get-prop + (%js-object-get-own-property-descriptor global "Math") + "configurable") + :to-equal nil) + (cl-cc/javascript/objects:%js-object-prevent-extensions global)) + (cl-cc/javascript/backend::%js-gdi-prepare + nil nil (list existing-name)) + (cl-cc/javascript/backend::%js-gdi-create-global-vars + (list existing-name) nil) + (expect (cl-cc/javascript/backend::%js-gdi-global-read existing-name) + :to-equal 4) + (cl-cc/javascript/backend::%js-gdi-prepare + nil nil (list configurable-name)) + (cl-cc/javascript/backend::%js-gdi-create-global-vars + (list configurable-name) nil) + (let ((descriptor + (%js-object-get-own-property-descriptor + (cl-cc/javascript/backend::%js-gdi-global-object) + "configurableProperty"))) + (expect (%js-get-prop descriptor "value") :to-equal 5) + (expect (%js-get-prop descriptor "writable") :to-equal t) + (expect (%js-get-prop descriptor "enumerable") :to-equal nil) + (expect (%js-get-prop descriptor "configurable") :to-equal t)) + (expect (%js-gdi-test-error-p + (lambda () + (cl-cc/javascript/backend::%js-gdi-prepare + nil nil (list missing-var))) + "TypeError") + :to-be-truthy) + (expect (%js-gdi-test-error-p + (lambda () + (cl-cc/javascript/backend::%js-gdi-prepare + nil (list missing-function) nil)) + "TypeError") + :to-be-truthy)))) + ;; Test262: test/language/global-code/decl-func.js, test/language/statements/function/name.js, test/language/statements/function/length-dflt.js, and test/built-ins/Function/prototype/S15.3.5.2_A1_T1.js + (it-sequential "js-gdi-function-properties-and-hoisting-metadata" + (let* ((state (%js-gdi-test-state)) + (name (%js-gdi-test-name "declared")) + (function + (make-instance (quote cl-cc/vm:vm-closure-object) + :entry-label "declared" + :params nil))) + (let ((cl-cc/vm:*vm-state* state)) + (setf (gethash name (cl-cc/vm:vm-function-registry state)) function) + (cl-cc/javascript/backend::%js-gdi-prepare nil (list name) nil) + (cl-cc/javascript/backend::%js-gdi-create-global-functions + (list (cons name 2))) + (let* ((global (cl-cc/javascript/backend::%js-gdi-global-object)) + (global-descriptor + (%js-object-get-own-property-descriptor global "declared")) + (length-descriptor + (%js-object-get-own-property-descriptor function "length")) + (name-descriptor + (%js-object-get-own-property-descriptor function "name")) + (prototype (%js-get-prop function "prototype")) + (prototype-descriptor + (%js-object-get-own-property-descriptor function "prototype"))) + (expect (eq (%js-get-prop global "declared") function) + :to-be-truthy) + (expect (%js-get-prop global-descriptor "writable") + :to-equal t) (expect (%js-get-prop global-descriptor "enumerable") + :to-equal t) (expect (%js-get-prop global-descriptor "configurable") + :to-equal nil) + (expect (%js-get-prop function "name") + :to-equal "declared") (expect (%js-get-prop name-descriptor "value") + :to-equal "declared") + (expect (%js-get-prop length-descriptor "value") :to-equal 2) + (expect (%js-get-prop length-descriptor "writable") + :to-equal nil) (expect (%js-get-prop length-descriptor "enumerable") + :to-equal nil) (expect (%js-get-prop length-descriptor "configurable") + :to-equal t) + (expect (%js-get-prop name-descriptor "writable") + :to-equal nil) (expect (%js-get-prop name-descriptor "enumerable") + :to-equal nil) (expect (%js-get-prop name-descriptor "configurable") + :to-equal t) + (expect (%js-get-prop prototype-descriptor "writable") + :to-equal t) (expect (%js-get-prop prototype-descriptor "enumerable") + :to-equal nil) + (expect (%js-get-prop prototype-descriptor "configurable") + :to-equal nil) + (expect (eq (%js-get-prop prototype "constructor") function) + :to-be-truthy) (let ((own-property-names + (cl-cc/javascript/objects:%js-object-get-own-property-names + function))) + (expect (coerce own-property-names (quote list)) + :to-equal (quote ("length" "name" "prototype"))) + (expect (coerce (cl-cc/javascript/objects:%js-object-keys + function) + (quote list)) + :to-equal nil)) (let* ((descriptors + (cl-cc/javascript/proxies:%js-object-get-own-property-descriptors + function)) + (length-property (%js-get-prop descriptors "length")) + (name-property (%js-get-prop descriptors "name")) + (prototype-property (%js-get-prop descriptors "prototype"))) + (expect (%js-get-prop length-property "value") :to-equal 2) + (expect (%js-get-prop length-property "enumerable") + :to-equal nil) + (expect (%js-get-prop name-property "value") + :to-equal "declared") + (expect (%js-get-prop prototype-property "value") + :to-equal prototype)))))) + ) diff --git a/t/backend/gdi-prelude-global-properties-test.lisp b/t/backend/gdi-prelude-global-properties-test.lisp new file mode 100644 index 0000000..c91bbf3 --- /dev/null +++ b/t/backend/gdi-prelude-global-properties-test.lisp @@ -0,0 +1,86 @@ +(in-package #:cl-cc/javascript/backend/test) + +(defun %js-gdi-expect-prelude-global-properties (global) + (dolist + (property + (list (list "undefined" +js-undefined+) + (list "Infinity" cl-cc/javascript/objects:*js-inf-float*) + (list "NaN" cl-cc/javascript/objects:*js-nan-float*))) + (let* ((name (first property)) + (descriptor (%js-object-get-own-property-descriptor global name)) + (value (%js-get-prop descriptor "value"))) + (expect (not (eq descriptor +js-undefined+)) :to-be-truthy) + (expect + (cond + ((string= name "undefined") (eq value +js-undefined+)) + ((string= name "Infinity") (= value cl-cc/javascript/objects:*js-inf-float*)) + (t (cl-cc/javascript/objects:%js-float-nan-p value))) + :to-be-truthy) + (expect (%js-get-prop descriptor "writable") :to-equal nil) + (expect (%js-get-prop descriptor "enumerable") :to-equal nil) + (expect (%js-get-prop descriptor "configurable") :to-equal nil)))) + +(defun %register-backend-gdi-prelude-global-properties-tests () + (it-sequential "js-gdi-prelude-global-properties-cover-all-intrinsics" + (let* ((state (cl-cc/vm:make-vm-state)) + (specs cl-cc/javascript/backend::*js-prelude-global-specs*) + (names + (mapcar + (lambda (spec) + (cl-cc/javascript/syntax:js-ident-sym (second spec))) + specs)) + (math-name (cl-cc/javascript/syntax:js-ident-sym "Math")) + (infinity-name (cl-cc/javascript/syntax:js-ident-sym "Infinity"))) + (let ((cl-cc/vm:*vm-state* state)) + (let* ((global (cl-cc/javascript/backend::%js-gdi-global-object)) + (vars (cl-cc/vm:vm-global-vars state)) + (shared-value (%js-make-object))) + (dolist (spec specs) + (let* ((name (second spec)) + (symbol (cl-cc/javascript/syntax:js-ident-sym name)) + (value + (cond + ((string= name "undefined") +js-undefined+) + ((string= name "Infinity") + cl-cc/javascript/objects:*js-inf-float*) + ((string= name "NaN") + cl-cc/javascript/objects:*js-nan-float*) + ((string= name "globalThis") global) + (t shared-value)))) + (setf (gethash symbol vars) value))) + (cl-cc/javascript/backend::%js-gdi-initialize-prelude-global-properties + names) + (dolist (spec specs) + (let* ((name (second spec)) + (restricted + (member name + (list "undefined" "Infinity" "NaN") + :test + (function string=))) + (descriptor + (%js-object-get-own-property-descriptor global name))) + (expect (not (eq descriptor +js-undefined+)) :to-be-truthy) + (expect (%js-get-prop descriptor "writable") + :to-equal + (not restricted)) + (expect (%js-get-prop descriptor "enumerable") :to-equal nil) + (expect (%js-get-prop descriptor "configurable") + :to-equal + (not restricted)))) + (%js-gdi-expect-prelude-global-properties global) + (cl-cc/javascript/backend::%js-gdi-global-write math-name 17) + (expect + (%js-get-prop (%js-object-get-own-property-descriptor global "Math") + "value") + :to-equal + 17) + (cl-cc/javascript/backend::%js-gdi-prepare nil nil (list infinity-name)) + (cl-cc/javascript/backend::%js-gdi-create-global-vars + (list infinity-name) + nil) + (%js-gdi-expect-prelude-global-properties global) + (expect + (%js-get-prop (%js-object-get-own-property-descriptor global "Math") + "value") + :to-equal + 17)))))) diff --git a/t/backend/suite.lisp b/t/backend/suite.lisp index 0d56e3a..1aabad5 100644 --- a/t/backend/suite.lisp +++ b/t/backend/suite.lisp @@ -2,6 +2,9 @@ (describe-concurrent "JavaScript Backend" (%register-backend-runtime-builtins-platform-tests) + (%register-backend-gdi-tests) + (%register-backend-gdi-instantiation-tests) + (%register-backend-gdi-prelude-global-properties-tests) (%register-backend-runtime-method-resolver-dispatch-tests) (%register-backend-runtime-misc-tests) (%register-backend-runtime-absent-builtins-tests) diff --git a/t/objects/suite.lisp b/t/objects/suite.lisp index 1fde0a1..0e2cb13 100644 --- a/t/objects/suite.lisp +++ b/t/objects/suite.lisp @@ -8,5 +8,4 @@ (%register-objects-runtime-console-tests) (%register-objects-runtime-object-ops-tests) (%register-objects-runtime-symbol-tests) - (%register-objects-runtime-structured-clone-tests) -) + (%register-objects-runtime-structured-clone-tests)) diff --git a/t/proxies/package.lisp b/t/proxies/package.lisp index e5d5f3f..c000ea9 100644 --- a/t/proxies/package.lisp +++ b/t/proxies/package.lisp @@ -1,4 +1,8 @@ (defpackage #:cl-cc/javascript/proxies/test (:use #:cl) (:import-from #:cl-weave #:describe-concurrent #:describe-sequential #:expect #:it #:it-sequential #:it-sequential-each #:signals) + (:import-from #:cl-cc/javascript/objects + #:%js-get-prop #:%js-make-object #:%js-object-extensible-p + #:%js-object-freeze #:%js-object-frozen-p #:%js-object-prevent-extensions + #:%js-object-seal #:%js-object-sealed-p) (:import-from #:cl-cc-javascript/test #:%jr-arr)) diff --git a/t/proxies/runtime-builtins-iterator-proxy-test.lisp b/t/proxies/runtime-builtins-iterator-proxy-test.lisp index 48f71c4..b777049 100644 --- a/t/proxies/runtime-builtins-iterator-proxy-test.lisp +++ b/t/proxies/runtime-builtins-iterator-proxy-test.lisp @@ -226,17 +226,17 @@ (it-sequential "js-rt-object-values-reads-accessor" (let* ((obj (cl-cc/javascript/objects:%js-make-object)) (getter (lambda () 123)) - (desc (cl-cc/javascript/objects:%js-make-object "get" getter))) + (desc (cl-cc/javascript/objects:%js-make-object "get" getter "enumerable" t))) (cl-cc/javascript/proxies:%js-object-define-property obj "answer" desc) - (let ((values (coerce (cl-cc/javascript/objects:%js-object-values obj) 'list))) - (expect values :to-equal '(123))))) + (let ((values (coerce (cl-cc/javascript/objects:%js-object-values obj) (quote list)))) + (expect values :to-equal (quote (123)))))) (it-sequential "js-rt-object-keys-includes-accessor-property-name" (let* ((obj (cl-cc/javascript/objects:%js-make-object)) (getter (lambda () 42)) - (desc (cl-cc/javascript/objects:%js-make-object "get" getter))) + (desc (cl-cc/javascript/objects:%js-make-object "get" getter "enumerable" t))) (cl-cc/javascript/proxies:%js-object-define-property obj "answer" desc) - (let ((keys (coerce (cl-cc/javascript/objects:%js-object-keys obj) 'list))) - (expect keys :to-equal '("answer"))))) + (let ((keys (coerce (cl-cc/javascript/objects:%js-object-keys obj) (quote list)))) + (expect keys :to-equal (quote ("answer")))))) (it-sequential "js-rt-object-extensibility-seal-freeze" (let* ((proto (cl-cc/javascript/objects:%js-make-object "p" 1)) (obj (cl-cc/javascript/objects:%js-object-create proto))) @@ -251,3 +251,182 @@ (expect (cl-cc/javascript/proxies:%js-reflect-set-prototype-of obj next-proto) :to-be-falsy) (expect (cl-cc/javascript/objects:%js-object-get-prototype-of obj) :to-be proto)))) ) + +(in-package #:cl-cc/javascript/proxies/test) + +(defun %register-proxies-runtime-object-closure-integrity-tests () + (labels ((make-closure () + (let ((closure + (make-instance (quote cl-cc/vm:vm-closure-object) + :entry-label "closure" + :params nil))) + (cl-cc/javascript/objects:%js-set-property-descriptor + closure "length" + (list :value 2 :writable nil :enumerable nil :configurable t)) + (cl-cc/javascript/objects:%js-set-property-descriptor + closure "name" + (list :value "closure" :writable nil :enumerable nil :configurable t)) + (cl-cc/javascript/objects:%js-set-property-descriptor + closure "prototype" + (list :value (%js-make-object) + :writable t :enumerable nil :configurable nil)) + closure))) + (it-sequential "js-rt-vm-closure-prevent-extensions-blocks-new-properties" + (let* ((closure (make-closure)) + (descriptor (%js-make-object "value" 1))) + (expect + (cl-cc/javascript/proxies:%js-reflect-prevent-extensions closure) + :to-equal t) + (expect (%js-object-extensible-p closure) :to-equal nil) + (expect (%js-object-sealed-p closure) :to-equal nil) + (expect (%js-object-frozen-p closure) :to-equal nil) + (expect + (cl-cc/javascript/proxies:%js-reflect-define-property + closure "added" descriptor) + :to-equal nil) + (expect + (handler-case + (progn + (cl-cc/javascript/proxies:%js-object-define-property + closure "added" descriptor) + nil) + (error () t)) + :to-be-truthy) + (expect + (nth-value 1 + (cl-cc/javascript/objects:%js-property-descriptor + closure "added")) + :to-equal nil))) + (it-sequential "js-rt-vm-closure-assignment-and-symbol-own-keys" + (let* ((closure (make-closure)) + (value 23) + (symbol-key (cl-cc/javascript/objects:%js-make-symbol "extra")) + (symbol-storage-key + (cl-cc/javascript/objects:%js-symbol-as-key symbol-key)) + (hidden-symbol (cl-cc/javascript/objects:%js-make-symbol "hidden"))) + (cl-cc/javascript/objects:%js-set-prop closure "extra" value) + (let ((descriptor + (cl-cc/javascript/proxies:%js-object-get-own-property-descriptor + closure "extra"))) + (expect (%js-get-prop closure "extra") :to-equal value) + (expect (%js-get-prop descriptor "value") :to-equal value) + (expect (%js-get-prop descriptor "writable") :to-equal t) + (expect (%js-get-prop descriptor "enumerable") :to-equal t) + (expect (%js-get-prop descriptor "configurable") :to-equal t)) + (cl-cc/javascript/proxies:%js-object-define-property + closure symbol-key + (%js-make-object "value" 29 + "writable" t + "enumerable" t + "configurable" t)) + (cl-cc/javascript/proxies:%js-object-define-property + closure hidden-symbol + (%js-make-object "value" 31 + "writable" t + "enumerable" nil + "configurable" t)) + (let ((assigned (cl-cc/javascript/objects:%js-object-assign + (%js-make-object) closure))) + (expect (%js-get-prop assigned symbol-key) :to-equal 29) + (expect (eq (%js-get-prop assigned hidden-symbol) cl-cc/javascript/objects:+js-undefined+) + :to-be-truthy)) + (let ((own-keys + (coerce (cl-cc/javascript/objects:%js-object-own-keys closure) + (quote list))) + (own-symbols + (coerce + (cl-cc/javascript/objects:%js-object-get-own-property-symbols closure) + (quote list))) + (descriptors + (cl-cc/javascript/proxies:%js-object-get-own-property-descriptors + closure))) + (expect + (some + (lambda (key) + (and (cl-cc/javascript/objects:%js-symbol-p key) + (string= symbol-storage-key + (cl-cc/javascript/objects:%js-symbol-as-key key)))) + own-keys) + :to-be-truthy) + (expect + (some + (lambda (key) + (string= symbol-storage-key + (cl-cc/javascript/objects:%js-symbol-as-key key))) + own-symbols) + :to-be-truthy) + (expect (nth-value 1 (gethash symbol-storage-key descriptors)) + :to-equal t) + (expect (%js-get-prop (gethash symbol-storage-key descriptors) "value") + :to-equal 29)))) + (it-sequential "js-rt-vm-closure-accessor-properties" + (let* ((closure (make-closure)) + (value 5) + (getter (lambda () value)) + (setter (lambda (next-value) (setf value next-value)))) + (cl-cc/javascript/proxies:%js-object-define-property + closure "computed" + (%js-make-object "get" getter "set" setter + "enumerable" t "configurable" t)) + (expect (%js-get-prop closure "computed") :to-equal 5) + (cl-cc/javascript/objects:%js-set-prop closure "computed" 11) + (expect (%js-get-prop closure "computed") :to-equal 11) + (let ((descriptor + (cl-cc/javascript/proxies:%js-object-get-own-property-descriptor + closure "computed"))) + (expect (%js-get-prop descriptor "get") :to-be-truthy) + (expect (%js-get-prop descriptor "set") :to-be-truthy) + (expect (%js-get-prop descriptor "value") :to-equal cl-cc/javascript/objects:+js-undefined+) + (expect (%js-get-prop descriptor "writable") :to-equal cl-cc/javascript/objects:+js-undefined+)) + (cl-cc/javascript/proxies:%js-object-define-property + closure "computed" (%js-make-object "enumerable" nil)) + (let ((descriptor + (cl-cc/javascript/proxies:%js-object-get-own-property-descriptor + closure "computed"))) + (expect (%js-get-prop closure "computed") :to-equal 11) + (expect (%js-get-prop descriptor "get") :to-be-truthy) + (expect (%js-get-prop descriptor "set") :to-be-truthy) + (expect (%js-get-prop descriptor "enumerable") :to-equal nil)))) + (it-sequential "js-rt-vm-closure-seal-integrity-level" + (let* ((closure (make-closure)) + (descriptor (%js-make-object "value" 1)) + (prototype-descriptor + (cl-cc/javascript/proxies:%js-object-get-own-property-descriptor + closure "prototype"))) + (expect (%js-object-seal closure) :to-be closure) + (expect (%js-object-extensible-p closure) :to-equal nil) + (expect (%js-object-sealed-p closure) :to-equal t) + (expect (%js-object-frozen-p closure) :to-equal nil) + (expect (%js-get-prop prototype-descriptor "writable") :to-equal t) + (expect (%js-get-prop prototype-descriptor "configurable") :to-equal nil) + (expect + (cl-cc/javascript/proxies:%js-reflect-define-property + closure "added" descriptor) + :to-equal nil))) + (it-sequential "js-rt-vm-closure-freeze-integrity-level" + (let* ((closure (make-closure)) + (descriptor (%js-make-object "value" 1))) + (expect (%js-object-freeze closure) :to-be closure) + (expect (%js-object-extensible-p closure) :to-equal nil) + (expect (%js-object-sealed-p closure) :to-equal t) + (expect (%js-object-frozen-p closure) :to-equal t) + (let ((prototype-descriptor + (cl-cc/javascript/proxies:%js-object-get-own-property-descriptor + closure "prototype"))) + (expect (%js-get-prop prototype-descriptor "writable") :to-equal nil) + (expect (%js-get-prop prototype-descriptor "configurable") :to-equal nil)) + (expect + (cl-cc/javascript/proxies:%js-reflect-define-property + closure "added" descriptor) + :to-equal nil))))) + +(defun %register-proxies-runtime-object-closure-empty-integrity-test () + (it-sequential "js-rt-vm-closure-empty-prevent-extensions-is-sealed-and-frozen" + (let ((closure + (make-instance (quote cl-cc/vm:vm-closure-object) + :entry-label "empty" + :params nil))) + (expect (%js-object-prevent-extensions closure) :to-be closure) + (expect (%js-object-extensible-p closure) :to-equal nil) + (expect (%js-object-sealed-p closure) :to-equal t) + (expect (%js-object-frozen-p closure) :to-equal t)))) diff --git a/t/proxies/suite.lisp b/t/proxies/suite.lisp index 9a03a4c..f475c04 100644 --- a/t/proxies/suite.lisp +++ b/t/proxies/suite.lisp @@ -3,4 +3,5 @@ (describe-concurrent "JavaScript Proxies" (%register-proxies-runtime-builtins-iterator-proxy-tests) (%register-proxies-runtime-object-property-tests) -) + (%register-proxies-runtime-object-closure-integrity-tests) + (%register-proxies-runtime-object-closure-empty-integrity-test))