Verified Commit e12e1abb authored by Vladimir Sedach's avatar Vladimir Sedach
Browse files

Got rid of the unnecessary crud around optimizing away .call(this)

parent c202f5d0
......@@ -63,14 +63,18 @@
(list "break" "case" "catch" "continue" "default" "delete" "do" "else"
"finally" "for" "function" "if" "in" "instanceof" "new" "return"
"switch" "this" "throw" "try" "typeof" "var" "void" "while" "with"
"abstract" "boolean" "byte" "char" "class" "const" "debugger" "double"
"enum" "export" "extends" "final" "float" "goto" "implements" "import"
"int" "interface" "long" "native" "package" "private" "protected"
"public" "short" "static" "super" "synchronized" "throws" "transient"
"volatile" "{}" "true" "false" "null" "undefined"))
(defvar *lambda-wrappable-statements* ;; break, return, continue not included
'(throw switch for for-in while try block))
"abstract" "boolean" "byte" "char" "class" "const" "debugger"
"double" "enum" "export" "extends" "final" "float" "goto"
"implements" "import" "int" "interface" "long" "native" "package"
"private" "protected" "public" "short" "static" "super"
"synchronized" "throws" "transient" "volatile" "{}" "true" "false"
"null" "undefined"))
(defvar *lambda-wrappable-statements*
'(throw switch for for-in while try block)
"Statement special forms that can be wrapped in a lambda to make
them into expressions. Control transfer forms like BREAK, RETURN,
and CONTINUE need special treatment, and are not included.")
(defun reserved-symbol-p (symbol)
(find (string-downcase (string symbol)) *reserved-symbol-names* :test #'string=))
......@@ -102,7 +106,9 @@
(or (gethash (car form) *special-expression-operators*)
(gethash (car form) *special-statement-operators*))))
;;; scoping and lexical environment
;;; naming, scoping, and lexical environment
(defvar *ps-gensym-counter* 0)
(defvar *vars-needing-to-be-declared* ()
"This special variable is expected to be bound to a fresh list by
......@@ -265,20 +271,6 @@ return NIL."
(values (ps-macroexpand form1) t)
form1)))
;;; lambda wrapping
(defvar *ps-gensym-counter* 0)
(defvar this-in-lambda-wrapped-form? nil)
(defun lambda-wrap (form)
(let ((this-in-lambda-wrapped-form? :query)
(*ps-gensym-counter* *ps-gensym-counter*))
(ps-compile form)
(if (eq this-in-lambda-wrapped-form? :yes)
`(chain (lambda () ,form) (call this))
`((lambda () ,form)))))
;;;; compiler interface
(defparameter *compilation-level* :toplevel
......@@ -300,37 +292,41 @@ form, FORM, returns the new value for *compilation-level*."
(define-condition compile-expression-error (error)
((form :initarg :form :reader error-form))
(:report (lambda (condition stream)
(format stream "The Parenscript form ~A cannot be compiled into an expression." (error-form condition)))))
(:report
(lambda (condition stream)
(format
stream
"The Parenscript form ~A cannot be compiled into an expression."
(error-form condition)))))
(defun compile-special-form (form)
(let* ((op (car form))
(statement-impl (gethash op *special-statement-operators*))
(let* ((op (car form))
(statement-impl (gethash op *special-statement-operators*))
(expression-impl (gethash op *special-expression-operators*)))
(cond ((or (not compile-expression?) this-in-lambda-wrapped-form?)
(cond ((not compile-expression?)
(apply (or statement-impl expression-impl) (cdr form)))
(expression-impl
(apply expression-impl (cdr form)))
((member op *lambda-wrappable-statements*)
(compile-expression (lambda-wrap form)))
(t (error 'compile-expression-error :form form)))))
(compile-expression (with-lambda-scope form)))
(t
(error 'compile-expression-error :form form)))))
(defun ps-compile (form)
(macrolet ((try-expanding (form &body body)
`(multiple-value-bind (expansion expanded?) (ps-macroexpand ,form)
(if expanded?
(ps-compile expansion)
(progn ,@body)))))
(macrolet
((try-expanding (form &body body)
`(multiple-value-bind (expansion expanded?)
(ps-macroexpand ,form)
(if expanded?
(ps-compile expansion)
,@body))))
(typecase form
((or null number string character)
form)
(vector
(ps-compile `(quote ,(coerce form 'list))))
(symbol
(try-expanding form
(when (and (eq form 'this) (eq this-in-lambda-wrapped-form? :query))
(setq this-in-lambda-wrapped-form? :yes))
form))
(try-expanding form form))
(cons
(try-expanding form
(let ((*compilation-level*
......
......@@ -167,7 +167,8 @@ of (declare ...) forms, and the remaining body."
(collapsed-body
(collapse-function-return-blocks body))
(suppress-values?
(find 'values (flatten body)))
;; probably buggy; this should be done after macroexpansion
(tree-find 'values collapsed-body))
(*dynamic-return-tags*
(append (mapcar (lambda (x) (cons x nil))
*function-block-names*)
......@@ -238,7 +239,7 @@ of (declare ...) forms, and the remaining body."
`(ps-js:lambda ,args1 ,body-block)))
(defmacro local-functions (special-op &body bindings)
`(if (or in-function-scope? this-in-lambda-wrapped-form?)
`(if in-function-scope?
(let* ((fn-renames (collect-function-names fn-defs))
,@bindings)
`(,(if compile-expression? 'ps-js:|,| 'ps-js:block)
......
......@@ -453,5 +453,5 @@
,@(awhen (accum-var state) (list it))))
(full `(block ,(name state) ,@(prologue-wrap (prologue state) main))))
(if (accum-var state)
(lambda-wrap full)
(with-lambda-scope full)
full))))
......@@ -198,7 +198,7 @@
body))
(define-statement-operator block (name &rest body)
(if (or in-function-scope? this-in-lambda-wrapped-form?)
(if in-function-scope?
(let* ((name (or name 'nilBlock))
(in-loop-scope? (if name in-loop-scope? nil))
(*dynamic-return-tags* (cons (cons name nil) *dynamic-return-tags*))
......@@ -206,7 +206,7 @@
(compiled-body (wrap-for-dynamic-return
(list name)
(compile-statement `(progn ,@body)))))
(if (tree-search `(ps-js:break ,name) compiled-body)
(if (tree-find `(ps-js:break ,name) compiled-body)
`(ps-js:label ,name ,compiled-body)
compiled-body))
(ps-compile (with-lambda-scope `(block ,name ,@body)))))
......@@ -333,7 +333,7 @@ invocations or not.")
,@(when in-case? `((t (return-from ,tag nil))))))
(if
(if (and (try-expressionizing-if? form)
(not (find 'values (flatten form)))
(not (tree-find 'values form))
(let ((used-up-names *used-up-names*)
(*lambda-wrappable-statements* ()))
(handler-case (compile-expression form)
......@@ -463,9 +463,13 @@ Parenscript now implements implicit return, update your code! Things like (lambd
(member x symbols-in-bindings))
(ps-gensym (symbol-name x))))
(defun with-lambda-scope (body)
(prog1 (lambda-wrap body)
(setf *vars-needing-to-be-declared* ())))
(defun with-lambda-scope (form)
(prog1 (if (tree-find 'this
(let ((*ps-gensym-counter* *ps-gensym-counter*))
(ps-compile `(lambda () ,form))))
`(funcall (getprop (lambda () ,form) 'call) this)
`((lambda () ,form)))
(setf *vars-needing-to-be-declared* ())))
(define-expression-operator let (bindings &body body)
(with-declaration-effects (body body)
......@@ -534,9 +538,7 @@ Parenscript now implements implicit return, update your code! Things like (lambd
dynamic-bindings)))))
renamed-body))))
(ps-compile
(cond ((or in-function-scope?
this-in-lambda-wrapped-form?
(null bindings))
(cond ((or in-function-scope? (null bindings))
let-body)
;; HACK
((find-if
......
......@@ -118,11 +118,11 @@ Use GETPROP, @, or CHAIN instead."
((atom x) (cons x acc))
(t (flatten (car x) (flatten (cdr x) acc)))))
(defun tree-search (A tree)
(defun tree-find (A tree)
(or (equal A tree)
(when (consp tree)
(loop for x on tree thereis ;; fucking dotted lists
(or (tree-search A (car x))
(loop for x on tree thereis
(or (tree-find A (car x))
(unless (listp (cdr x))
(equal A (cdr x))))))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment