Fixed bug where named function declarations would not be allowed in !…

…begin blocks; renamed js-debug and JD-DEBUG to debug-js and DEBUG-JS; added xml-debug and XML-DEBUG forms.
untyped · Jun 20, 2009 · 68d01d2 · 68d01d2
1 parent 3d2cd34
commit 68d01d2
Show file tree

Hide file tree

Showing 4 changed files with 37 additions and 19 deletions.
diff --git a/info.ss b/info.ss
@@ -7,7 +7,7 @@
 
 (define release-notes
   '((p "Changes and additions:")
-    (ul (li "nothing yet...")))
+    (ul (li "named function declarations are now allowed within !begin blocks;"))))
 
 (define primary-file "mirrors.ss")
 

diff --git a/javascript/render.ss b/javascript/render.ss
@@ -2,7 +2,7 @@
 
 (require "../base.ss")
 
-(require (javascript-in print)
+(require (javascript-in config print)
          (pprint-in)
          (unlib-in debug list profile)
          "quote.ss"
@@ -19,20 +19,26 @@
 
 ; javascript -> string
 (define (javascript->string js)
-  (parameterize ([formatters/Expression (list* format-FunctionExpression
-                                               format-RawExpression
-                                               (formatters/Expression))]
-                 [formatters/Statement  (list* format-BeginStatement
-                                               (formatters/Statement))])
-    (pretty-format (group (format-term js)) #f)))
+  #;(parameterize ([allow-nested-function-declarations? #t]
+                   [formatters/Expression               (list* format-FunctionExpression
+                                                               format-RawExpression
+                                                               (formatters/Expression))]
+                   [formatters/Statement                (list* format-BeginStatement
+                                                               (formatters/Statement))])
+      (pretty-format (group (format-term js)) #f))
+  (if (render-pretty-javascript?)
+      (javascript->pretty-string js)
+      (fast-javascript->string js)))
+
 
 ; javascript -> string
 (define (javascript->pretty-string js)
-  (parameterize ([formatters/Expression (list* format-FunctionExpression
-                                               format-RawExpression
-                                               (formatters/Expression))]
-                 [formatters/Statement  (list* format-BeginStatement
-                                               (formatters/Statement))])
+  (parameterize ([allow-nested-function-declarations? #t]
+                 [formatters/Expression               (list* format-FunctionExpression
+                                                             format-RawExpression
+                                                             (formatters/Expression))]
+                 [formatters/Statement                (list* format-BeginStatement
+                                                             (formatters/Statement))])
     (pretty-format (format-term js))))
 
 ; Custom printers --------------------------------

diff --git a/javascript/syntax.ss b/javascript/syntax.ss
@@ -21,7 +21,7 @@
       (js)))
 
 ; (_ string xml ...)
-(define-syntax-rule (js-debug msg expr ...)
+(define-syntax-rule (debug-js msg expr ...)
   (let ([ans (js expr ...)])
     (printf "----------~a:~n~a~n----------~n" msg (javascript->pretty-string ans))
     ans))
@@ -41,12 +41,12 @@
       (JS)))
 
 ; (_ string xml ...)
-(define-syntax-rule (JS-DEBUG msg expr ...)
+(define-syntax-rule (DEBUG-JS msg expr ...)
   (let ([ans (JS expr ...)])
     (printf "----------~a:~n~a~n----------~n" msg (javascript->pretty-string ans))
     ans))
 
 ; Provide statements -----------------------------
 
-(provide js opt-js js-debug
-         JS OPT-JS JS-DEBUG)
+(provide js opt-js debug-js
+         JS OPT-JS DEBUG-JS)
diff --git a/xml/syntax.ss b/xml/syntax.ss
@@ -58,6 +58,12 @@
                   (xml-attrs [id ,val])
                   (xml-attrs)))]))
 
+; (_ string xml ...)
+(define-syntax-rule (debug-xml msg expr ...)
+  (let ([ans (xml expr ...)])
+    (printf "----------~a:~n~a~n----------~n" msg (xml->string ans))
+    ans))
+
 ; Uppercase variants -----------------------------
 
 (define-syntax (XML stx)
@@ -106,7 +112,13 @@
                   (XML-ATTRS [id ,val])
                   (XML-ATTRS)))]))
 
+; (_ string xml ...)
+(define-syntax-rule (DEBUG-XML msg expr ...)
+  (let ([ans (XML expr ...)])
+    (printf "----------~a:~n~a~n----------~n" msg (xml->string ans))
+    ans))
+
 ; Provide statements -----------------------------
 
-(provide xml xml-attrs xml* xml-attrs* opt-xml opt-xml-attr
-         XML XML-ATTRS XML* XML-ATTRS* OPT-XML OPT-XML-ATTR)
+(provide xml xml-attrs xml* xml-attrs* opt-xml opt-xml-attr debug-xml
+         XML XML-ATTRS XML* XML-ATTRS* OPT-XML OPT-XML-ATTR DEBUG-XML)