xml: 10-12% faster benchmark through cleanup and minor refactoring.

basis/xml/data/data.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences sequences.private assocs arrays
 delegate.protocols delegate vectors accessors multiline
-macros words quotations combinators slots fry strings ;
+macros words quotations combinators slots fry strings
+combinators.short-circuit ;
 IN: xml.data
 
 TUPLE: interpolated var ;
@@ -18,9 +19,11 @@ C: <name> name
     2dup and [ = ] [ 2drop t ] if ;
 
 : names-match? ( name1 name2 -- ? )
-    [ [ space>> ] bi@ ?= ]
+    {
-    [ [ url>> ] bi@ ?= ]
+        [ [ space>> ] bi@ ?= ]
-    [ [ main>> ] bi@ ?= ] 2tri and and ;
+        [ [ url>> ] bi@ ?= ]
+        [ [ main>> ] bi@ ?= ]
+    } 2&& ;
 
 : <simple-name> ( string -- name )
     "" swap f <name> ;

basis/xml/elements/elements.factor

@@ -18,29 +18,26 @@ IN: xml.elements
 : interpolate-quote ( -- interpolated )
     [ quoteless-attr ] take-interpolated ;
 
-: parse-attr ( -- )
-    parse-name pass-blank "=" expect pass-blank
-    get-char CHAR: < eq?
-    [ "<-" expect interpolate-quote ]
-    [ t parse-quote* ] if 2array , ;
-
 : start-tag ( -- name ? )
     #! Outputs the name and whether this is a closing tag
     get-char CHAR: / eq? dup [ next ] when
     parse-name swap ;
 
-: (middle-tag) ( -- )
-    pass-blank version-1.0? get-char name-start?
-    [ parse-attr (middle-tag) ] when ;
-
 : assure-no-duplicates ( attrs-alist -- attrs-alist )
     H{ } clone 2dup '[ swap _ push-at ] assoc-each
     [ nip length 2 >= ] { } assoc-filter-as
     [ first first2 duplicate-attr ] unless-empty ;
 
+: parse-attr ( -- array )
+    parse-name pass-blank "=" expect pass-blank
+    get-char CHAR: < eq?
+    [ "<-" expect interpolate-quote ]
+    [ t parse-quote* ] if 2array ;
+
 : middle-tag ( -- attrs-alist )
-    ! f make will make a vector if it has any elements
+    ! f produce-as will make a vector if it has any elements
-    [ (middle-tag) ] f make pass-blank
+    [ pass-blank version-1.0? get-char name-start? ]
+    [ parse-attr ] f produce-as pass-blank
     dup length 1 > [ assure-no-duplicates ] when ;
 
 : end-tag ( name attrs-alist -- tag )

basis/xml/name/name.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel namespaces accessors xml.tokenize xml.data assocs
 xml.errors xml.char-classes combinators.short-circuit splitting
-fry xml.state sequences combinators ascii ;
+fry xml.state sequences combinators ascii math ;
 IN: xml.name
 
 ! XML namespace processing: ns = namespace
@@ -53,11 +53,19 @@ SYMBOL: ns-stack
         } 2&&
     ] if-empty ;
 
+: maybe-name ( space main -- name/f )
+    2dup {
+        [ drop valid-name? ]
+        [ nip valid-name? ]
+    } 2&& [ f <name> ] [ 2drop f ] if ;
+
 : prefixed-name ( str -- name/f )
-    ":" split dup length 2 = [
+    CHAR: : over index [
-        [ [ valid-name? ] all? ]
+        CHAR: : 2over 1 + swap index-from
-        [ first2 f <name> ] bi and
+        [ 2drop f ]
-    ] [ drop f ] if ;
+        [ [ head ] [ 1 + tail ] 2bi maybe-name ]
+        if
+    ] [ drop f ] if* ;
 
 : interpret-name ( str -- name )
     dup prefixed-name [ ] [

basis/xml/tokenize/tokenize.factor

@@ -3,16 +3,17 @@
 USING: namespaces xml.state kernel sequences accessors
 xml.char-classes xml.errors math io sbufs fry strings ascii
 xml.entities assocs splitting math.parser
-locals combinators arrays hints ;
+locals combinators combinators.short-circuit arrays hints ;
 IN: xml.tokenize
 
 ! * Basic utility words
 
 : assure-good-char ( spot ch -- )
     [
-        over
+        over {
-        [ version-1.0?>> over text? not ]
+            [ version-1.0?>> over text? not ]
-        [ check>> ] bi and
+            [ check>> ]
+        } 1&&
         [
             [ [ 1 + ] change-column drop ] dip
             disallowed-char

basis/xml/writer/writer.factor

@@ -34,7 +34,7 @@ SYMBOL: indentation
 : ?filter-children ( children -- no-whitespace )
     xml-pprint? get [
         [ dup string? [ [ blank? ] trim ] when ] map
-        [ [ empty? ] [ string? ] bi and not ] filter
+        [ "" = not ] filter
     ] when ;
 
 PRIVATE>

basis/xml/xml.factor

@@ -89,7 +89,7 @@ M: closer process
     [ drop default-prolog ] unless ;
 
 : cut-prolog ( seq -- newseq )
-    [ [ prolog? not ] [ "" = not ] bi and ] filter ;
+    [ { [ prolog? not ] [ "" = not ] } 1&& ] filter ;
 
 : make-xml-doc ( seq -- xml-doc )
     [ get-prolog ] keep