Making xml literal inverse behavior only load if inverse is loaded

diff --git a/basis/xml/syntax/inverse/inverse.factor b/basis/xml/syntax/inverse/inverse.factor
new file mode 100644 (file)
index 0000000..002f60a
--- /dev/null
+++ b/basis/xml/syntax/inverse/inverse.factor
@@ -0,0 +1,75 @@
+! Copyright (C) 2005, 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs combinators
+combinators.short-circuit fry generalizations inverse kernel
+namespaces sequences sorting strings unicode.categories
+xml.data xml.syntax xml.syntax.private ;
+IN: xml.syntax.inverse
+
+: remove-blanks ( seq -- newseq )
+    [ { [ string? not ] [ [ blank? ] all? not ] } 1|| ] filter ;
+
+GENERIC: >xml ( xml -- tag )
+M: xml >xml body>> ;
+M: tag >xml ;
+M: xml-chunk >xml
+    remove-blanks
+    [ length 1 =/fail ]
+    [ first dup tag? [ fail ] unless ] bi ;
+M: object >xml fail ;
+
+: 1chunk ( object -- xml-chunk )
+    1array <xml-chunk> ;
+
+GENERIC: >xml-chunk ( xml -- chunk )
+M: xml >xml-chunk body>> 1chunk ;
+M: xml-chunk >xml-chunk ;
+M: object >xml-chunk 1chunk ;
+
+GENERIC: [undo-xml] ( xml -- quot )
+
+M: xml [undo-xml]
+    body>> [undo-xml] '[ >xml @ ] ;
+
+M: xml-chunk [undo-xml]
+    seq>> [undo-xml] '[ >xml-chunk @ ] ;
+
+: undo-attrs ( attrs -- quot: ( attrs -- ) )
+    [
+        [ main>> ] dip dup interpolated?
+        [ var>> '[ _ attr _ set ] ]
+        [ '[ _ attr _ =/fail ] ] if
+    ] { } assoc>map '[ _ cleave ] ;
+
+M: tag [undo-xml] ( tag -- quot: ( tag -- ) )
+    {
+        [ name>> main>> '[ name>> main>> _ =/fail ] ]
+        [ attrs>> undo-attrs ] 
+        [ children>> [undo-xml] '[ children>> @ ] ]
+    } cleave '[ _ _ _ tri ] ;
+
+: firstn-strong ( seq n -- ... )
+    [ swap length =/fail ]
+    [ firstn ] 2bi ; inline
+
+M: sequence [undo-xml] ( sequence -- quot: ( seq -- ) )
+    remove-blanks [ length ] [ [ [undo-xml] ] { } map-as ] bi
+    '[ remove-blanks _ firstn-strong _ spread ] ;
+
+M: string [undo-xml] ( string -- quot: ( string -- ) )
+    '[ _ =/fail ] ;
+
+M: xml-data [undo-xml] ( datum -- quot: ( datum -- ) )
+    '[ _ =/fail ] ;
+
+M: interpolated [undo-xml]
+    var>> '[ _ set ] ;
+
+: >enum ( assoc -- enum )
+    ! Assumes keys are 0..n
+    >alist sort-keys values <enum> ;
+
+: undo-xml ( xml -- quot )
+    [undo-xml] '[ H{ } clone [ _ bind ] keep >enum ] ;
+
+\ interpolate-xml 1 [ undo-xml ] define-pop-inverse

diff --git a/basis/xml/syntax/syntax.factor b/basis/xml/syntax/syntax.factor
index c56dd23db75b1eb26864dafeec1a777f6efb6cc9..a58526faa36c7cfbff04b2abc68d6e204cf7ad80 100644 (file)
--- a/basis/xml/syntax/syntax.factor
+++ b/basis/xml/syntax/syntax.factor
@@ -4,7 +4,7 @@ USING: words assocs kernel accessors parser vocabs.parser effects.parser
 sequences summary lexer splitting combinators locals
 memoize sequences.deep xml.data xml.state xml namespaces present
 arrays generalizations strings make math macros multiline
-inverse combinators.short-circuit sorting fry unicode.categories
+combinators.short-circuit sorting fry unicode.categories
 effects ;
 IN: xml.syntax
 
@@ -175,74 +175,6 @@ SYNTAX: <XML
 SYNTAX: [XML
     "XML]" [ string>chunk ] parse-def ;
 
-<PRIVATE
-
-: remove-blanks ( seq -- newseq )
-    [ { [ string? not ] [ [ blank? ] all? not ] } 1|| ] filter ;
-
-GENERIC: >xml ( xml -- tag )
-M: xml >xml body>> ;
-M: tag >xml ;
-M: xml-chunk >xml
-    remove-blanks
-    [ length 1 =/fail ]
-    [ first dup tag? [ fail ] unless ] bi ;
-M: object >xml fail ;
-
-: 1chunk ( object -- xml-chunk )
-    1array <xml-chunk> ;
-
-GENERIC: >xml-chunk ( xml -- chunk )
-M: xml >xml-chunk body>> 1chunk ;
-M: xml-chunk >xml-chunk ;
-M: object >xml-chunk 1chunk ;
-
-GENERIC: [undo-xml] ( xml -- quot )
+USE: vocabs.loader
 
-M: xml [undo-xml]
-    body>> [undo-xml] '[ >xml @ ] ;
-
-M: xml-chunk [undo-xml]
-    seq>> [undo-xml] '[ >xml-chunk @ ] ;
-
-: undo-attrs ( attrs -- quot: ( attrs -- ) )
-    [
-        [ main>> ] dip dup interpolated?
-        [ var>> '[ _ attr _ set ] ]
-        [ '[ _ attr _ =/fail ] ] if
-    ] { } assoc>map '[ _ cleave ] ;
-
-M: tag [undo-xml] ( tag -- quot: ( tag -- ) )
-    {
-        [ name>> main>> '[ name>> main>> _ =/fail ] ]
-        [ attrs>> undo-attrs ] 
-        [ children>> [undo-xml] '[ children>> @ ] ]
-    } cleave '[ _ _ _ tri ] ;
-
-: firstn-strong ( seq n -- ... )
-    [ swap length =/fail ]
-    [ firstn ] 2bi ; inline
-
-M: sequence [undo-xml] ( sequence -- quot: ( seq -- ) )
-    remove-blanks [ length ] [ [ [undo-xml] ] { } map-as ] bi
-    '[ remove-blanks _ firstn-strong _ spread ] ;
-
-M: string [undo-xml] ( string -- quot: ( string -- ) )
-    '[ _ =/fail ] ;
-
-M: xml-data [undo-xml] ( datum -- quot: ( datum -- ) )
-    '[ _ =/fail ] ;
-
-M: interpolated [undo-xml]
-    var>> '[ _ set ] ;
-
-: >enum ( assoc -- enum )
-    ! Assumes keys are 0..n
-    >alist sort-keys values <enum> ;
-
-: undo-xml ( xml -- quot )
-    [undo-xml] '[ H{ } clone [ _ bind ] keep >enum ] ;
-
-\ interpolate-xml 1 [ undo-xml ] define-pop-inverse
-
-PRIVATE>
+"inverse" "xml.syntax.inverse" require-when