|
|
|
|
|
;;;; Parenscript
|
|
|
|
|
|
(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 ps-js::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 '=>)
|
|
|
|
|
|
;;; Actually return nothing (with no empty return)
|
|
|
(defvar *old-return-result-of* (function return-result-of))
|
|
|
|
|
|
(defun return-result-of (tag form)
|
|
|
(if (equal form '(void))
|
|
|
nil
|
|
|
(funcall *old-return-result-of* tag form)))
|
|
|
(cl:export 'void)
|
|
|
|
|
|
;;; Bitwise stuff
|
|
|
;; No idea why these are not exported
|
|
|
(export '<<)
|
|
|
(export '>>)
|
|
|
|
|
|
;;;; Esrap
|
|
|
|
|
|
(in-package esrap)
|
|
|
|
|
|
(defmethod print-object :around ((condition esrap-error) stream)
|
|
|
(when (not txt2web::*delivered*)
|
|
|
(return-from print-object
|
|
|
(call-next-method)))
|
|
|
(when (or *print-escape*
|
|
|
*print-readably*
|
|
|
(and *print-lines* (<= *print-lines* 5)))
|
|
|
(return-from print-object))
|
|
|
|
|
|
;; FIXME: this looks like it won't do the right thing when used as
|
|
|
;; part of a logical block.
|
|
|
(if-let ((text (esrap-error-text condition))
|
|
|
(position (esrap-error-position condition)))
|
|
|
(labels ((safe-index (index)
|
|
|
(min (max index 0) (length text)))
|
|
|
(find-newline (&key (start 0) (end (length text)) (from-end t))
|
|
|
(let ((start (safe-index start))
|
|
|
(end (safe-index end)))
|
|
|
(cond
|
|
|
((when-let ((position (position #\Newline text
|
|
|
:start start :end end
|
|
|
:from-end from-end)))
|
|
|
(1+ position)))
|
|
|
((and from-end (zerop start))
|
|
|
start)
|
|
|
((and (not from-end) (= end (length text)))
|
|
|
end)))))
|
|
|
;; FIXME: magic numbers
|
|
|
(let* ((line (count #\Newline text :end position))
|
|
|
(column (- position (or (find-newline :end position) 0) 1))
|
|
|
(min-start (- position 160))
|
|
|
(max-end (+ position 24))
|
|
|
(line-start (or (find-newline :start min-start
|
|
|
:end position)
|
|
|
(safe-index min-start)))
|
|
|
(start (cond
|
|
|
((= (safe-index min-start) line-start)
|
|
|
line-start)
|
|
|
((find-newline :start min-start
|
|
|
:end (1- line-start)))
|
|
|
(t
|
|
|
|
|
|
line-start)))
|
|
|
(end (or (find-newline :start position
|
|
|
:end max-end
|
|
|
:from-end nil)
|
|
|
(safe-index max-end)))
|
|
|
(*print-circle* nil))
|
|
|
(txt2web::lformat stream :error
|
|
|
(= position (length text))
|
|
|
(list (subseq text start end))
|
|
|
(- position line-start)
|
|
|
(1+ line) (1+ column) position)))
|
|
|
|
|
|
(format stream "~2&<text and position not available>~2%")))
|
|
|
|