diff --git a/core/classes/classes-docs.factor b/core/classes/classes-docs.factor
index 130844e797..147714692d 100644
--- a/core/classes/classes-docs.factor
+++ b/core/classes/classes-docs.factor
@@ -5,7 +5,7 @@ classes.predicate ;
IN: classes
ARTICLE: "builtin-classes" "Built-in classes"
-"Every object is an instance of to exactly one canonical " { $emphasis "built-in class" } " which defines its layout in memory and basic behavior."
+"Every object is an instance of exactly one canonical " { $emphasis "built-in class" } " which defines its layout in memory and basic behavior."
$nl
"Corresponding to every built-in class is a built-in type number. An object can be asked for its built-in type number:"
{ $subsection type }
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index de10e5c2e4..2902f574eb 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -221,7 +221,8 @@ TUPLE: column seq col ;
C: <column> column
M: column virtual-seq column-seq ;
-M: column virtual@ dup column-col -rot column-seq nth ;
+M: column virtual@
+ dup column-col -rot column-seq nth bounds-check ;
M: column length column-seq length ;
INSTANCE: column virtual-sequence
@@ -546,11 +547,6 @@ M: sequence <=>
: all-eq? ( seq -- ? ) [ eq? ] monotonic? ;
-: flip ( matrix -- newmatrix )
- dup empty? [
- dup first length [ <column> dup like ] curry* map
- ] unless ;
-
: exchange ( m n seq -- )
pick over bounds-check 2drop 2dup bounds-check 2drop
exchange-unsafe ;
@@ -667,7 +663,19 @@ PRIVATE>
: infimum ( seq -- n ) dup first [ min ] reduce ;
: supremum ( seq -- n ) dup first [ max ] reduce ;
+: flip ( matrix -- newmatrix )
+ dup empty? [
+ dup [ length ] map infimum
+ [ <column> dup like ] curry* map
+ ] unless ;
+
+: sequence-hashcode-step ( oldhash newpart -- newhash )
+ swap [
+ dup -2 fixnum-shift >fixnum swap 5 fixnum-shift >fixnum
+ fixnum+fast fixnum+fast
+ ] keep bitxor ; inline
+
: sequence-hashcode ( n seq -- x )
0 -rot [
- hashcode* >fixnum swap 31 fixnum*fast fixnum+fast
+ hashcode* >fixnum sequence-hashcode-step
] curry* each ; inline
diff --git a/core/slots/slots-docs.factor b/core/slots/slots-docs.factor
index 04db98c9b2..d8c8f5fbba 100644
--- a/core/slots/slots-docs.factor
+++ b/core/slots/slots-docs.factor
@@ -9,7 +9,6 @@ ARTICLE: "slots" "Slots"
$nl
{ $link "tuples" } " are composed entirely of slots, and instances of " { $link "builtin-classes" } " consist of slots together with intrinsic data."
$nl
-"The "
"The " { $snippet "\"slots\"" } " word property of built-in and tuple classes holds an array of " { $emphasis "slot specifiers" } " describing the slot layout of each instance."
{ $subsection slot-spec }
"Each slot has a reader word; mutable slots have an optional writer word. All tuple slots are mutable, but some slots on built-in classes are not."
diff --git a/extra/faq/faq.factor b/extra/faq/faq.factor
index 9f39b33dc6..f10e6481fa 100644
--- a/extra/faq/faq.factor
+++ b/extra/faq/faq.factor
@@ -9,7 +9,7 @@ IN: faq
over >r find r> rot 1+ tail ; inline
: tag-named? ( tag name -- ? )
- assure-name swap (get-tag) ;
+ assure-name swap tag-named? ;
! Questions
TUPLE: q/a question answer ;
diff --git a/extra/xml/data/data.factor b/extra/xml/data/data.factor
index 58ff2a3f6c..725d6da3cc 100644
--- a/extra/xml/data/data.factor
+++ b/extra/xml/data/data.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2005, 2006 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences sequences.private assocs arrays ;
+USING: kernel sequences sequences.private assocs arrays vectors ;
IN: xml.data
TUPLE: name space tag url ;
@@ -60,7 +60,8 @@ M: attrs set-at
2dup attr@ nip [
2nip set-second
] [
- >r assure-name swap 2array r> push
+ [ >r assure-name swap 2array r> ?push ] keep
+ set-delegate
] if* ;
M: attrs assoc-size length ;
@@ -68,14 +69,15 @@ M: attrs new-assoc drop V{ } new <attrs> ;
M: attrs >alist delegate >alist ;
: >attrs ( assoc -- attrs )
- V{ } assoc-clone-like
- [ >r assure-name r> ] assoc-map
- <attrs> ;
+ dup [
+ V{ } assoc-clone-like
+ [ >r assure-name r> ] assoc-map
+ ] when <attrs> ;
M: attrs assoc-like
drop dup attrs? [ >attrs ] unless ;
M: attrs clear-assoc
- delete-all ;
+ f swap set-delegate ;
M: attrs delete-at
tuck attr@ drop [ swap delete-nth ] [ drop ] if* ;
diff --git a/extra/xml/utilities/utilities.factor b/extra/xml/utilities/utilities.factor
index 303de4295e..2ce4e2b3d3 100644
--- a/extra/xml/utilities/utilities.factor
+++ b/extra/xml/utilities/utilities.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces sequences words io assocs
quotations strings parser arrays xml.data xml.writer debugger
-splitting ;
+splitting vectors ;
IN: xml.utilities
! * System for words specialized on tag names
@@ -36,14 +36,16 @@ M: process-missing error.
! * Common utility functions
: build-tag* ( items name -- tag )
- "" swap "" <name>
- swap >r { } r> <tag> ;
+ assure-name swap >r f r> <tag> ;
: build-tag ( item name -- tag )
>r 1array r> build-tag* ;
+: standard-prolog ( -- prolog )
+ T{ prolog f "1.0" "iso-8859-1" f } ;
+
: build-xml ( tag -- xml )
- T{ prolog f "1.0" "iso-8859-1" f } { } rot { } <xml> ;
+ standard-prolog { } rot { } <xml> ;
: children>string ( tag -- string )
tag-children
@@ -111,30 +113,54 @@ M: object xml-inject 2drop ;
M: xml xml-inject >r delegate >r xml-inject ;
! * Accessing part of an XML document
+! for tag- words, a start means that it searches all children
+! and no star searches only direct children
-: get-id ( tag id -- elem ) ! elem=tag.getElementById(id)
- swap [
- dup tag?
- [ "id" swap at over = ]
- [ drop f ] if
- ] xml-find nip ;
-
-: (get-tag) ( name elem -- ? )
+: tag-named? ( name elem -- ? )
dup tag? [ names-match? ] [ 2drop f ] if ;
: tag-named* ( tag name/string -- matching-tag )
- assure-name swap [ dupd (get-tag) ] xml-find nip ;
+ assure-name swap [ dupd tag-matches? ] xml-find nip ;
: tags-named* ( tag name/string -- tags-seq )
- assure-name swap [ dupd (get-tag) ] xml-subset nip ;
+ assure-name swap [ dupd tag-matches? ] xml-subset nip ;
: tag-named ( tag name/string -- matching-tag )
! like get-name-tag but only looks at direct children,
! not all the children down the tree.
- assure-name swap [ (get-tag) ] curry* find nip ;
+ assure-name swap [ tag-matches? ] curry* find nip ;
: tags-named ( tag name/string -- tags-seq )
- assure-name swap [ (get-tag) ] curry* subset ;
+ assure-name swap [ tag-matches? ] curry* subset ;
: assert-tag ( name name -- )
names-match? [ "Unexpected XML tag found" throw ] unless ;
+
+: insert-children ( children tag -- )
+ dup tag-children [ push-all ]
+ [ >r V{ } like r> set-tag-children ] if ;
+
+: insert-child ( child tag -- )
+ >r 1vector r> insert-children ;
+
+: tag-with-attr? ( elem attr-value attr-name -- ? )
+ rot dup tag? [ at = ] [ drop f ] if ;
+
+: tag-with-attr ( tag attr-value attr-name -- matching-tag )
+ assure-name [ tag-with-attr? ] 2curry find nip ;
+
+: tags-with-attr ( tag attr-value attr-name -- tags-seq )
+ assure-name [ tag-with-attr? ] 2curry subset ;
+
+: tag-with-attr* ( tag attr-value attr-name -- matching-tag )
+ assure-name [ tag-with-attr? ] 2curry xml-find nip ;
+
+: tags-with-attr* ( tag attr-value attr-name -- tags-seq )
+ assure-name [ tag-with-attr? ] 2curry xml-subset ;
+
+: get-id ( tag id -- elem ) ! elem=tag.getElementById(id)
+ "id" tag-with-attr ;
+
+: tags-named-with-attr* ( tag tag-name attr-value attr-name -- tags )
+ >r >r tags-named* r> r> tags-with-attr ;
+