diff --git a/extra/inverse/authors.txt b/basis/inverse/authors.txt
similarity index 100%
rename from extra/inverse/authors.txt
rename to basis/inverse/authors.txt
diff --git a/extra/inverse/inverse-docs.factor b/basis/inverse/inverse-docs.factor
similarity index 100%
rename from extra/inverse/inverse-docs.factor
rename to basis/inverse/inverse-docs.factor
diff --git a/extra/inverse/inverse-tests.factor b/basis/inverse/inverse-tests.factor
similarity index 100%
rename from extra/inverse/inverse-tests.factor
rename to basis/inverse/inverse-tests.factor
diff --git a/extra/inverse/inverse.factor b/basis/inverse/inverse.factor
similarity index 100%
rename from extra/inverse/inverse.factor
rename to basis/inverse/inverse.factor
diff --git a/extra/inverse/summary.txt b/basis/inverse/summary.txt
similarity index 100%
rename from extra/inverse/summary.txt
rename to basis/inverse/summary.txt
diff --git a/extra/inverse/tags.txt b/basis/inverse/tags.txt
similarity index 100%
rename from extra/inverse/tags.txt
rename to basis/inverse/tags.txt
diff --git a/basis/xml/literals/literals-tests.factor b/basis/xml/literals/literals-tests.factor
index ec68a034a6..0d8367c144 100644
--- a/basis/xml/literals/literals-tests.factor
+++ b/basis/xml/literals/literals-tests.factor
@@ -66,3 +66,37 @@ IN: xml.literals.tests
[ 1 ] [ [ XML> ] length ] unit-test
[ "" ] [ [XML XML] concat ] unit-test
+
+USE: inverse
+
+[ "foo" ] [ [XML foo XML] [ [XML <-> XML] ] undo ] unit-test
+[ "foo" ] [ [XML XML] [ [XML /> XML] ] undo ] unit-test
+[ "foo" "baz" ] [ [XML baz XML] [ [XML ><-> XML] ] undo ] unit-test
+
+: dispatch ( xml -- string )
+ {
+ { [ [XML <-> XML] ] [ "a" prepend ] }
+ { [ [XML <-> XML] ] [ "b" prepend ] }
+ { [ [XML XML] ] [ "byes" ] }
+ { [ [XML /> XML] ] [ "bno" prepend ] }
+ } switch ;
+
+[ "apple" ] [ [XML pple XML] dispatch ] unit-test
+[ "banana" ] [ [XML anana XML] dispatch ] unit-test
+[ "byes" ] [ [XML XML] dispatch ] unit-test
+[ "bnowhere" ] [ [XML XML] dispatch ] unit-test
+[ "baboon" ] [ [XML aboon XML] dispatch ] unit-test
+[ "apple" ] [ pple XML> dispatch ] unit-test
+[ "apple" ] [ pple XML> body>> dispatch ] unit-test
+
+: dispatch-doc ( xml -- string )
+ {
+ { [ <-> XML> ] [ "a" prepend ] }
+ { [ <-> XML> ] [ "b" prepend ] }
+ { [ XML> ] [ "byes" ] }
+ { [ /> XML> ] [ "bno" prepend ] }
+ } switch ;
+
+[ "apple" ] [ pple XML> dispatch-doc ] unit-test
+[ "apple" ] [ [XML pple XML] dispatch-doc ] unit-test
+[ "apple" ] [ pple XML> body>> dispatch-doc ] unit-test
diff --git a/basis/xml/literals/literals.factor b/basis/xml/literals/literals.factor
index 1520afdde4..4648f7b0e7 100644
--- a/basis/xml/literals/literals.factor
+++ b/basis/xml/literals/literals.factor
@@ -142,3 +142,73 @@ PRIVATE>
: [XML
"XML]" [ string>chunk ] parse-def ; parsing
+
+USING: inverse sorting fry combinators.short-circuit ;
+
+: 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 ;
+
+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 ;
+
+: undo-xml ( xml -- quot )
+ [undo-xml] '[ H{ } clone [ _ bind ] keep >enum ] ;
+
+\ interpolate-xml 1 [ undo-xml ] define-pop-inverse