XML interpolation efficiency/cleanup

basis/xml/interpolate/interpolate-tests.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test xml.interpolate multiline kernel assocs
 sequences accessors xml.writer xml.interpolate.private
-locals splitting urls xml.data ;
+locals splitting urls xml.data classes ;
 IN: xml.interpolate.tests
 
 [ "a" "c" { "a" "c" f } ] [
@@ -54,6 +54,15 @@ IN: xml.interpolate.tests
 [ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml-chunk>string ] unit-test
 [ "<x></x>" ] [ f [XML <x><-></x> XML] xml-chunk>string ] unit-test
 
-\ parse-def must-infer
-[ "" interpolate-chunk ] must-infer
+\ <XML must-infer
+[ { } "" interpolate-xml ] must-infer
 [ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer
+
+[ xml-chunk ] [ [ [XML <foo/> XML] ] first class ] unit-test
+[ xml ] [ [ <XML <foo/> XML> ] first class ] unit-test
+[ xml-chunk ] [ [ [XML <foo val=<->/> XML] ] third class ] unit-test
+[ xml ] [ [ <XML <foo val=<->/> XML> ] third class ] unit-test
+[ 1 ] [ [ [XML <foo/> XML] ] length ] unit-test
+[ 1 ] [ [ <XML <foo/> XML> ] length ] unit-test
+
+[ "" ] [ [XML XML] concat ] unit-test

basis/xml/interpolate/interpolate.factor

@@ -64,14 +64,18 @@ M: interpolated interpolate-item
 
 : number<-> ( doc -- dup )
     0 over [
-        dup var>> [ over >>var [ 1+ ] dip ] unless drop
+        dup var>> [
+            over >>var [ 1+ ] dip
+        ] unless drop
     ] each-interpolated drop ;
 
-MACRO: interpolate-xml ( string -- doc )
-    string>doc number<-> '[ _ interpolate-xml-doc ] ;
+GENERIC: interpolate-xml ( table xml -- xml )
 
-MACRO: interpolate-chunk ( string -- chunk )
-    string>chunk number<-> '[ _ interpolate-sequence ] ;
+M: xml interpolate-xml
+    interpolate-xml-doc ;
+
+M: xml-chunk interpolate-xml
+    interpolate-sequence <xml-chunk> ;
 
 : >search-hash ( seq -- hash )
     [ dup search ] H{ } map>assoc ;
@@ -82,26 +86,24 @@ MACRO: interpolate-chunk ( string -- chunk )
 : nenum ( ... n -- assoc )
     narray <enum> ; inline
 
-: collect ( accum seq -- accum )
+: collect ( accum variables -- accum ? )
     {
-        { [ dup [ ] all? ] [ >search-hash parsed ] } ! locals
-        { [ dup [ not ] all? ] [ ! fry
-            length parsed \ nenum parsed
-        ] }
+        { [ dup empty? ] [ drop f ] } ! Just a literal
+        { [ dup [ ] all? ] [ >search-hash parsed t ] } ! locals
+        { [ dup [ not ] all? ] [ length parsed \ nenum parsed t ] } ! fry
         [ drop "XML interpolation contains both fry and locals" throw ] ! mixed
     } cond ;
 
-: parse-def ( accum delimiter word -- accum )
-    [
-        parse-multiline-string but-last
-        [ string>chunk extract-variables collect ] keep
-        parsed
-    ] dip parsed ;
+: parse-def ( accum delimiter quot -- accum )
+    [ parse-multiline-string 1 short head* ] dip call
+    [ extract-variables collect ] keep swap
+    [ number<-> parsed ] dip
+    [ \ interpolate-xml parsed ] when ; inline
 
 PRIVATE>
 
 : <XML
-    "XML>" \ interpolate-xml parse-def ; parsing
+    "XML>" [ string>doc ] parse-def ; parsing
 
 : [XML
-    "XML]" \ interpolate-chunk parse-def ; parsing
+    "XML]" [ string>chunk ] parse-def ; parsing