housekeeping
Sat Apr 11 07:56:43 PDT 2009 attila.lendvai@gmail.com
* housekeeping
Warning: CRC errors found. These are probably harmless but should be repaired.
See 'darcs gzcrcs --help' for more information.
diff -rN -u old-cl-quasi-quote/src/binary.lisp new-cl-quasi-quote/src/binary.lisp
--- old-cl-quasi-quote/src/binary.lisp 2014-07-31 20:44:05.000000000 -0700
+++ new-cl-quasi-quote/src/binary.lisp 2014-07-31 20:44:05.000000000 -0700
@@ -166,7 +166,8 @@
(etypecase node
(vector (write-sequence node stream))
(list (mapc (lambda (node) (write-quasi-quoted-binary node stream)) node))
- (delayed-emitting (funcall node)))
+ (delayed-emitting (funcall node))
+ (binary-quasi-quote (write-quasi-quoted-binary (body-of node) stream)))
(values))
(def function reduce-binary-subsequences (sequence)
diff -rN -u old-cl-quasi-quote/src/js/syntax.lisp new-cl-quasi-quote/src/js/syntax.lisp
--- old-cl-quasi-quote/src/js/syntax.lisp 2014-07-31 20:44:05.000000000 -0700
+++ new-cl-quasi-quote/src/js/syntax.lisp 2014-07-31 20:44:05.000000000 -0700
@@ -13,7 +13,8 @@
(splice-character #\@)
(destructive-splice-character #\.)
(transformation-pipeline nil)
- (dispatched-quasi-quote-name "js"))
+ (dispatched-quasi-quote-name "js")
+ (toplevel-reader-wrapper #'identity))
(set-quasi-quote-syntax-in-readtable
(lambda (body dispatched?)
(declare (ignore dispatched?))
@@ -33,6 +34,7 @@
:destructive-splice-character destructive-splice-character
:readtable-case :preserve
:unquote-readtable-case :toplevel
+ :toplevel-reader-wrapper toplevel-reader-wrapper
:dispatched-quasi-quote-name dispatched-quasi-quote-name))
(macrolet ((x (name transformation-pipeline &optional args)
diff -rN -u old-cl-quasi-quote/src/js/transform.lisp new-cl-quasi-quote/src/js/transform.lisp
--- old-cl-quasi-quote/src/js/transform.lisp 2014-07-31 20:44:05.000000000 -0700
+++ new-cl-quasi-quote/src/js/transform.lisp 2014-07-31 20:44:05.000000000 -0700
@@ -189,6 +189,7 @@
(|vector| (transform-vector-like -node-))
(|list| (transform-vector-like -node-))
(|map| (transform-map-like -node-))
+ ;; TODO i think the with syntax ought to be a full AST node...
(|with| (bind ((arguments (arguments-of -node-)))
`("with (" ,(recurse (first arguments)) ") " ,(transform-statements (rest arguments) :wrap? #t))))
;; KLUDGE need to handle 'not' specially, because the one at application-form can only handle infix operators for now
@@ -638,17 +639,24 @@
(defmethod print-object ((self quasi-quoted-js-to-quasi-quoted-string) *standard-output*)
(princ "[JS->String]"))
+(def method compatible-transformations? ((a quasi-quoted-js-to-quasi-quoted-string) a-next a-rest
+ (b quasi-quoted-js-to-quasi-quoted-string) b-next b-rest)
+ (compatible-transformations? a-next (first a-rest) (rest a-rest)
+ b-next (first b-rest) (rest b-rest)))
+
(def function transform-quasi-quoted-js-to-quasi-quoted-string/toplevel (node)
(assert (typep node 'js-quasi-quote))
(with-root-operator-precedence
(make-string-quasi-quote (rest (transformation-pipeline-of node))
`(,(awhen (output-prefix-of *transformation*)
- (if (functionp it)
+ (if (or (functionp it)
+ (symbolp it))
(funcall it)
it))
,(transform-quasi-quoted-js-to-quasi-quoted-string (body-of node))
,(awhen (output-postfix-of *transformation*)
- (if (functionp it)
+ (if (or (functionp it)
+ (symbolp it))
(funcall it)
it))))))
@@ -664,10 +672,11 @@
(transformation-pipeline-of node))
(transform-quasi-quoted-js-to-quasi-quoted-string/toplevel node)
(transform node)))
- (string-quasi-quote node)))
+ (string-quasi-quote node)
+ (binary-quasi-quote node)))
(def function transform-quasi-quoted-js-to-quasi-quoted-string/unquote (node)
- (assert (typep node 'js-unquote))
+ (check-type node js-unquote)
(bind ((spliced? (spliced? node)))
(make-string-unquote
(wrap-runtime-delayed-js-transformation-form
diff -rN -u old-cl-quasi-quote/src/package.lisp new-cl-quasi-quote/src/package.lisp
--- old-cl-quasi-quote/src/package.lisp 2014-07-31 20:44:05.000000000 -0700
+++ new-cl-quasi-quote/src/package.lisp 2014-07-31 20:44:05.000000000 -0700
@@ -41,7 +41,7 @@
macroexpand-ignoring-toplevel-quasi-quote-macro
map-ast
map-ast/map-accessors-unless-same-returned
- bq-process bq-bracket
+ bq-process bq-bracket bq-completely-process
*bq-list*
*bq-list**
*bq-nconc*
@@ -82,6 +82,7 @@
*transformation*
*transformation-pipeline*
*transformation-environment*
+ compatible-with-current-transformation-pipeline?
compatible-transformation-pipelines?
compatible-transformations?
run-transformation-pipeline
diff -rN -u old-cl-quasi-quote/src/string.lisp new-cl-quasi-quote/src/string.lisp
--- old-cl-quasi-quote/src/string.lisp 2014-07-31 20:44:05.000000000 -0700
+++ new-cl-quasi-quote/src/string.lisp 2014-07-31 20:44:05.000000000 -0700
@@ -239,8 +239,7 @@
(character (babel:string-to-octets (string node) :encoding encoding))
(string (babel:string-to-octets node :encoding encoding))
(string-quasi-quote
- (if (compatible-transformation-pipelines? *transformation-pipeline*
- (transformation-pipeline-of node))
+ (if (compatible-with-current-transformation-pipeline? (transformation-pipeline-of node))
(make-binary-quasi-quote (rest (transformation-pipeline-of node))
(transform-quasi-quoted-string-to-quasi-quoted-binary (body-of node)))
(transform node)))
@@ -250,7 +249,8 @@
`(transform-quasi-quoted-string-to-quasi-quoted-binary
,(map-filtered-tree (form-of node) 'string-quasi-quote
(lambda (child)
- (transform-quasi-quoted-string-to-quasi-quoted-binary child)))))))))
+ (transform-quasi-quoted-string-to-quasi-quoted-binary child)))))))
+ (binary-quasi-quote node)))
(def method compatible-transformations? ((a quasi-quoted-binary-to-binary-emitting-form) a-next a-rest
(b quasi-quoted-string-to-quasi-quoted-binary) (b-next quasi-quoted-binary-to-binary-emitting-form) b-rest)
diff -rN -u old-cl-quasi-quote/src/transformation.lisp new-cl-quasi-quote/src/transformation.lisp
--- old-cl-quasi-quote/src/transformation.lisp 2014-07-31 20:44:05.000000000 -0700
+++ new-cl-quasi-quote/src/transformation.lisp 2014-07-31 20:44:05.000000000 -0700
@@ -60,6 +60,10 @@
(eq a-rest b-rest))
(call-next-method))))
+(def function compatible-with-current-transformation-pipeline? (pipeline)
+ (or (not (boundp '*transformation-pipeline*))
+ (compatible-transformation-pipelines? *transformation-pipeline* pipeline)))
+
(def function compatible-transformation-pipelines? (a b)
(or (and (null a) (null b))
(compatible-transformations? (first a) (second a) (rest (rest a))