patches.lisp
136 lines
| 4.6 KiB
| text/x-common-lisp
|
CommonLispLexer
/ src / patches.lisp
r58 | ||||
;;;; Parenscript | ||||
r23 | ||||
(in-package parenscript) | ||||
;;; async/await | ||||
(defprinter ps-js::await (x) | ||||
(psw (string-downcase "await ")) | ||||
(print-op-argument 'ps-js::await x)) | ||||
r29 | (define-trivial-special-ops await ps-js::await) | |||
r23 | ||||
(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 '=>) | ||||
r27 | ||||
;;; 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))) | ||||
r51 | (cl:export 'void) | |||
r33 | ||||
;;; Bitwise stuff | ||||
;; No idea why these are not exported | ||||
(export '<<) | ||||
(export '>>) | ||||
r54 | ||||
r58 | ;;;; Esrap | |||
r54 | (in-package esrap) | |||
r58 | ||||
r54 | (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%"))) | ||||