Abstract out word cross-referencing into a graph library; implement help cross-referencing
parent
56bb99fa56
commit
055cb66e0f
|
@ -42,16 +42,15 @@
|
||||||
http://twb.ath.cx/~twb/darcs/OBSOLETE/factor/final.html
|
http://twb.ath.cx/~twb/darcs/OBSOLETE/factor/final.html
|
||||||
- fix remaining HTML stream issues
|
- fix remaining HTML stream issues
|
||||||
- fix up the min thumb size hack
|
- fix up the min thumb size hack
|
||||||
- help cross-referencing
|
- automatically update help graph when adding/removing articles/words
|
||||||
- document conventions
|
- document conventions
|
||||||
- new turtle graphics tutorial
|
- new turtle graphics tutorial
|
||||||
- better line spacing in ui and html
|
- better line spacing in ui and html
|
||||||
- tabular formatting - for inspector and changes
|
- tabular formatting - for inspector, changes and $values in help
|
||||||
- grid layout
|
- grid layout
|
||||||
- variable width word wrap
|
- variable width word wrap
|
||||||
- fix top level window positioning
|
- fix top level window positioning
|
||||||
- changing window titles
|
- changing window titles
|
||||||
- remove distinction between a word and a link to a word
|
|
||||||
|
|
||||||
+ compiler/ffi:
|
+ compiler/ffi:
|
||||||
|
|
||||||
|
|
|
@ -136,7 +136,7 @@ ARTICLE: "word-crossref" "Cross-referencing"
|
||||||
{ $subsection usage }
|
{ $subsection usage }
|
||||||
{ $subsection usages }
|
{ $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."
|
"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"
|
ARTICLE: "word-internals" "Word implementation details"
|
||||||
"The behavior of a word when executed depends on the values of two slots:"
|
"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
|
[ "()" subseq? not ] subset >r pick r> parse-arglist
|
||||||
(define-c-word) ;
|
(define-c-word) ;
|
||||||
|
|
||||||
M: compound (uncrossref)
|
M: compound unxref-word*
|
||||||
dup word-def \ alien-invoke swap member?
|
dup word-def \ alien-invoke swap member?
|
||||||
over "infer" word-prop or [
|
over "infer" word-prop or [
|
||||||
drop
|
drop
|
||||||
|
|
|
@ -43,6 +43,7 @@ vectors words ;
|
||||||
"/library/collections/lists.factor"
|
"/library/collections/lists.factor"
|
||||||
"/library/collections/flatten.factor"
|
"/library/collections/flatten.factor"
|
||||||
"/library/collections/queues.factor"
|
"/library/collections/queues.factor"
|
||||||
|
"/library/collections/graphs.factor"
|
||||||
|
|
||||||
"/library/math/random.factor"
|
"/library/math/random.factor"
|
||||||
"/library/math/constants.factor"
|
"/library/math/constants.factor"
|
||||||
|
@ -53,7 +54,6 @@ vectors words ;
|
||||||
"/library/math/parse-numbers.factor"
|
"/library/math/parse-numbers.factor"
|
||||||
|
|
||||||
"/library/words.factor"
|
"/library/words.factor"
|
||||||
"/library/vocabularies.factor"
|
|
||||||
"/library/continuations.factor"
|
"/library/continuations.factor"
|
||||||
"/library/errors.factor"
|
"/library/errors.factor"
|
||||||
|
|
||||||
|
@ -84,13 +84,12 @@ vectors words ;
|
||||||
|
|
||||||
"/library/tools/interpreter.factor"
|
"/library/tools/interpreter.factor"
|
||||||
|
|
||||||
"/library/help/database.factor"
|
|
||||||
"/library/help/stylesheet.factor"
|
"/library/help/stylesheet.factor"
|
||||||
"/library/help/help.factor"
|
"/library/help/help.factor"
|
||||||
"/library/help/markup.factor"
|
"/library/help/markup.factor"
|
||||||
"/library/help/word-help.factor"
|
"/library/help/word-help.factor"
|
||||||
"/library/help/syntax.factor"
|
|
||||||
"/library/help/crossref.factor"
|
"/library/help/crossref.factor"
|
||||||
|
"/library/help/syntax.factor"
|
||||||
|
|
||||||
"/library/tools/describe.factor"
|
"/library/tools/describe.factor"
|
||||||
"/library/tools/debugger.factor"
|
"/library/tools/debugger.factor"
|
||||||
|
@ -193,7 +192,6 @@ vectors words ;
|
||||||
"/library/errors.facts"
|
"/library/errors.facts"
|
||||||
"/library/kernel.facts"
|
"/library/kernel.facts"
|
||||||
"/library/threads.facts"
|
"/library/threads.facts"
|
||||||
"/library/vocabularies.facts"
|
|
||||||
"/library/words.facts"
|
"/library/words.facts"
|
||||||
"/library/alien/alien-callback.facts"
|
"/library/alien/alien-callback.facts"
|
||||||
"/library/alien/alien-invoke.facts"
|
"/library/alien/alien-invoke.facts"
|
||||||
|
|
|
@ -1,12 +1,12 @@
|
||||||
! Copyright (C) 2004, 2006 Slava Pestov.
|
! Copyright (C) 2004, 2006 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! 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
|
kernel-internals lists math memory namespaces optimizer parser
|
||||||
sequences sequences-internals words ;
|
sequences sequences-internals words ;
|
||||||
|
|
||||||
"Building cross-referencing database..." print
|
"Cross-referencing..." print
|
||||||
H{ } clone crossref set
|
xref-words
|
||||||
recrossref
|
xref-articles
|
||||||
|
|
||||||
"compile" get [
|
"compile" get [
|
||||||
"native-io" get [
|
"native-io" get [
|
||||||
|
|
|
@ -303,7 +303,7 @@ M: hashtable ' ( hashtable -- pointer )
|
||||||
[
|
[
|
||||||
{
|
{
|
||||||
vocabularies typemap builtins c-types crossref
|
vocabularies typemap builtins c-types crossref
|
||||||
articles terms
|
articles terms help-graph
|
||||||
}
|
}
|
||||||
[ [ ] change ] each
|
[ [ ] change ] each
|
||||||
] make-hash '
|
] make-hash '
|
||||||
|
|
|
@ -24,13 +24,14 @@ H{ } clone c-types set
|
||||||
"syntax" vocab
|
"syntax" vocab
|
||||||
|
|
||||||
H{ } clone vocabularies set
|
H{ } clone vocabularies set
|
||||||
H{ } clone articles set
|
|
||||||
H{ } clone terms set
|
|
||||||
|
|
||||||
crossref off
|
crossref off
|
||||||
|
|
||||||
vocabularies get [ "syntax" set [ reveal ] each ] bind
|
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 the quotation parsed from primitive-types.factor
|
||||||
call
|
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 % ;
|
: # ( 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
|
IN: lists
|
||||||
|
|
||||||
: alist>quot ( default alist -- quot )
|
: alist>quot ( default alist -- quot )
|
||||||
|
|
|
@ -1,12 +1,12 @@
|
||||||
! Copyright (C) 2006 Slava Pestov.
|
! Copyright (C) 2006 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
IN: help
|
IN: help
|
||||||
USING: arrays generic hashtables io kernel lists namespaces
|
USING: arrays generic graphs hashtables io kernel lists
|
||||||
sequences strings words ;
|
namespaces sequences strings words ;
|
||||||
|
|
||||||
: all-articles ( -- seq )
|
: all-articles ( -- seq )
|
||||||
[
|
[
|
||||||
articles hash-keys %
|
articles get hash-keys %
|
||||||
[ word-article ] word-subset %
|
[ word-article ] word-subset %
|
||||||
terms get hash-keys [ <term> ] map %
|
terms get hash-keys [ <term> ] map %
|
||||||
] { } make ;
|
] { } make ;
|
||||||
|
@ -40,8 +40,19 @@ M: array elements*
|
||||||
\ $subsection swap collect-elements
|
\ $subsection swap collect-elements
|
||||||
] make-hash hash-keys ;
|
] make-hash hash-keys ;
|
||||||
|
|
||||||
: links-in ( article -- seq )
|
SYMBOL: help-graph
|
||||||
all-articles [ links-out member? ] subset-with ;
|
|
||||||
|
: 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 -- )
|
: help-outliner ( seq quot -- | quot: obj -- )
|
||||||
swap sort-articles [ ($subsection) terpri ] each-with ;
|
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.
|
! Copyright (C) 2005, 2006 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
IN: help
|
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
|
SYMBOL: last-block
|
||||||
|
|
||||||
|
@ -21,7 +55,3 @@ DEFER: $heading
|
||||||
: handbook ( -- ) "handbook" help ;
|
: handbook ( -- ) "handbook" help ;
|
||||||
|
|
||||||
: tutorial ( -- ) "tutorial" help ;
|
: tutorial ( -- ) "tutorial" help ;
|
||||||
|
|
||||||
: articles. ( -- )
|
|
||||||
|
|
||||||
;
|
|
||||||
|
|
|
@ -129,12 +129,14 @@ DEFER: help
|
||||||
: $subsection ( object -- )
|
: $subsection ( object -- )
|
||||||
[ first [ (help) ] swap ($subsection) ] ($block) ;
|
[ first [ (help) ] swap ($subsection) ] ($block) ;
|
||||||
|
|
||||||
|
: >link ( obj -- obj ) dup string? [ <link> ] when ;
|
||||||
|
|
||||||
: $link ( article -- )
|
: $link ( article -- )
|
||||||
last-block off first dup word? [
|
last-block off first dup word? [
|
||||||
pprint
|
pprint
|
||||||
] [
|
] [
|
||||||
link-style [
|
link-style [
|
||||||
dup article-title swap <link> simple-object
|
dup article-title swap >link simple-object
|
||||||
] with-style
|
] with-style
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
|
|
|
@ -18,12 +18,14 @@ H{ } clone components set-global
|
||||||
{ "Definition" [ help ] }
|
{ "Definition" [ help ] }
|
||||||
{ "Calls in" [ usage. ] }
|
{ "Calls in" [ usage. ] }
|
||||||
{ "Calls out" [ uses. ] }
|
{ "Calls out" [ uses. ] }
|
||||||
|
{ "Links in" [ links-in. ] }
|
||||||
{ "Links out" [ links-out. ] }
|
{ "Links out" [ links-out. ] }
|
||||||
{ "Vocabulary" [ word-vocabulary words. ] }
|
{ "Vocabulary" [ word-vocabulary words. ] }
|
||||||
} \ word components get-global set-hash
|
} \ word components get-global set-hash
|
||||||
|
|
||||||
{
|
{
|
||||||
{ "Article" [ help ] }
|
{ "Article" [ help ] }
|
||||||
|
{ "Links in" [ links-in. ] }
|
||||||
{ "Links out" [ links-out. ] }
|
{ "Links out" [ links-out. ] }
|
||||||
} \ link components get-global set-hash
|
} \ 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.
|
! 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
|
IN: words
|
||||||
USING: hashtables kernel kernel-internals lists math
|
USING: errors graphs hashtables kernel kernel-internals lists
|
||||||
namespaces sequences strings vectors ;
|
math namespaces sequences strings vectors ;
|
||||||
|
|
||||||
M: word <=> [ word-name ] 2apply <=> ;
|
M: word <=> [ word-name ] 2apply <=> ;
|
||||||
|
|
||||||
|
@ -43,38 +43,28 @@ M: word set-word-xt ( xt w -- ) 7 set-integer-slot ;
|
||||||
|
|
||||||
SYMBOL: crossref
|
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 -- )
|
: usage ( word -- seq ) crossref get in-edges ;
|
||||||
crossref get over word-vocabulary and [
|
|
||||||
dup dup uses [ (add-crossref) ] each-with
|
|
||||||
] when drop ;
|
|
||||||
|
|
||||||
: usage ( word -- seq )
|
: usages ( word -- deps ) crossref get closure ;
|
||||||
crossref get ?hash dup [ hash-keys ] when ;
|
|
||||||
|
|
||||||
: usages ( word -- deps )
|
GENERIC: unxref-word* ( word -- )
|
||||||
crossref get dup [ closure ] [ 2drop { } ] if ;
|
|
||||||
|
|
||||||
GENERIC: (uncrossref) ( word -- )
|
M: word unxref-word* drop ;
|
||||||
|
|
||||||
M: word (uncrossref) drop ;
|
: unxref-word ( word -- )
|
||||||
|
dup unxref-word* dup usages [ unxref-word* ] each
|
||||||
: remove-crossref ( callee caller -- )
|
[ uses ] crossref get remove-vertex ;
|
||||||
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 ;
|
|
||||||
|
|
||||||
: define ( word parameter primitive -- )
|
: define ( word parameter primitive -- )
|
||||||
pick uncrossref
|
pick unxref-word
|
||||||
pick set-word-primitive
|
pick set-word-primitive
|
||||||
over set-word-def
|
over set-word-def
|
||||||
dup update-xt
|
dup update-xt
|
||||||
add-crossref ;
|
xref-word ;
|
||||||
|
|
||||||
: define-symbol ( word -- ) dup 2 define ;
|
: define-symbol ( word -- ) dup 2 define ;
|
||||||
|
|
||||||
|
@ -100,3 +90,64 @@ M: word literalize <wrapper> ;
|
||||||
|
|
||||||
: completions ( substring words -- seq )
|
: completions ( substring words -- seq )
|
||||||
[ word-name subseq? ] subset-with ;
|
[ 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 -- )"
|
HELP: execute "( word -- )"
|
||||||
{ $values { "word" "a word" } }
|
{ $values { "word" "a word" } }
|
||||||
|
@ -83,9 +83,9 @@ HELP: uses "( word -- seq )"
|
||||||
|
|
||||||
HELP: crossref f
|
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." }
|
{ $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" } }
|
{ $values { "word" "a word" } }
|
||||||
{ $description "Adds dependencies from every word called by this word to this word." }
|
{ $description "Adds dependencies from every word called by this word to this word." }
|
||||||
$low-level-note ;
|
$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." }
|
{ $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." } ;
|
{ $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" } }
|
{ $values { "word" "a word" } }
|
||||||
{ $contract "Updates the word to cope with a callee being redefined." }
|
{ $contract "Updates the word to cope with a callee being redefined." }
|
||||||
$low-level-note ;
|
$low-level-note ;
|
||||||
|
|
||||||
HELP: remove-crossref "( callee caller -- )"
|
HELP: unxref-word "( callee caller -- )"
|
||||||
{ $values { "callee" "a word" } { "caller" "a word" } }
|
{ $values { "callee" "a word" } { "caller" "a word" } }
|
||||||
{ $description "Remove the fact that " { $snippet "caller" } " calls " { $snippet "callee" } " from the cross-referencing database." }
|
{ $description "Remove the fact that " { $snippet "caller" } " calls " { $snippet "callee" } " from the cross-referencing database." }
|
||||||
$low-level-note ;
|
$low-level-note ;
|
||||||
|
@ -148,3 +148,81 @@ HELP: definer "( word -- definer )"
|
||||||
{ $example ": foo ; \\ foo definer ." "POSTPONE: :" }
|
{ $example ": foo ; \\ foo definer ." "POSTPONE: :" }
|
||||||
{ $example "SYMBOL: foo \\ foo definer ." "POSTPONE: SYMBOL:" }
|
{ $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