diff --git a/info.ss b/info.ss index 1f67549..ccdc8cf 100644 --- 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 index 7828f22..a234fb6 100644 --- 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 index 907884c..f17be69 100644 --- 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 index 228f787..7c4c896 100644 --- 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)