diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,6 +1,5 @@ -* Remove cl-uglify-js (no support for ES6 at all and no way to monkey-patch it reliably) -* Use Parenscript's async/await +* Use async/await * Use Parenscript's minifier * WAIT and MENU with async/await * Special locations diff --git a/src/api.ps b/src/api.ps --- a/src/api.ps +++ b/src/api.ps @@ -11,7 +11,7 @@ ;;; Utils (defm (root api make-act-html) (title img) - (+ "" + (+ "" title "")) @@ -53,7 +53,7 @@ (this.append-id (this.key-to-id key) "
" t)) (defm (root api clear-id) (id) - (setf (ps:chain document (get-element-by-id id) inner-h-t-m-l) "")) + (setf (ps:inner-html (document.get-element-by-id id)) "")) (setf (root api text-escaper) (document.create-element :textarea)) @@ -62,17 +62,17 @@ s (progn (setf (ps:@ (root api text-escaper) text-content) s) - (ps:@ (root api text-escaper) inner-h-t-m-l)))) + (ps:inner-html (root api text-escaper))))) (defm (root api get-id) (id &optional force-html) - (ps:chain (document.get-element-by-id id) inner-h-t-m-l)) + (ps:inner-html (document.get-element-by-id id))) (defm (root api set-id) (id contents &optional force-html) - (setf (ps:chain (document.get-element-by-id id) inner-h-t-m-l) (this.prepare-contents contents force-html))) + (setf (ps:inner-html (document.get-element-by-id id)) (this.prepare-contents contents force-html))) (defm (root api append-id) (id contents &optional force-html) (when contents - (incf (ps:chain (document.get-element-by-id id) inner-h-t-m-l) (this.prepare-contents contents force-html)))) + (incf (ps:inner-html (document.get-element-by-id id)) (this.prepare-contents contents force-html)))) ;;; Function calls @@ -89,7 +89,12 @@ (var result 0 :num))) (defm (root api call-loc) (name args) - (funcall (ps:getprop (root locs) name) args)) + (with-frame + (funcall (ps:getprop (root locs) name) args))) + +(defm (root api call-act) (title) + (with-frame + (funcall (ps:getprop (root acts) title)))) ;;; Text windows @@ -140,7 +145,7 @@ (let ((elt (document.get-element-by-id "qsp-acts"))) (ps:for-in (title (root acts)) (let ((obj (ps:getprop (root acts) title))) - (incf elt.inner-h-t-m-l (this.make-act-html title (ps:getprop obj :img))))))) + (incf (ps:inner-html elt) (this.make-act-html title (ps:getprop obj :img))))))) ;;; "Syntax" @@ -266,20 +271,20 @@ (defm (root api update-objs) () (let ((elt (document.get-element-by-id "qsp-objs"))) - (setf elt.inner-h-t-m-l ""))) ;;; Menu (defm (root api menu) (menu-data) (let ((elt (document.get-element-by-id "qsp-dropdown")) (i 0)) - (setf elt.inner-h-t-m-l "") + (setf (ps:inner-html elt) "") (loop :for item :in menu-data :do (incf i) - :do (incf elt.inner-h-t-m-l (this.make-menu-item-html i item.text item.icon item.loc))) + :do (incf (ps:inner-html elt) (this.make-menu-item-html i item.text item.icon item.loc))) (setf elt.style.display "block"))) ;;; Content @@ -344,12 +349,10 @@ objs (root objs) loc-args args msecs (- (*date.now) (root started-at)) - main-html (ps:@ - (document.get-element-by-id :qsp-main) - inner-h-t-m-l) - stat-html (ps:@ - (document.get-element-by-id :qsp-stat) - inner-h-t-m-l) + main-html (ps:inner-html + (document.get-element-by-id :qsp-main)) + stat-html (ps:inner-html + (document.get-element-by-id :qsp-stat)) next-location (root current-location)))) (values)) @@ -363,9 +366,9 @@ (setf (root started-at) (- (*date.now) (ps:@ data msecs))) (setf (root objs) (ps:@ data objs)) (setf (root current-location) (ps:@ data next-location)) - (setf (ps:@ (document.get-element-by-id :qsp-main) inner-h-t-m-l) + (setf (ps:inner-html (document.get-element-by-id :qsp-main)) (ps:@ data main-html)) - (setf (ps:@ (document.get-element-by-id :qsp-stat) inner-h-t-m-l) + (setf (ps:inner-html (document.get-element-by-id :qsp-stat)) (ps:@ data stat-html)) (this.update-objs) (api-call call-serv-loc "ONGLOAD") diff --git a/src/class.lisp b/src/class.lisp --- a/src/class.lisp +++ b/src/class.lisp @@ -6,16 +6,23 @@ (uiop/pathname:merge-pathnames* filename (asdf:system-source-directory :sugar-qsp))) - (defun compile-ps (filename) - (format nil "////// Parenscript file: ~A~%~%~A" - (file-namestring filename) (ps:ps-compile-file filename)))) + (defun read-code-from-string (string) + (with-input-from-string (in string) + `(progn + ,@(loop :for form := (read in nil :eof) + :until (eq form :eof) + :collect form)))) + (defun load-src (filename) + (alexandria:read-file-into-string (src-file filename)))) (defclass compiler () - ((body :accessor body :initform #.(alexandria:read-file-into-string (src-file "extras/body.html"))) - (css :accessor css :initform (list #.(alexandria:read-file-into-string (src-file "extras/default.css")))) - (js :accessor js :initform (list #.(compile-ps (src-file "src/intrinsics.ps")) - #.(compile-ps (src-file "src/api.ps")) - #.(compile-ps (src-file "src/main.ps")))) + ((body :accessor body :initform #.(load-src "extras/body.html")) + (css :accessor css :initform (list #.(load-src "extras/default.css"))) + (js :accessor js :initform '#.(mapcar #'read-code-from-string + (mapcar #'load-src + (list "src/intrinsics.ps" + "src/api.ps" + "src/main.ps")))) (compile :accessor compile-only :initarg :compile) (target :accessor target :initarg :target) (beautify :accessor beautify :initarg :beautify))) diff --git a/src/main.lisp b/src/main.lisp --- a/src/main.lisp +++ b/src/main.lisp @@ -53,39 +53,6 @@ (p:parse 'sugar-qsp-grammar (alexandria:read-file-into-string filename))) -(defun make-javascript (locations) - (format nil "////// THE GAME STARTS HERE~%~%~{~A~^~%~%~}" - (mapcar #'ps:ps* locations))) - -(defun uglify-js::write-json-chars (quote s stream) - "Write JSON representations (chars or escape sequences) of -characters in string S to STREAM. -Monkey-patched to output plain utf-8 instead of escape-sequences." - (write-char quote stream) - (loop :for ch :across s - :for code := (char-code ch) - :with special - :do (cond ((eq ch quote) - (write-char #\\ stream) (write-char ch stream)) - ((setq special (car (rassoc ch uglify-js::+json-lisp-escaped-chars+))) - (write-char #\\ stream) (write-char special stream)) - (t - (write-char ch stream)))) - (write-char quote stream)) - -(defun preprocess-js (js beautify) - (if beautify - (cl-uglify-js:ast-gen-code - (cl-uglify-js:ast-squeeze - (parse-js:parse-js js) - :sequences nil) - :beautify t) - (cl-uglify-js:ast-gen-code - (cl-uglify-js:ast-mangle - (cl-uglify-js:ast-squeeze - (parse-js:parse-js js))) - :beautify nil))) - (defun report-error (fmt &rest args) (apply #'format t fmt args) (throw :terminate nil)) @@ -93,7 +60,8 @@ Monkey-patched to output plain utf-8 ins ;;; JS (defmethod js-sources ((compiler compiler)) - (format nil "~{~A~^~%~%~}" (reverse (js compiler)))) + (let ((ps:*ps-print-pretty* (beautify compiler))) + (format nil "~{~A~^~%~%~}" (mapcar #'ps:ps* (reverse (js compiler)))))) ;;; CSS @@ -116,7 +84,7 @@ Monkey-patched to output plain utf-8 ins (body body-template (style css) - (script (preprocess-js js (beautify compiler)))))) + (script js)))) :stream out :pretty nil)))) @@ -125,7 +93,7 @@ Monkey-patched to output plain utf-8 ins (with-slots (body css js) compiler ;; Compile the game's JS - (push (make-javascript (parse-file source)) js) + (push (list* 'progn (parse-file source)) js) ;; Does the user need us to do anything else (unless compile ;; Read in body diff --git a/src/parser.lisp b/src/parser.lisp --- a/src/parser.lisp +++ b/src/parser.lisp @@ -325,7 +325,7 @@ (p:? (and spaces (p:~ "if")))) (:constant nil)) -(p:defrule block-act (and block-act-head (or block-act-ml block-act-sl)) +(p:defrule block-act (and block-act-head (or block-ml block-sl)) (:lambda (list) (apply #'append list))) @@ -547,7 +547,7 @@ (p:defrule eq-expr (and sum-expr (* (and spaces? (or "<=" ">=" "=<" "=>" "<>" "=" "<" ">" "!") - spaces? cat-expr))) + spaces? sum-expr))) (:function do-binop)) (p:defrule sum-expr (and mod-expr (* (and spaces? (or #\+ #\-) spaces? mod-expr))) diff --git a/src/patches.lisp b/src/patches.lisp new file mode 100644 --- /dev/null +++ b/src/patches.lisp @@ -0,0 +1,60 @@ + +(in-package parenscript) + +;;; async/await + +(defprinter ps-js::await (x) + (psw (string-downcase "await ")) + (print-op-argument 'ps-js::await x)) + +(define-trivial-special-ops await) + +(define-statement-operator async-defun (name lambda-list &rest body) + (multiple-value-bind (effective-args body-block docstring) + (compile-named-function-body name lambda-list body) + (list 'ps-js::async-defun name effective-args docstring body-block))) + +(defprinter ps-js::async-defun (name args docstring body-block) + (when docstring (print-comment docstring)) + (psw "async ") + (print-fun-def name args body-block)) + +(define-expression-operator async-lambda (lambda-list &rest body) + (multiple-value-bind (effective-args effective-body) + (parse-extended-function lambda-list body) + `(ps-js::async-lambda + ,effective-args + ,(let ((*function-block-names* ())) + (compile-function-body effective-args effective-body))))) + +(defprinter ps-js::async-lambda (args body-block) + (psw "async ") + (print-fun-def nil args body-block)) + +(cl:export 'await) +(cl:export 'async-defun) +(cl:export 'async-lambda) + +;;; ES6 + +(define-expression-operator => (lambda-list &rest body) + (unless (listp lambda-list) + (setf lambda-list (list lambda-list))) + (multiple-value-bind (effective-args effective-body) + (parse-extended-function lambda-list body) + `(ps-js::=> + ,effective-args + ,(let ((*function-block-names* ())) + (compile-function-body effective-args effective-body))))) + +(defprinter ps-js::=> (args body) + (unless (= 1 (length args)) + (psw "(")) + (loop for (arg . remaining) on args do + (psw (symbol-to-js-string arg)) (when remaining (psw ", "))) + (unless (= 1 (length args)) + (psw ")")) + (psw " => ") + (ps-print body)) + +(cl:export '=>) diff --git a/src/ps-macros.lisp b/src/ps-macros.lisp --- a/src/ps-macros.lisp +++ b/src/ps-macros.lisp @@ -46,9 +46,8 @@ ,@(when has-labels '((defvar __labels))) ,@(if locals - `((with-frame - (tagbody - ,@body))) + `((tagbody + ,@body)) `((tagbody ,@body)))))) diff --git a/sugar-qsp.asd b/sugar-qsp.asd --- a/sugar-qsp.asd +++ b/sugar-qsp.asd @@ -1,8 +1,10 @@ (defsystem sugar-qsp :description "QSP compiler to monolithic HTML page" - :depends-on (:alexandria :esrap - :parenscript :parse-js :cl-uglify-js :flute) + :depends-on (:alexandria ;; General + :esrap ;; Parsing + :parenscript :flute ;; Codegening + ) :pathname "src/" :serial t :components ((:file "package")