Abstract out word cross-referencing into a graph library; implement help cross-referencing
slava
parent
56bb99fa56
commit
055cb66e0f
|
|
@ -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:
|
||||
|
||||
|
|
|
|||
|
|
@ -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:"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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 [
|
||||
|
|
|
|||
|
|
@ -303,7 +303,7 @@ M: hashtable ' ( hashtable -- pointer )
|
|||
[
|
||||
{
|
||||
vocabularies typemap builtins c-types crossref
|
||||
articles terms
|
||||
articles terms help-graph
|
||||
}
|
||||
[ [ ] change ] each
|
||||
] make-hash '
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
@ -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 )
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
@ -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. ( -- )
|
||||
|
||||
;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
@ -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." } ;
|
||||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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." } ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue