From 055cb66e0f7134a3c87f4fc00f4f2547877ae875 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Mon, 27 Mar 2006 08:10:58 +0000
Subject: [PATCH] Abstract out word cross-referencing into a graph library;
 implement help cross-referencing

---
 TODO.FACTOR.txt                       |   5 +-
 doc/handbook/words.facts              |   2 +-
 library/alien/alien-invoke.factor     |   2 +-
 library/bootstrap/boot-stage1.factor  |   6 +-
 library/bootstrap/boot-stage2.factor  |   8 +-
 library/bootstrap/image.factor        |   2 +-
 library/bootstrap/primitives.factor   |   7 +-
 library/collections/graphs.factor     |  52 +++++++++++++
 library/collections/namespaces.factor |  22 ------
 library/help/crossref.factor          |  21 ++++--
 library/help/database.factor          |  39 ----------
 library/help/help.factor              |  40 ++++++++--
 library/help/markup.factor            |   4 +-
 library/ui/browser.factor             |   2 +
 library/vocabularies.factor           |  66 -----------------
 library/vocabularies.facts            |  83 ---------------------
 library/words.factor                  | 101 +++++++++++++++++++-------
 library/words.facts                   |  88 ++++++++++++++++++++--
 18 files changed, 282 insertions(+), 268 deletions(-)
 create mode 100644 library/collections/graphs.factor
 delete mode 100644 library/help/database.factor
 delete mode 100644 library/vocabularies.factor
 delete mode 100644 library/vocabularies.facts

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index aa55b53f10..5bc0977423 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -42,16 +42,15 @@
   http://twb.ath.cx/~twb/darcs/OBSOLETE/factor/final.html
 - fix remaining HTML stream issues
 - fix up the min thumb size hack
-- help cross-referencing
+- automatically update help graph when adding/removing articles/words
 - document conventions
 - new turtle graphics tutorial
 - better line spacing in ui and html
-- tabular formatting - for inspector and changes
+- tabular formatting - for inspector, changes and $values in help
 - grid layout
 - variable width word wrap
 - fix top level window positioning
 - changing window titles
-- remove distinction between a word and a link to a word
 
 + compiler/ffi:
 
diff --git a/doc/handbook/words.facts b/doc/handbook/words.facts
index cdd4f2faf7..e6eac9f82e 100644
--- a/doc/handbook/words.facts
+++ b/doc/handbook/words.facts
@@ -136,7 +136,7 @@ ARTICLE: "word-crossref" "Cross-referencing"
 { $subsection usage }
 { $subsection usages }
 "In most cases the cross-reference database is maintained automatically, but if you do something unusual you might need to update it manually."
-{ $subsection recrossref } ;
+{ $subsection xref-words } ;
 
 ARTICLE: "word-internals" "Word implementation details"
 "The behavior of a word when executed depends on the values of two slots:"
diff --git a/library/alien/alien-invoke.factor b/library/alien/alien-invoke.factor
index 6cf2695acc..2fd432ed23 100644
--- a/library/alien/alien-invoke.factor
+++ b/library/alien/alien-invoke.factor
@@ -88,7 +88,7 @@ M: alien-invoke stack-reserve*
     [ "()" subseq? not ] subset >r pick r> parse-arglist
     (define-c-word) ;
 
-M: compound (uncrossref)
+M: compound unxref-word*
     dup word-def \ alien-invoke swap member?
     over "infer" word-prop or [
         drop
diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor
index 1c226799d2..226f80719e 100644
--- a/library/bootstrap/boot-stage1.factor
+++ b/library/bootstrap/boot-stage1.factor
@@ -43,6 +43,7 @@ vectors words ;
         "/library/collections/lists.factor"
         "/library/collections/flatten.factor"
         "/library/collections/queues.factor"
+        "/library/collections/graphs.factor"
 
         "/library/math/random.factor"
         "/library/math/constants.factor"
@@ -53,7 +54,6 @@ vectors words ;
         "/library/math/parse-numbers.factor"
 
         "/library/words.factor"
-        "/library/vocabularies.factor"
         "/library/continuations.factor"
         "/library/errors.factor"
         
@@ -84,13 +84,12 @@ vectors words ;
 
         "/library/tools/interpreter.factor"
         
-        "/library/help/database.factor"
         "/library/help/stylesheet.factor"
         "/library/help/help.factor"
         "/library/help/markup.factor"
         "/library/help/word-help.factor"
-        "/library/help/syntax.factor"
         "/library/help/crossref.factor"
+        "/library/help/syntax.factor"
         
         "/library/tools/describe.factor"
         "/library/tools/debugger.factor"
@@ -193,7 +192,6 @@ vectors words ;
         "/library/errors.facts"
         "/library/kernel.facts"
         "/library/threads.facts"
-        "/library/vocabularies.facts"
         "/library/words.facts"
         "/library/alien/alien-callback.facts"
         "/library/alien/alien-invoke.facts"
diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor
index 69fd74cc85..ce47aba771 100644
--- a/library/bootstrap/boot-stage2.factor
+++ b/library/bootstrap/boot-stage2.factor
@@ -1,12 +1,12 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: compiler compiler-backend io io-internals kernel
+USING: compiler compiler-backend help io io-internals kernel
 kernel-internals lists math memory namespaces optimizer parser
 sequences sequences-internals words ;
 
-"Building cross-referencing database..." print
-H{ } clone crossref set
-recrossref
+"Cross-referencing..." print
+xref-words
+xref-articles
 
 "compile" get [
     "native-io" get [
diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor
index df7f7ece14..06387cf3fc 100644
--- a/library/bootstrap/image.factor
+++ b/library/bootstrap/image.factor
@@ -303,7 +303,7 @@ M: hashtable ' ( hashtable -- pointer )
     [
         {
             vocabularies typemap builtins c-types crossref
-            articles terms
+            articles terms help-graph
         }
         [ [ ] change ] each
     ] make-hash '
diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index 2485a7391d..d1b6fcd024 100644
--- a/library/bootstrap/primitives.factor
+++ b/library/bootstrap/primitives.factor
@@ -24,13 +24,14 @@ H{ } clone c-types set
 "syntax" vocab
 
 H{ } clone vocabularies set
-H{ } clone articles set
-H{ } clone terms set
-
 crossref off
 
 vocabularies get [ "syntax" set [ reveal ] each ] bind
 
+H{ } clone articles set
+H{ } clone terms set
+help-xref off
+
 ! Call the quotation parsed from primitive-types.factor
 call
 
diff --git a/library/collections/graphs.factor b/library/collections/graphs.factor
new file mode 100644
index 0000000000..5b4175a198
--- /dev/null
+++ b/library/collections/graphs.factor
@@ -0,0 +1,52 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: graphs
+USING: hashtables kernel namespaces sequences ;
+
+: if-graph over [ bind ] [ 2drop 2drop ] if ; inline
+
+: (add-vertex) ( vertex edges -- | edges: vertex -- seq )
+    dupd call [ dupd nest set-hash ] each-with ; inline
+
+: add-vertex ( vertex edges graph -- | edges: vertex -- seq )
+    [ (add-vertex) ] if-graph ; inline
+
+: add-vertices ( seq edges graph -- | edges: vertex -- seq )
+    [
+        namespace clear-hash
+        swap [ swap (add-vertex) ] each-with
+    ] if-graph ;
+
+: (remove-vertex) ( vertex graph -- )
+    nest remove-hash ;
+
+: remove-vertex ( vertex edges graph -- )
+    [
+        >r dup dup r> call [ nest remove-hash ] each-with
+        namespace remove-hash
+    ] if-graph ; inline
+
+: in-edges ( vertex graph -- seq )
+    ?hash dup [ hash-keys ] when ;
+
+SYMBOL: hash-buffer
+
+: closure, ( value key -- old )
+    hash-buffer get [ hash swap ] 2keep set-hash ;
+
+: (closure) ( key hash -- )
+    tuck ?hash dup [
+        [
+            drop dup dup closure,
+            [ 2drop ] [ swap (closure) ] if
+        ] hash-each-with
+    ] [
+        2drop
+    ] if ;
+
+: closure ( vertex graph -- seq )
+    [
+        H{ } clone hash-buffer set
+        (closure)
+        hash-buffer get hash-keys
+    ] with-scope ;
diff --git a/library/collections/namespaces.factor b/library/collections/namespaces.factor
index 3b0859fc68..856e64d33f 100644
--- a/library/collections/namespaces.factor
+++ b/library/collections/namespaces.factor
@@ -52,28 +52,6 @@ SYMBOL: building
 
 : # ( n -- ) number>string % ;
 
-SYMBOL: hash-buffer
-
-: closure, ( value key -- old )
-    hash-buffer get [ hash swap ] 2keep set-hash ;
-
-: (closure) ( key hash -- )
-    tuck hash dup [
-        [
-            drop dup dup closure,
-            [ 2drop ] [ swap (closure) ] if
-        ] hash-each-with
-    ] [
-        2drop
-    ] if ;
-
-: closure ( key hash -- list )
-    [
-        H{ } clone hash-buffer set
-        (closure)
-        hash-buffer get hash-keys
-    ] with-scope ;
-
 IN: lists
 
 : alist>quot ( default alist -- quot )
diff --git a/library/help/crossref.factor b/library/help/crossref.factor
index 28b85ad1e7..faa5ceb107 100644
--- a/library/help/crossref.factor
+++ b/library/help/crossref.factor
@@ -1,12 +1,12 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: help
-USING: arrays generic hashtables io kernel lists namespaces
-sequences strings words ;
+USING: arrays generic graphs hashtables io kernel lists
+namespaces sequences strings words ;
 
 : all-articles ( -- seq )
     [
-        articles hash-keys %
+        articles get hash-keys %
         [ word-article ] word-subset %
         terms get hash-keys [ <term> ] map %
     ] { } make ;
@@ -40,8 +40,19 @@ M: array elements*
         \ $subsection swap collect-elements
     ] make-hash hash-keys ;
 
-: links-in ( article -- seq )
-    all-articles [ links-out member? ] subset-with ;
+SYMBOL: help-graph
+
+: links-in ( article -- ) help-graph get in-edges ;
+
+: xref-article ( article -- )
+    [ links-out ] help-graph get add-vertex ;
+
+: unxref-article ( article -- )
+    [ links-out ] help-graph get remove-vertex ;
+
+: xref-articles ( -- )
+    H{ } clone help-graph set
+    all-articles [ links-out ] help-graph get add-vertices ;
 
 : help-outliner ( seq quot -- | quot: obj -- )
     swap sort-articles [ ($subsection) terpri ] each-with ;
diff --git a/library/help/database.factor b/library/help/database.factor
deleted file mode 100644
index 569c28cea5..0000000000
--- a/library/help/database.factor
+++ /dev/null
@@ -1,39 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: help
-USING: arrays hashtables io kernel namespaces parser sequences
-strings styles words ;
-
-! Markup
-GENERIC: print-element
-
-! Help articles
-SYMBOL: articles
-
-TUPLE: article title content ;
-
-: article ( name -- article ) articles get hash ;
-
-: add-article ( name title element -- )
-    <article> swap articles get set-hash ;
-
-M: string article-title article article-title ;
-
-M: string article-content article article-content ;
-
-! Special case: f help
-M: f article-title drop \ f article-title ;
-M: f article-content drop \ f article-content ;
-
-! Glossary of terms
-SYMBOL: terms
-
-TUPLE: term entry ;
-
-M: term article-title term-entry ;
-
-M: term article-content
-    term-entry terms get hash
-    [ "No such glossary entry" ] unless* ;
-
-: add-term ( term element -- ) swap terms get set-hash ;
diff --git a/library/help/help.factor b/library/help/help.factor
index b0e556ee25..fab99258a9 100644
--- a/library/help/help.factor
+++ b/library/help/help.factor
@@ -1,7 +1,41 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: help
-USING: arrays hashtables io kernel namespaces ;
+USING: arrays hashtables io kernel namespaces strings ;
+
+! Markup
+GENERIC: print-element
+
+! Help articles
+SYMBOL: articles
+
+TUPLE: article title content ;
+
+: article ( name -- article ) articles get hash ;
+
+: add-article ( name title element -- )
+    <article> swap articles get set-hash ;
+
+M: string article-title article article-title ;
+
+M: string article-content article article-content ;
+
+! Special case: f help
+M: f article-title drop \ f article-title ;
+M: f article-content drop \ f article-content ;
+
+! Glossary of terms
+SYMBOL: terms
+
+TUPLE: term entry ;
+
+M: term article-title term-entry ;
+
+M: term article-content
+    term-entry terms get hash
+    [ "No such glossary entry" ] unless* ;
+
+: add-term ( term element -- ) swap terms get set-hash ;
 
 SYMBOL: last-block
 
@@ -21,7 +55,3 @@ DEFER: $heading
 : handbook ( -- ) "handbook" help ;
     
 : tutorial ( -- ) "tutorial" help ;
-
-: articles. ( -- )
-    
-    ;
diff --git a/library/help/markup.factor b/library/help/markup.factor
index ffa1367924..c6a4ed155a 100644
--- a/library/help/markup.factor
+++ b/library/help/markup.factor
@@ -129,12 +129,14 @@ DEFER: help
 : $subsection ( object -- )
     [ first [ (help) ] swap ($subsection) ] ($block) ;
 
+: >link ( obj -- obj ) dup string? [ <link> ] when ;
+
 : $link ( article -- )
     last-block off first dup word? [
         pprint
     ] [
         link-style [
-            dup article-title swap <link> simple-object
+            dup article-title swap >link simple-object
         ] with-style
     ] if ;
 
diff --git a/library/ui/browser.factor b/library/ui/browser.factor
index dfd857ee9e..4cb4be1027 100644
--- a/library/ui/browser.factor
+++ b/library/ui/browser.factor
@@ -18,12 +18,14 @@ H{ } clone components set-global
     { "Definition" [ help ] }
     { "Calls in" [ usage. ] }
     { "Calls out" [ uses. ] }
+    { "Links in" [ links-in. ] }
     { "Links out" [ links-out. ] }
     { "Vocabulary" [ word-vocabulary words. ] }
 } \ word components get-global set-hash
 
 {
     { "Article" [ help ] }
+    { "Links in" [ links-in. ] }
     { "Links out" [ links-out. ] }
 } \ link components get-global set-hash
 
diff --git a/library/vocabularies.factor b/library/vocabularies.factor
deleted file mode 100644
index 8747d91459..0000000000
--- a/library/vocabularies.factor
+++ /dev/null
@@ -1,66 +0,0 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: words
-USING: errors hashtables kernel lists namespaces sequences
-strings ;
-
-SYMBOL: bootstrapping?
-
-SYMBOL: vocabularies
-
-: word ( -- word ) \ word get-global ;
-
-: set-word ( word -- ) \ word set-global ;
-
-: vocabs ( -- seq ) vocabularies get hash-keys natural-sort ;
-
-: vocab ( name -- vocab ) vocabularies get hash ;
-
-: ensure-vocab ( name -- ) vocabularies get [ nest drop ] bind ;
-
-: words ( vocab -- list ) vocab dup [ hash-values ] when ;
-
-: all-words ( -- list ) vocabs [ words ] map concat ;
-
-: word-subset ( pred -- list )
-    all-words swap subset ; inline
-
-: word-subset-with ( obj pred -- list | pred: obj word -- ? )
-    all-words swap subset-with ; inline
-
-: recrossref ( -- )
-    crossref get clear-hash all-words [ add-crossref ] each ;
-
-: lookup ( name vocab -- word ) vocab ?hash ;
-
-: reveal ( word -- )
-    vocabularies get [
-        dup word-name over word-vocabulary nest set-hash
-    ] bind ;
-
-: check-create ( name vocab -- )
-    string? [ "Vocabulary name is not a string" throw ] unless
-    string? [ "Word name is not a string" throw ] unless ;
-
-: create ( name vocab -- word )
-    2dup check-create 2dup lookup dup
-    [ 2nip ] [ drop <word> dup init-word dup reveal ] if ;
-
-: constructor-word ( string vocab -- word )
-    >r "<" swap ">" append3 r> create ;
-
-: forget ( word -- )
-    dup uncrossref
-    crossref get [ dupd remove-hash ] when*
-    dup word-name swap word-vocabulary vocab remove-hash ;
-
-: target-word ( word -- word )
-    dup word-name swap word-vocabulary lookup ;
-
-: interned? ( word -- ? ) dup target-word eq? ;
-
-: bootstrap-word ( word -- word )
-    dup word-name swap word-vocabulary
-    bootstrapping? get [
-        dup "syntax" = [ drop "!syntax" ] when
-    ] when lookup ;
diff --git a/library/vocabularies.facts b/library/vocabularies.facts
deleted file mode 100644
index 68384e72a9..0000000000
--- a/library/vocabularies.facts
+++ /dev/null
@@ -1,83 +0,0 @@
-USING: help parser words ;
-
-HELP: bootstrapping? f
-{ $description "Variable. Set by the library while bootstrap is in progress. Some parsing words need to behave differently during bootstrap." } ;
-
-HELP: vocabularies f
-{ $description "Variable. Holds a hashtable mapping vocabulary names to vocabularies." } ;
-
-HELP: word "( -- word )"
-{ $values { "word" "a word" } }
-{ $description "Outputs the most recently defined word." }
-{ $see-also save-location } ;
-
-HELP: set-word "( -- word )"
-{ $values { "word" "a word" } }
-{ $description "Sets the recently defined word. Usually you would call " { $link save-location } " on a newly-defined word instead, which will in turn call this word." }
-{ $see-also word } ;
-
-HELP: vocabs "( -- seq )"
-{ $values { "word" "a sequence of strings" } }
-{ $description "Outputs a sequence of all defined vocabulary names." } ;
-
-HELP: vocab "( name -- vocab )"
-{ $values { "name" "a string" } { "vocab" "a hashtable" } }
-{ $description "Outputs a named vocabulary, or " { $link f } " if no vocabulary with this name exists." } ;
-
-HELP: ensure-vocab "( name -- )"
-{ $values { "name" "a string" } }
-{ $description "Creates a vocabulary if it does not already exist." } ;
-
-HELP: words "( vocab -- seq )"
-{ $values { "vocab" "a string" } { "seq" "a sequence of words" } }
-{ $description "Outputs a sequence of words defined in the vocabulary, or " { $link f } " if no vocabulary with this name exists." } ;
-
-HELP: all-words "( -- seq )"
-{ $values { "seq" "a sequence of words" } }
-{ $description "Outputs a sequence of all words in the dictionary." } ;
-
-HELP: each-word "( quot -- )"
-{ $values { "quot" "a quotation with stack effect " { $snippet "( word -- )" } } }
-{ $description "Applies a quotation to each word in the dictionary." } ;
-
-HELP: word-subset "( quot -- seq )"
-{ $values { "quot" "a quotation with stack effect " { $snippet "( word -- ? )" } } { "seq" "a sequence of words" } }
-{ $description "Outputs a sequence of words satisfying the predicate." } ;
-
-HELP: recrossref "( -- )"
-{ $description "Update the word dependency database. Usually this is done automatically." } ;
-
-HELP: lookup "( name vocab -- word )"
-{ $values { "name" "a string" } { "vocab" "a string" } { "word" "a word or " { $link f } } }
-{ $description "Looks up a word in the dictionary. If the vocabulary or the word is not defined, outputs " { $link f } "." } ;
-
-HELP: reveal "( word -- )"
-{ $values { "word" "a word" } }
-{ $description "Adds a newly-created word to the dictionary. Usually this word does not need to be called directly." }
-{ $see-also create } ;
-
-HELP: create "( name vocab -- word )"
-{ $values { "name" "a string" } { "vocab" "a string" } { "word" "a word" } }
-{ $description "Creates a new word. Creates the vocabulary first if it does not already exist. If the vocabulary exists and already contains a word with the requested name, outputs the existing word." } ;
-
-HELP: constructor-word "( name vocab -- word )"
-{ $values { "name" "a string" } { "vocab" "a string" } { "word" "a word" } }
-{ $description "Creates a new word, surrounding " { $snippet "name" } " in angle brackets." }
-{ $examples { $example "\"salmon\" \"scratchpad\" constructor-word ." "<salmon>" } } ;
-
-HELP: forget "( word -- )"
-{ $values { "word" "a word" } }
-{ $description "Removes the word from its vocabulary. The word becomes uninterned." }
-{ $see-also POSTPONE: FORGET: } ;
-
-HELP: target-word "( word -- target )"
-{ $values { "word" "a word" } { "target" "a word" } }
-{ $description "Looks up a word with the same name and vocabulary as the given word. Used during bootstrap to transfer host words to the target dictionary." } ;
-
-HELP: interned? "( word -- ? )"
-{ $values { "word" "a word" } { "?" "a boolean" } }
-{ $description "Test if the word is an interned word." } ;
-
-HELP: bootstrap-word "( word -- target )"
-{ $values { "word" "a word" } { "target" "a word" } }
-{ $description "Looks up a word with the same name and vocabulary as the given word, performing a transformation to handle parsing words in the target dictionary. Used during bootstrap to transfer host words to the target dictionary." } ;
diff --git a/library/words.factor b/library/words.factor
index b495089158..b19cf032da 100644
--- a/library/words.factor
+++ b/library/words.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! See http://factorcode.org/license.txt for BSD license.
 IN: words
-USING: hashtables kernel kernel-internals lists math
-namespaces sequences strings vectors ;
+USING: errors graphs hashtables kernel kernel-internals lists
+math namespaces sequences strings vectors ;
 
 M: word <=> [ word-name ] 2apply <=> ;
 
@@ -43,38 +43,28 @@ M: word set-word-xt ( xt w -- ) 7 set-integer-slot ;
 
 SYMBOL: crossref
 
-: (add-crossref) crossref get [ dupd nest set-hash ] bind ;
+: xref-word ( word -- )
+    dup word-vocabulary
+    [ [ uses ] crossref get add-vertex ] [ drop ] if ;
 
-: add-crossref ( word -- )
-    crossref get over word-vocabulary and [
-        dup dup uses [ (add-crossref) ] each-with
-    ] when drop ;
+: usage ( word -- seq ) crossref get in-edges ;
 
-: usage ( word -- seq )
-    crossref get ?hash dup [ hash-keys ] when ;
+: usages ( word -- deps ) crossref get closure ;
 
-: usages ( word -- deps )
-    crossref get dup [ closure ] [ 2drop { } ] if ;
+GENERIC: unxref-word* ( word -- )
 
-GENERIC: (uncrossref) ( word -- )
+M: word unxref-word* drop ;
 
-M: word (uncrossref) drop ;
-
-: remove-crossref ( callee caller -- )
-    crossref get [ nest remove-hash ] bind ;
-
-: uncrossref ( word -- )
-    crossref get [
-        dup dup uses [ remove-crossref ] each-with
-        dup (uncrossref) dup usages [ (uncrossref) ] each
-    ] when drop ;
+: unxref-word ( word -- )
+    dup unxref-word* dup usages [ unxref-word* ] each
+    [ uses ] crossref get remove-vertex ;
 
 : define ( word parameter primitive -- )
-    pick uncrossref
+    pick unxref-word
     pick set-word-primitive
     over set-word-def
     dup update-xt
-    add-crossref ;
+    xref-word ;
 
 : define-symbol ( word -- ) dup 2 define ;
 
@@ -100,3 +90,64 @@ M: word literalize <wrapper> ;
 
 : completions ( substring words -- seq )
     [ word-name subseq? ] subset-with ;
+
+SYMBOL: bootstrapping?
+
+SYMBOL: vocabularies
+
+: word ( -- word ) \ word get-global ;
+
+: set-word ( word -- ) \ word set-global ;
+
+: vocabs ( -- seq ) vocabularies get hash-keys natural-sort ;
+
+: vocab ( name -- vocab ) vocabularies get hash ;
+
+: ensure-vocab ( name -- ) vocabularies get [ nest drop ] bind ;
+
+: words ( vocab -- list ) vocab dup [ hash-values ] when ;
+
+: all-words ( -- list ) vocabs [ words ] map concat ;
+
+: word-subset ( pred -- list )
+    all-words swap subset ; inline
+
+: word-subset-with ( obj pred -- list | pred: obj word -- ? )
+    all-words swap subset-with ; inline
+
+: xref-words ( -- )
+    H{ } clone crossref set
+    all-words [ uses ] crossref get add-vertices ;
+
+: lookup ( name vocab -- word ) vocab ?hash ;
+
+: reveal ( word -- )
+    vocabularies get [
+        dup word-name over word-vocabulary nest set-hash
+    ] bind ;
+
+: check-create ( name vocab -- )
+    string? [ "Vocabulary name is not a string" throw ] unless
+    string? [ "Word name is not a string" throw ] unless ;
+
+: create ( name vocab -- word )
+    2dup check-create 2dup lookup dup
+    [ 2nip ] [ drop <word> dup init-word dup reveal ] if ;
+
+: constructor-word ( string vocab -- word )
+    >r "<" swap ">" append3 r> create ;
+
+: forget ( word -- )
+    dup unxref-word
+    dup word-name swap word-vocabulary vocab remove-hash ;
+
+: target-word ( word -- word )
+    dup word-name swap word-vocabulary lookup ;
+
+: interned? ( word -- ? ) dup target-word eq? ;
+
+: bootstrap-word ( word -- word )
+    dup word-name swap word-vocabulary
+    bootstrapping? get [
+        dup "syntax" = [ drop "!syntax" ] when
+    ] when lookup ;
diff --git a/library/words.facts b/library/words.facts
index 6772cf510d..ff7b37be8d 100644
--- a/library/words.facts
+++ b/library/words.facts
@@ -1,4 +1,4 @@
-USING: help kernel words ;
+USING: help kernel parser words ;
 
 HELP: execute "( word -- )"
 { $values { "word" "a word" } }
@@ -83,9 +83,9 @@ HELP: uses "( word -- seq )"
 
 HELP: crossref f
 { $description "Variable. A hashtable mapping words to usages, where usages are a set represented by a hashtable with words as keys and dummy sentinels as values." }
-{ $see-also usages recrossref } ;
+{ $see-also usages xref-words } ;
 
-HELP: add-crossref "( word -- )"
+HELP: xref-word "( word -- )"
 { $values { "word" "a word" } }
 { $description "Adds dependencies from every word called by this word to this word." }
 $low-level-note ;
@@ -101,12 +101,12 @@ HELP: usages "( word -- seq )"
 { $description "Outputs a sequence of words that call the given word through some chain of callers." }
 { $notes "This word computes the transitive closure of the result of " { $link usage } ". The sequence will include the word itself if it is recursive." } ;
 
-HELP: (uncrossref) "( word -- )"
+HELP: unxref-word* "( word -- )"
 { $values { "word" "a word" } }
 { $contract "Updates the word to cope with a callee being redefined." }
 $low-level-note ;
 
-HELP: remove-crossref "( callee caller -- )"
+HELP: unxref-word "( callee caller -- )"
 { $values { "callee" "a word" } { "caller" "a word" } }
 { $description "Remove the fact that " { $snippet "caller" } " calls " { $snippet "callee" } " from the cross-referencing database." }
 $low-level-note ;
@@ -148,3 +148,81 @@ HELP: definer "( word -- definer )"
     { $example ": foo ; \\ foo definer ." "POSTPONE: :" }
     { $example "SYMBOL: foo \\ foo definer ." "POSTPONE: SYMBOL:" }
 } ;
+
+HELP: bootstrapping? f
+{ $description "Variable. Set by the library while bootstrap is in progress. Some parsing words need to behave differently during bootstrap." } ;
+
+HELP: vocabularies f
+{ $description "Variable. Holds a hashtable mapping vocabulary names to vocabularies." } ;
+
+HELP: word "( -- word )"
+{ $values { "word" "a word" } }
+{ $description "Outputs the most recently defined word." }
+{ $see-also save-location } ;
+
+HELP: set-word "( -- word )"
+{ $values { "word" "a word" } }
+{ $description "Sets the recently defined word. Usually you would call " { $link save-location } " on a newly-defined word instead, which will in turn call this word." }
+{ $see-also word } ;
+
+HELP: vocabs "( -- seq )"
+{ $values { "word" "a sequence of strings" } }
+{ $description "Outputs a sequence of all defined vocabulary names." } ;
+
+HELP: vocab "( name -- vocab )"
+{ $values { "name" "a string" } { "vocab" "a hashtable" } }
+{ $description "Outputs a named vocabulary, or " { $link f } " if no vocabulary with this name exists." } ;
+
+HELP: ensure-vocab "( name -- )"
+{ $values { "name" "a string" } }
+{ $description "Creates a vocabulary if it does not already exist." } ;
+
+HELP: words "( vocab -- seq )"
+{ $values { "vocab" "a string" } { "seq" "a sequence of words" } }
+{ $description "Outputs a sequence of words defined in the vocabulary, or " { $link f } " if no vocabulary with this name exists." } ;
+
+HELP: all-words "( -- seq )"
+{ $values { "seq" "a sequence of words" } }
+{ $description "Outputs a sequence of all words in the dictionary." } ;
+
+HELP: word-subset "( quot -- seq )"
+{ $values { "quot" "a quotation with stack effect " { $snippet "( word -- ? )" } } { "seq" "a sequence of words" } }
+{ $description "Outputs a sequence of words satisfying the predicate." } ;
+
+HELP: xref-words "( -- )"
+{ $description "Update the word dependency database. Usually this is done automatically." } ;
+
+HELP: lookup "( name vocab -- word )"
+{ $values { "name" "a string" } { "vocab" "a string" } { "word" "a word or " { $link f } } }
+{ $description "Looks up a word in the dictionary. If the vocabulary or the word is not defined, outputs " { $link f } "." } ;
+
+HELP: reveal "( word -- )"
+{ $values { "word" "a word" } }
+{ $description "Adds a newly-created word to the dictionary. Usually this word does not need to be called directly." }
+{ $see-also create } ;
+
+HELP: create "( name vocab -- word )"
+{ $values { "name" "a string" } { "vocab" "a string" } { "word" "a word" } }
+{ $description "Creates a new word. Creates the vocabulary first if it does not already exist. If the vocabulary exists and already contains a word with the requested name, outputs the existing word." } ;
+
+HELP: constructor-word "( name vocab -- word )"
+{ $values { "name" "a string" } { "vocab" "a string" } { "word" "a word" } }
+{ $description "Creates a new word, surrounding " { $snippet "name" } " in angle brackets." }
+{ $examples { $example "\"salmon\" \"scratchpad\" constructor-word ." "<salmon>" } } ;
+
+HELP: forget "( word -- )"
+{ $values { "word" "a word" } }
+{ $description "Removes the word from its vocabulary. The word becomes uninterned." }
+{ $see-also POSTPONE: FORGET: } ;
+
+HELP: target-word "( word -- target )"
+{ $values { "word" "a word" } { "target" "a word" } }
+{ $description "Looks up a word with the same name and vocabulary as the given word. Used during bootstrap to transfer host words to the target dictionary." } ;
+
+HELP: interned? "( word -- ? )"
+{ $values { "word" "a word" } { "?" "a boolean" } }
+{ $description "Test if the word is an interned word." } ;
+
+HELP: bootstrap-word "( word -- target )"
+{ $values { "word" "a word" } { "target" "a word" } }
+{ $description "Looks up a word with the same name and vocabulary as the given word, performing a transformation to handle parsing words in the target dictionary. Used during bootstrap to transfer host words to the target dictionary." } ;