factor: trim using lists

[factor.git] / basis / xml / elements / elements.factor

diff --git a/basis/xml/elements/elements.factor b/basis/xml/elements/elements.factor
index 57e91cc24e125f3e306a60c6a4696965691e5d37..042cde931e7926136c58bbfca63c56f629926b7e 100644 (file)
--- a/basis/xml/elements/elements.factor
+++ b/basis/xml/elements/elements.factor
@@ -1,14 +1,13 @@
 ! Copyright (C) 2005, 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces xml.tokenize xml.state xml.name
-xml.data accessors arrays make xml.char-classes fry assocs sequences
-math xml.errors sets combinators io.encodings io.encodings.iana
-unicode.case xml.dtd strings xml.entities unicode.categories ;
+USING: arrays assocs combinators kernel make math namespaces
+sequences sets strings unicode xml.char-classes xml.data xml.dtd
+xml.errors xml.name xml.state xml.tokenize ;
 IN: xml.elements
 
 : take-interpolated ( quot -- interpolated )
     interpolating? get [
-        drop get-char CHAR: > =
+        drop get-char CHAR: > eq?
         [ next f ]
         [ "->" take-string [ blank? ] trim ]
         if <interpolated>
@@ -17,33 +16,30 @@ IN: xml.elements
 : interpolate-quote ( -- interpolated )
     [ quoteless-attr ] take-interpolated ;
 
-: parse-attr ( -- )
-    parse-name pass-blank "=" expect pass-blank
-    get-char CHAR: < =
-    [ "<-" expect interpolate-quote ]
-    [ t parse-quote* ] if 2array , ;
-
 : start-tag ( -- name ? )
-    #! Outputs the name and whether this is a closing tag
-    get-char CHAR: / = dup [ next ] when
+    ! 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 >alist
+    [ 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
-    [ (middle-tag) ] f make pass-blank
-    assure-no-duplicates ;
+    ! f produce-as will make a vector if it has any elements
+    [ 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 )
-    tag-ns pass-blank get-char CHAR: / =
+    tag-ns pass-blank get-char CHAR: / eq?
     [ pop-ns <contained> next ">" expect ]
     [ depth inc <opener> close ] if ;
 
@@ -59,17 +55,19 @@ IN: xml.elements
         T{ name f "" "encoding" f }
         T{ name f "" "standalone" f }
     } diff
-    [ extra-attrs ] unless-empty ; 
+    [ extra-attrs ] unless-empty ;
 
 : good-version ( version -- version )
     dup { "1.0" "1.1" } member? [ bad-version ] unless ;
 
 : prolog-version ( alist -- version )
-    T{ name f "" "version" f } swap at
-    [ good-version ] [ versionless-prolog ] if* ;
+    T{ name { space "" } { main "version" } } of
+    [ good-version ] [ versionless-prolog ] if*
+    dup set-version ;
 
 : prolog-encoding ( alist -- encoding )
-    T{ name f "" "encoding" f } swap at "UTF-8" or ;
+    T{ name { space "" } { main "encoding" } } of
+    "UTF-8" or ;
 
 : yes/no>bool ( string -- t/f )
     {
@@ -79,7 +77,7 @@ IN: xml.elements
     } case ;
 
 : prolog-standalone ( alist -- version )
-    T{ name f "" "standalone" f } swap at
+    T{ name { space "" } { main "standalone" } } of
     [ yes/no>bool ] [ f ] if* ;
 
 : prolog-attrs ( alist -- prolog )
@@ -88,16 +86,9 @@ IN: xml.elements
     [ prolog-standalone ]
     tri <prolog> ;
 
-SYMBOL: string-input?
-: decode-input-if ( encoding -- )
-    string-input? get [ drop ] [ decode-input ] if ;
-
 : parse-prolog ( -- prolog )
     pass-blank middle-tag "?>" expect
-    dup assure-no-extra prolog-attrs
-    dup encoding>> dup "UTF-16" =
-    [ drop ] [ name>encoding [ decode-input-if ] when* ] if
-    dup prolog-data set ;
+    dup assure-no-extra prolog-attrs ;
 
 : instruct ( -- instruction )
     take-name {
@@ -129,8 +120,8 @@ DEFER: make-tag ! Is this unavoidable?
 
 : take-internal-subset ( -- dtd )
     [
-        H{ } clone pe-table set
-        t in-dtd? set
+        H{ } clone pe-table namespaces:set
+        t in-dtd? namespaces:set
         dtd-loop
         pe-table get
     ] { } make swap extra-entities get swap <dtd> ;
@@ -140,7 +131,7 @@ DEFER: make-tag ! Is this unavoidable?
     [ take-external-id ] [ f ] if ;
 
 : take-internal ( -- dtd/f )
-    get-char CHAR: [ =
+    get-char CHAR: [ eq?
     [ next take-internal-subset ] [ f ] if ;
 
 : take-doctype-decl ( -- doctype-decl )
@@ -173,9 +164,9 @@ DEFER: make-tag ! Is this unavoidable?
     [ "-" bad-name ] take-interpolated ;
 
 : make-tag ( -- tag )
-    {
-        { [ get-char dup CHAR: ! = ] [ drop next direct ] }
-        { [ dup CHAR: ? = ] [ drop next instruct ] }
-        { [ dup CHAR: - = ] [ drop next interpolate-tag ] }
+    get-char {
+        { CHAR: ! [ next direct ] }
+        { CHAR: ? [ next instruct ] }
+        { CHAR: - [ next interpolate-tag ] }
         [ drop normal-tag ]
-    } cond ;
+    } case ;