words chapter of handbook converted

cvs
Slava Pestov 2006-01-06 07:04:42 +00:00
parent 95242341aa
commit 3e6eb47785
25 changed files with 525 additions and 167 deletions

View File

@ -11,7 +11,6 @@
ui/line-editor - don't use variables
- amd64 to do:
- alien calls
- compiling sheet runs out of memory
- port ffi to win64
- intrinsic char-slot set-char-slot for x86
- closing ui does not stop timers

157
doc/handbook/words.facts Normal file
View File

@ -0,0 +1,157 @@
USING: help kernel parser words ;
GLOSSARY: "defining word" "a word that adds definitions to the dictionary" ;
GLOSSARY: "dictionary" "the collection of vocabularies making up the code in the Factor image" ;
ARTICLE: "words" "Words"
"Words are the fundamental unit of code in Factor, analogous to functions or procedures in other languages. Words are also objects, and this concept forms the basis for Factor's meta-programming facilities. A word consists of several parts:"
{ $list
"a word name,"
"a vocabulary name,"
"a definition, specifying the behavior of the word when executed,"
"a set of word properties, including documentation strings and other meta-data."
}
"Words for working with words are in the " { $snippet "words" } " vocabulary, and words form a class of objects."
{ $subsection word }
{ $subsection word? }
{ $subsection word-name }
{ $subsection word-vocabulary }
{ $subsection word-sort }
{ $subsection "vocabularies" }
{ $subsection "word-definition" }
{ $subsection "word-crossref" }
{ $subsection "word-internals" } ;
GLOSSARY: "interned word" "a word that is a member of the vocabulary named by its vocabulary slot. Interned words are created by calls to " { $link create } ;
GLOSSARY: "uninterned word" "a word whose vocabulary slot is either set to " { $link f } ", or that does not belong to the vocabulary named by its vocabulary slot. Uninterned words are created by calls to " { $link gensym } ", and interned words can become uninterned via calls to " { $link forget } ;
ARTICLE: "vocabularies" "Vocabularies"
"Words are organized into named vocabularies, stored in a global variable."
{ $subsection vocabularies }
"A word is said to be " { $emphasis "interned" } " if it is a member of the vocabulary named by its vocabulary slot. Otherwise, the word is " { $emphasis "uninterned" } "."
$terpri
"Words whose names are known at parse time -- that is, most words making up your program -- can be referenced in source code by stating their name. However, the parser itself, and sometimes code you write, will need to create look up words dynamically."
$terpri
"Parsing words add definitions to the current vocabulary. When a source file is being parsed, the current vocabulary is initially set to " { $snippet "scratchpad" } ". The current vocabulary may be changed with the " { $link POSTPONE: IN: } " parsing word (see " { $link "vocabulary-search" } ")."
{ $subsection create }
{ $subsection create-in }
{ $subsection gensym }
{ $subsection lookup } ;
ARTICLE: "word-definition" "Defining words"
"There are two approaches to creating word definitions:"
{ $list
"using parsing words at parse time,"
"using defining words at run-time."
}
"The latter is a more dynamic feature that can be used to implement code generation and such, and in fact parse-time defining words are implemented in terms of run-time defining words."
{ $subsection "colon-definition" }
{ $subsection "symbols" }
{ $subsection "primitives" }
{ $subsection "deferred" }
{ $subsection "undefining" }
{ $subsection "declarations" } ;
GLOSSARY: "compound definition" "a word that calls a quotation when executed" ;
GLOSSARY: "colon definition" "see compound definition" ;
ARTICLE: "colon-definition" "Compound definitions"
"A compound definition associates a word name with a quotation that is called when the word is executed."
{ $subsection POSTPONE: : }
{ $subsection define-compound }
{ $subsection compound? }
{ $subsection compound } ;
GLOSSARY: "symbol" "a word defined to push itself on the stack when executed, created by the " { $link POSTPONE: SYMBOL: } " parsing word" ;
ARTICLE: "symbols" "Symbols"
{ $subsection POSTPONE: SYMBOL: }
{ $subsection define-symbol }
{ $subsection symbol? }
{ $subsection symbol } ;
ARTICLE: "primitives" "Primitives"
"Executing a primitive invokes native code in the Factor runtime. Primitives cannot be defined through Factor code. Compiled definitions behave similarly to primitives in that the interpreter jumps to native code upon encountering them."
{ $subsection primitive? }
{ $subsection primitive } ;
ARTICLE: "deferred" "Deferred words and mutual recursion"
{ $subsection POSTPONE: DEFER: }
{ $subsection undefined? }
{ $subsection undefined } ;
ARTICLE: "undefining" "Undefining words"
{ $subsection POSTPONE: FORGET: }
{ $subsection forget }
{ $subsection interned? } ;
GLOSSARY: "inline word" "calls to inline words are replaced with the inline word's body by the compiler. Inline words are declared via the " { $link POSTPONE: inline } " parsing word" ;
GLOSSARY: "flushable word" "calls to flushable words may be removed from compiled code if their outputs are subsequently discarded by calls to " { $link drop } ". Flushable words are declared via the " { $link POSTPONE: flushable } " parsing word" ;
GLOSSARY: "foldable word" "calls to foldable words may be evaluated at compile time if all inputs are literal. Foldable words are declared via the " { $link POSTPONE: foldable } " parsing word" ;
ARTICLE: "declarations" "Declarations"
"Declarations give special behavior to a word. Declarations are parsing words that set a word property in the most recently defined word."
$terpri
"The first declaration specifies the time when a word runs. It affects both interpreted and compiled definitions."
{ $subsection POSTPONE: parsing }
"The remaining declarations only affect compiled definitions. They do not change evaluation semantics of a word, but instead declare that the word follows a certain contract, and thus may be compiled differently."
$terpri
{ $warning "If a generic word is defined as " { $link POSTPONE: flushable } " or " { $link POSTPONE: foldable } ", all methods must satisfy the contract, otherwise unpredicable behavior will occur." }
{ $subsection POSTPONE: inline }
{ $subsection POSTPONE: flushable }
{ $subsection POSTPONE: foldable } ;
GLOSSARY: "word property" "a name/value pair stored in the word properties of a word" ;
GLOSSARY: "word properties" "a hashtable associated with each word storing various sundry properties" ;
ARTICLE: "word-props" "Word properties"
"Each word has a hashtable of properties."
{ $subsection word-prop }
{ $subsection set-word-prop }
{ $subsection word-props }
{ $subsection set-word-props }
"The stack effect of the above two words is designed so that it is most convenient when " { $snippet "name" } " is a literal pushed on the stack right before executing this word."
$terpri
"The following properties are set by the library:"
{ $list
{ { $snippet "\"parsing\"" } ", " { $snippet "\"inline\"" } ", " { $snippet "\"flushable\"" } ", " { $snippet "\"fondable\"" } " - declarations (see " { $link "declarations" } ")" }
{ { $snippet "\"methods\"" } ", " { $snippet "\"combination\"" } " - only defined on generic words (see " { $link "generic" } ")" }
{ { $snippet "\"file\"" } " - the source file storing the word definition" }
{ { $snippet "\"line\"" } " - the line number in the source file storing the word definition" }
} ;
ARTICLE: "word-crossref" "Cross-referencing"
"The cross-reference database is updated every time a word is redefined."
{ $subsection crossref }
"You can find all words called by a given word:"
{ $subsection uses }
"As well as all words calling a given word:"
{ $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 } ;
ARTICLE: "word-internals" "Word implementation details"
"The behavior of a word when executed depends on the values of two slots:"
{ $list
"the primitive number"
"the primitive parameter"
}
"The primitive number is an index into an array of native functions in the Factor runtime."
$terpri
"Primitive number accessors:"
{ $subsection word-primitive }
{ $subsection set-word-primitive }
"Primitive parameter accessors:"
{ $subsection word-def }
{ $subsection set-word-def }
"A lower-level facility for inspecting the machine code address of a word:"
{ $subsection word-xt }
{ $subsection set-word-xt }
{ $subsection update-xt } ;

View File

@ -150,6 +150,9 @@ vectors words ;
"/library/help/word-help.factor"
"/library/help/syntax.factor"
! This must be the last file of parsing words loaded
"/library/syntax/parse-syntax.factor"
"/library/sdl/sdl.factor"
"/library/sdl/sdl-video.factor"
"/library/sdl/sdl-event.factor"
@ -194,6 +197,8 @@ vectors words ;
"/library/help/commands.factor"
"/library/vocabularies.facts"
"/library/words.facts"
"/library/collections/growable.facts"
"/library/collections/arrays.facts"
"/library/collections/hashtables.facts"
@ -220,8 +225,7 @@ vectors words ;
"/doc/handbook/sequences.facts"
"/doc/handbook/syntax.facts"
"/doc/handbook/tutorial.facts"
"/library/syntax/parse-syntax.factor"
"/doc/handbook/words.facts"
"/library/bootstrap/image.factor"
} [ parse-resource % ] each

View File

@ -35,7 +35,7 @@ vocabularies get [ "syntax" set [ reveal ] each ] bind
call
: make-primitive ( { vocab word } n -- )
>r first2 create r> f define ;
>r first2 create f r> define ;
{
{ "execute" "words" }

View File

@ -1,9 +1,10 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: sequences-internals
USING: arrays generic kernel kernel-internals math vectors ;
USING: arrays generic kernel kernel-internals math sequences
vectors ;
: collect ( n generator -- vector | quot: n -- value )
: collect ( n generator -- array | quot: n -- value )
>r [ f <array> ] keep r> swap [
[ rot >r [ swap call ] keep r> set-array-nth ] 3keep
] repeat drop ; inline
@ -29,6 +30,11 @@ USING: arrays generic kernel kernel-internals math vectors ;
t <array> f 0 pick set-nth-unsafe
] if ;
: (subset) ( quot accum elt -- quot accum )
-rot [
>r over >r call [ r> r> push ] [ r> r> 2drop ] if
] 2keep ; inline
IN: sequences
G: each ( seq quot -- | quot: elt -- )
@ -137,15 +143,8 @@ M: object find ( seq quot -- i elt )
swap [ with rot ] all? 2nip ; inline
: subset ( seq quot -- seq | quot: elt -- ? )
swap [
dup length <vector> -rot [
rot >r 2dup >r >r swap call [
r> r> r> [ push ] keep swap
] [
r> r> drop r> swap
] if
] each drop
] keep like ; inline
over >r V{ } clone rot [ (subset) ] each r> like nip ;
inline
: subset-with ( obj seq quot -- seq | quot: obj elt -- ? )
swap [ with rot ] subset 2nip ; inline

View File

@ -1,19 +1,25 @@
! Copyright (C) 2005 Slava Pestov.
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: sequences
USING: generic kernel lists strings ;
G: tree-each ( obj quot -- | quot: elt -- )
G: tree-each* ( obj quot -- | quot: elt -- )
[ over ] standard-combination ; inline
: tree-each ( obj quot -- | quot: elt -- )
[ call ] 2keep tree-each* ;
: tree-each-with ( obj vector quot -- )
swap [ with ] tree-each 2drop ; inline
M: object tree-each call ;
M: object tree-each* 2drop ;
M: sequence tree-each swap [ swap tree-each ] each-with ;
M: sequence tree-each* swap [ swap tree-each ] each-with ;
M: string tree-each call ;
M: string tree-each* 2drop ;
M: cons tree-each ( cons quot -- )
M: cons tree-each* ( cons quot -- )
>r uncons r> tuck >r >r tree-each r> r> tree-each ;
M: wrapper tree-each* ( wrapper quot -- )
>r wrapped r> tree-each ;

View File

@ -2,5 +2,5 @@ USING: help sequences ;
HELP: tree-each "( seq quot -- )"
{ $values { "obj" "an object" } { "quot" "a quotation with stack effect" { $snippet "( elt -- )" } } }
{ $description "Recursively descends nested arrays, vectors and lists, applying the quotation to leaf elements." }
{ $description "Traverses a tree where the root is the given object, the branches are arrays, vectors, lists and wrappers, and the leaves are all other types of objects. Traversal is pre-order; the quotation is first applied to a branch, then to the children." }
{ $notes "This word does not descend into virtual sequences, or user-defined sequences." } ;

View File

@ -7,6 +7,8 @@ strings styles words ;
! Markup
GENERIC: print-element
GENERIC: article-name
! Help articles
SYMBOL: articles
@ -19,11 +21,15 @@ TUPLE: article title content ;
M: string article-title article article-title ;
M: string article-name article article-name ;
M: string article-content article article-content ;
! Special case: f help
M: f article-title drop \ f word-name ;
M: article article-name article-title ;
! Special case: f help
M: f article-title drop \ f article-title ;
M: f article-name drop \ f article-name ;
M: f article-content drop \ f article-content ;
! Glossary of terms
@ -33,6 +39,8 @@ TUPLE: term entry ;
M: term article-title term-entry ;
M: term article-name term-entry ;
M: term article-content
term-entry terms get hash
[ "No such glossary entry" ] unless* ;

View File

@ -1,6 +1,5 @@
IN: help
USING: arrays gadgets-listener gadgets-presentations hashtables
io kernel namespaces parser sequences words ;
USING: arrays hashtables io kernel ;
: (help) ( topic -- )
default-style [

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005 Slava Pestov.
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: help
USING: arrays gadgets gadgets-panes gadgets-presentations
USING: arrays
generic hashtables inspector io kernel lists namespaces parser
prettyprint sequences strings styles vectors words ;
@ -89,11 +89,6 @@ M: simple-element print-element [ print-element ] each ;
dup parsing? [ $syntax ] [ $stack-effect ] if
terpri* ;
: $values ( content -- )
"Arguments and values" $subheading [
unswons* $emphasis " -- " format* print-element terpri*
] each ;
: $description ( content -- )
"Description" $subheading print-element ;
@ -103,6 +98,13 @@ M: simple-element print-element [ print-element ] each ;
: $examples ( content -- )
"Examples" $subheading print-element ;
: $warning ( content -- )
terpri*
current-style warning-style hash-union [
"Warning" $subheading print-element
] with-nesting
terpri* ;
: textual-list ( seq quot -- )
[ "," format* bl ] interleave ; inline
@ -141,6 +143,8 @@ TUPLE: link name ;
M: link article-title link-name article-title ;
M: link article-name link-name article-name ;
M: link article-content link-name article-content ;
M: link summary ( term -- string )
@ -148,23 +152,19 @@ M: link summary ( term -- string )
DEFER: help
: ($link) ( element quot -- )
over length 1 = [
>r first dup article-title swap r> call
] [
>r first2 r> swapd call
] if ;
: $subsection ( object -- )
terpri*
subsection-style [
[ <link> ] ($link) dup [ link-name (help) ] curry
first dup article-title swap <link>
dup [ link-name (help) ] curry
simple-outliner
] with-style ;
: $link ( article -- ) [ <link> ] ($link) simple-object ;
: $link ( article -- )
first dup article-name swap <link> simple-object ;
: $glossary ( element -- ) [ <term> ] ($link) simple-object ;
: $glossary ( element -- )
first dup <term> simple-object ;
: $definition ( content -- )
"Definition" $subheading $see ;
@ -172,11 +172,17 @@ DEFER: help
: $see-also ( content -- )
"See also" $subheading [ 1array $link ] textual-list ;
: $predicate ( content -- )
{ { "object" "an object" } } $values
: $values ( content -- )
"Arguments and values" $subheading [
unswons* $snippet " -- " format* print-element
] [
terpri
] interleave ;
: $predicate ( content -- :r)
{ { "object" object } } $values
"Tests if the top of the stack is " $description
dup first word-name a/an print-element $link
"." print-element ;
dup word-name a/an print-element $link "." print-element ;
: $list ( content -- )
terpri* [ "- " format* print-element terpri* ] each ;

View File

@ -11,7 +11,7 @@ USING: styles ;
: emphasis-style
H{ { font-style italic } } ;
: heading-style H{ { font "Serif" } { font-size 18 } } ;
: heading-style H{ { font "Serif" } { font-size 16 } } ;
: subheading-style H{ { font "Serif" } { font-style bold } } ;
@ -40,3 +40,10 @@ USING: styles ;
{ font "Monospaced" }
{ foreground { 0.0 0.0 1.0 1.0 } }
} ;
: warning-style
H{
{ page-color { 0.95 0.95 0.95 1 } }
{ border-color { 1 0 0 1 } }
{ border-width 5 }
} ;

View File

@ -2,7 +2,7 @@ IN: !syntax
USING: arrays help kernel parser sequences syntax words ;
: HELP:
scan-word dup [
scan-word bootstrap-word dup [
>array uncons* >r "stack-effect" set-word-prop r>
"help" set-word-prop
] [ ] ; parsing

View File

@ -1,8 +1,9 @@
IN: help
USING: arrays kernel namespaces words ;
USING: arrays kernel namespaces prettyprint sequences words ;
! Word help
M: word article-title word-name ;
M: word article-title "The " swap word-name " word" append3 ;
M: word article-name word-name ;
: word-help ( word -- )
dup "help" word-prop [

View File

@ -1,4 +1,4 @@
! Copyright (C) 2005 Slava Pestov.
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: styles
@ -42,3 +42,6 @@ SYMBOL: page-color
SYMBOL: border-color
SYMBOL: border-width
SYMBOL: wrap-margin
! Input history
TUPLE: input string ;

View File

@ -20,15 +20,15 @@ HELP: flushable ""
HELP: foldable ""
{ $description
"Declares that the most recently defined word can be evaluated at compile-time. Foldable words are always " { $link flushable } "."
"Declares that the most recently defined word can be evaluated at compile-time. Foldable words are always " { $link POSTPONE: flushable } "."
$terpri
"Foldable words are evaluated at compile time if all inputs are literal. Foldable words must satisfy a very strong contract:"
{ $list
{ "foldable words must satisfy the contract of " { $link flushable } " words," }
{ "foldable words must satisfy the contract of " { $link POSTPONE: flushable } " words," }
{ "foldable words must halt - for example, a word computing a series until it coverges should not be foldable, since compilation will not halt in the event the series does not converge." }
{ "both inputs and outputs of foldable words must be immutable." }
}
"The last restriction ensures that words such as " { $link clone } " do not satisfy the foldable word contract. Indeed, " { $link clone } " is " { $link flushable } ", however it may output a mutable object if its input is mutable, and so it is undesirable to evaluate it at compile-time, since doing so would give incorrect semantics for code that clones mutable objects."
"The last restriction ensures that words such as " { $link clone } " do not satisfy the foldable word contract. Indeed, " { $link clone } " is " { $link POSTPONE: flushable } ", however it may output a mutable object if its input is mutable, and so it is undesirable to evaluate it at compile-time, since doing so would give incorrect semantics for code that clones mutable objects."
$terpri
"Most operations on numbers are foldable. For example, " { $snippet "2 2 +" } " compiles to a literal 4, since " { $link + } " is declared foldable."
} ;

View File

@ -1,7 +1,7 @@
USING: help parser sequences ;
USING: help kernel parser sequences ;
IN: help : $parsing-note
"This word should only be called from parsing words." $notes ;
drop "This word should only be called from parsing words." $notes ;
HELP: use f
{ $description "A variable holding the current vocabulary search path as a sequence of hashtables." }

View File

@ -44,7 +44,6 @@ sequences strings styles words ;
] ?if ;
: synopsis ( word -- string )
#! Output a brief description of the word in question.
[
0 margin set [
dup (synopsis) stack-effect comment.
@ -122,6 +121,5 @@ M: word class. drop ;
all-words [ word-name [ subseq? ] completion? ] subset-with ;
: apropos ( substring -- )
#! List all words that contain a string.
(apropos) word-sort
[ [ synopsis ] keep simple-object terpri ] each ;

View File

@ -26,12 +26,14 @@ GENERIC: sheet ( obj -- sheet )
M: object summary
"an instance of the " swap class word-name " class" append3 ;
M: object sheet ( obj -- sheet )
: slot-sheet ( obj -- sheet )
dup class "slots" word-prop
dup [ second ] map -rot
[ first slot ] map-with
2array ;
M: object sheet ( obj -- sheet ) slot-sheet ;
M: sequence summary
dup length 1 = [
drop "a sequence containing 1 element"

View File

@ -2,7 +2,7 @@ IN: gadgets-presentations
USING: compiler gadgets gadgets-buttons gadgets-listener
gadgets-menus gadgets-panes generic hashtables inference
inspector io jedit kernel lists namespaces parser prettyprint
sequences words ;
sequences words styles ;
SYMBOL: commands

View File

@ -1,14 +1,12 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: help
DEFER: <link>
IN: gadgets-listener
USING: arrays compiler gadgets gadgets-editors gadgets-labels
gadgets-layouts gadgets-panes gadgets-scrolling
gadgets-splitters gadgets-theme generic hashtables
inference inspector io jedit kernel listener lists math
namespaces parser prettyprint sequences shells threads words ;
namespaces parser prettyprint sequences shells threads words
help ;
SYMBOL: stack-bar
SYMBOL: browser-pane
@ -45,7 +43,7 @@ SYMBOL: browser-pane
word-completion ;
: tutorial-button
"Factor tutorial" "tutorial" <link> simple-object terpri ;
{ "tutorial" } $link terpri ;
: listener-thread
pane get [

View File

@ -6,9 +6,6 @@ gadgets-labels gadgets-layouts gadgets-scrolling gadgets-theme
generic hashtables io kernel line-editor math namespaces
sequences strings styles threads ;
! Input history
TUPLE: input string ;
! A pane is an area that can display text.
! output: pile

View File

@ -4,53 +4,38 @@ IN: words
USING: errors hashtables kernel lists namespaces sequences
strings ;
! If true in current namespace, we are bootstrapping.
SYMBOL: bootstrapping?
SYMBOL: vocabularies
: word ( -- word ) \ word global hash ;
: set-word ( word -- ) \ word set-global ;
: vocabs ( -- list )
#! Push a list of vocabularies.
vocabularies get hash-keys string-sort ;
: vocabs ( -- seq ) vocabularies get hash-keys string-sort ;
: vocab ( name -- vocab )
#! Get a vocabulary.
vocabularies get hash ;
: vocab ( name -- vocab ) vocabularies get hash ;
: ensure-vocab ( name -- )
#! Create the vocabulary if it does not exist.
vocabularies get [ nest drop ] bind ;
: ensure-vocab ( name -- ) vocabularies get [ nest drop ] bind ;
: words ( vocab -- list )
#! Push a list of all words in a vocabulary.
#! Filter empty slots.
vocab dup [ hash-values ] when ;
: words ( vocab -- list ) vocab dup [ hash-values ] when ;
: all-words ( -- list )
vocabs [ words ] map concat ;
: all-words ( -- list ) vocabs [ words ] map concat ;
: each-word ( quot -- )
#! Apply a quotation to each word in the image.
all-words swap each ; inline
: each-word ( quot -- ) all-words swap each ; inline
: word-subset ( pred -- list | pred: word -- ? )
#! A list of words matching the predicate.
: 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 ( -- )
#! Update word cross referencing information.
crossref get clear-hash [ add-crossref ] each-word ;
: lookup ( name vocab -- word ) vocab ?hash ;
: reveal ( word -- )
#! Add a new word to its vocabulary.
vocabularies get [
dup word-name over word-vocabulary nest set-hash
] bind ;
@ -60,9 +45,6 @@ SYMBOL: vocabularies
string? [ "Word name is not a string" throw ] unless ;
: create ( name vocab -- word )
#! Create a new word in a vocabulary. If the vocabulary
#! already contains the word, the existing instance is
#! returned.
2dup check-create 2dup lookup dup
[ 2nip ] [ drop <word> dup init-word dup reveal ] if ;
@ -70,7 +52,6 @@ SYMBOL: vocabularies
>r "<" swap ">" append3 r> create ;
: forget ( word -- )
#! Remove a word definition.
dup uncrossref
crossref get [ dupd remove-hash ] when*
dup word-name swap word-vocabulary vocab remove-hash ;
@ -78,9 +59,7 @@ SYMBOL: vocabularies
: target-word ( word -- word )
dup word-name swap word-vocabulary lookup ;
: interned? ( word -- ? )
#! Test if the word is a member of its vocabulary.
dup target-word eq? ;
: interned? ( word -- ? ) dup target-word eq? ;
: bootstrap-word ( word -- word )
dup word-name swap word-vocabulary

View File

@ -0,0 +1,83 @@
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." } ;

View File

@ -1,69 +1,69 @@
! Copyright (C) 2004, 2005 Slava Pestov.
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: words
USING: generic hashtables kernel kernel-internals lists math
namespaces sequences strings vectors ;
: init-word ( word -- )
H{ } clone swap set-word-props ;
GENERIC: definer ( word -- word )
! The basic word type. Words can be named and compared using
! identity. They hold a property map.
PREDICATE: word undefined ( obj -- ? ) word-primitive 0 = ;
M: undefined definer drop \ DEFER: ;
: word-prop ( word name -- value )
swap word-props hash ;
PREDICATE: word compound ( obj -- ? ) word-primitive 1 = ;
M: compound definer drop \ : ;
PREDICATE: word primitive ( obj -- ? ) word-primitive 2 > ;
M: primitive definer drop \ PRIMITIVE: ;
PREDICATE: word symbol ( obj -- ? ) word-primitive 2 = ;
M: symbol definer drop \ SYMBOL: ;
: init-word ( word -- ) H{ } clone swap set-word-props ;
: word-prop ( word name -- value ) swap word-props hash ;
: remove-word-prop ( word name -- )
swap word-props remove-hash ;
: set-word-prop ( word value name -- )
rot word-props pick [ set-hash ] [ remove-hash drop ] if ;
over
[ rot word-props set-hash ]
[ nip remove-word-prop ] if ;
! Pointer to executable native code
GENERIC: word-xt
M: word word-xt ( w -- xt ) 7 integer-slot ;
GENERIC: set-word-xt
M: word set-word-xt ( xt w -- ) 7 set-integer-slot ;
: word-sort ( list -- list )
#! Sort a list of words by name.
[ [ word-name ] 2apply lexi ] sort ;
: word-sort ( seq -- seq ) [ [ word-name ] 2apply lexi ] sort ;
: uses ( word -- uses )
#! Outputs a list of words that this word directly calls.
[
dup word-def [
dup word?
[ 2dup eq? [ dup dup set ] unless ] when
2drop
] tree-each-with
word-def
[ dup word? [ dup dup set ] when drop ] tree-each
] make-hash hash-keys ;
! The cross-referencer keeps track of word dependencies, so that
! words can be recompiled when redefined.
SYMBOL: crossref
: (add-crossref) crossref get [ dupd nest set-hash ] bind ;
: add-crossref ( word -- )
#! Marks each word in the quotation as being a dependency
#! of the word.
crossref get [
dup dup uses [ (add-crossref) ] each-with
] when drop ;
: usages ( word -- deps )
#! List all usages of a word. This is a transitive closure,
#! so indirect usages are reported.
crossref get dup [ closure ] [ 2drop { } ] if ;
: usage ( word -- list )
#! List all direct usages of a word.
: usage ( word -- seq )
crossref get ?hash dup [ hash-keys ] when ;
: usages ( word -- deps )
crossref get dup [ closure ] [ 2drop { } ] if ;
GENERIC: (uncrossref) ( word -- )
M: word (uncrossref) drop ;
: remove-crossref ( usage user -- )
: remove-crossref ( callee caller -- )
crossref get [ nest remove-hash ] bind ;
: uncrossref ( word -- )
@ -72,49 +72,25 @@ M: word (uncrossref) drop ;
dup (uncrossref) dup usages [ (uncrossref) ] each
] when drop ;
! The word primitive combined with the word def specify what the
! word does when invoked.
: define ( word primitive parameter -- )
: define ( word parameter primitive -- )
pick uncrossref
pick set-word-def
over set-word-primitive
update-xt ;
pick set-word-primitive
over set-word-def
dup update-xt
add-crossref ;
GENERIC: definer ( word -- word )
#! Return the parsing word that defined this word.
! Undefined words raise an error when invoked.
PREDICATE: word undefined ( obj -- ? ) word-primitive 0 = ;
M: undefined definer drop \ DEFER: ;
! Primitives are defined in the runtime.
PREDICATE: word primitive ( obj -- ? ) word-primitive 2 > ;
M: primitive definer drop \ PRIMITIVE: ;
! Symbols push themselves when executed.
PREDICATE: word symbol ( obj -- ? ) word-primitive 2 = ;
M: symbol definer drop \ SYMBOL: ;
: define-symbol ( word -- ) 2 over define ;
: define-symbol ( word -- ) dup 2 define ;
: intern-symbol ( word -- )
dup undefined? [ define-symbol ] [ drop ] if ;
! Compound words invoke a quotation when executed.
PREDICATE: word compound ( obj -- ? ) word-primitive 1 = ;
M: compound definer drop \ : ;
: define-compound ( word def -- ) 1 define ;
: define-compound ( word def -- )
over >r 1 swap define r> add-crossref ;
: reset-props ( word seq -- )
[ f swap set-word-prop ] each-with ;
: reset-props ( word seq -- ) [ remove-word-prop ] each-with ;
: reset-word ( word -- )
{
"parsing" "inline" "foldable" "flushable" "predicating"
} reset-props ;
{ "parsing" "inline" "foldable" "flushable" "predicating" }
reset-props ;
: reset-generic ( word -- )
dup reset-word { "methods" "combination" } reset-props ;
@ -122,8 +98,6 @@ M: compound definer drop \ : ;
M: word literalize <wrapper> ;
: gensym ( -- word )
#! Return a word that is distinct from every other word, and
#! is not contained in any vocabulary.
"G:"
global [ \ gensym dup inc get ] bind
number>string append f <word> dup init-word ;

138
library/words.facts Normal file
View File

@ -0,0 +1,138 @@
USING: help kernel words ;
IN: help
: $defining-note
drop
"Calling this word directly is not necessary in most cases. High-level defining words call it automatically." print-element ;
HELP: word-props "( word -- props )"
{ $values { "word" "a word" } { "props" "a hashtable" } }
{ $description "Outputs a word's property hashtable." } ;
HELP: set-word-props "( props word -- )"
{ $values { "props" "a hashtable" } { "word" "a word" } }
{ $description "Sets a word's property hashtable." }
{ $notes "The given hashtable must not be a literal, since it will get mutated by future calls to " { $link set-word-prop } "." } ;
HELP: word-primitive "( word -- n )"
{ $values { "word" "a word" } { "n" "a non-negative integer" } }
{ $description "Outputs a word's primitive number." } ;
HELP: set-word-primitive "( n word -- )"
{ $values { "n" "a non-negative integer" } { "word" "a word" } }
{ $description "Sets a word's primitive number." }
{ $notes "Changing the primitive number does not update the execution token, and the word will still call its old definition until a subsequent call to " { $link update-xt } "." } ;
HELP: word-def "( word -- obj )"
{ $values { "word" "a word" } { "obj" "an object" } }
{ $description "Outputs a word's primitive parameter. This parameter is only used if the primitive number is 1 (compound definitions) or 2 (symbols)." } ;
HELP: set-word-def "( obj word -- )"
{ $values { "obj" "an object" } { "word" "a word" } }
{ $description "Sets a word's primitive parameter." }
$defining-note ;
HELP: init-word "( word -- )"
{ $values { "word" "a word" } }
{ $description "Initializes a word output from the " { $link <word> } " primitive." } ;
HELP: word-prop "( word name -- value )"
{ $values { "word" "a word" } { "name" "a property name" } { "value" "a property value" } }
{ $description "Retrieves a word property. Word property names are conventionally strings." } ;
HELP: set-word-prop "( word value name -- )"
{ $values { "word" "a word" } { "value" "a property value" } { "name" "a property name" } }
{ $description "Stores a word property. Word property names are conventionally strings." } ;
HELP: remove-word-prop "( word name -- )"
{ $values { "word" "a word" } { "name" "a property name" } }
{ $description "Removes a word property, so future lookups will output " { $link f } " until it is set again. Word property names are conventionally strings." } ;
HELP: word-xt "( word -- xt )"
{ $values { "word" "a word" } { "xt" "an execution token integer" } }
{ $description "Outputs the machine code address of the word's definition." } ;
HELP: set-word-xt "( xt word -- )"
{ $values { "xt" "an execution token integer" } { "word" "a word" } }
{ $description "Sets the machine code address of the word's definition." }
{ $safety "This word is unsafe. Specifying an invalid address can corrupt memory and crash the runtime." }
{ $notes "This word is used by the compiler." } ;
HELP: word-sort "( seq -- sorted )"
{ $values { "seq" "a sequence of words" } { "sorted" "a sorted sequence" } }
{ $description "Sorts a sequence of words by word name." } ;
HELP: uses "( word -- seq )"
{ $values { "word" "a word" } { "seq" "a sequence of words" } }
{ $description "Outputs a sequence of words directory called by the given word." }
{ $notes "The sequence will include the word itself if it is recursive." }
{ $see-also uses } ;
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 } ;
HELP: add-crossref "( word -- )"
{ $values { "word" "a word" } }
{ $description "Adds dependencies from every word called by this word to this word." }
$defining-note ;
HELP: usage "( word -- seq )"
{ $values { "word" "a word" } { "seq" "a sequence of words" } }
{ $description "Outputs a sequence of words that directly call the given word." }
{ $notes "The sequence will include the word itself if it is recursive." }
{ $see-also usage } ;
HELP: usages "( word -- seq )"
{ $values { "word" "a word" } { "seq" "a sequence of words" } }
{ $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 -- )"
{ $values { "word" "a word" } }
{ $contract "Updates the word to cope with a callee being redefined." }
$defining-note ;
HELP: remove-crossref "( callee caller -- )"
{ $values { "callee" "a word" } { "caller" "a word" } }
{ $description "Remove the fact that " { $snippet "caller" } " calls " { $snippet "callee" } " from the cross-referencing database." }
$defining-note ;
HELP: define "( word def primitive -- )"
{ $values { "word" "a word" } { "def" "an object" } { "primitive" "a non-negative integer" } }
{ $description "Defines a word and updates cross-referencing." }
$defining-note
{ $see-also define-symbol define-compound } ;
HELP: define-symbol "( word -- )"
{ $values { "word" "a word" } }
{ $description "Defines the word to push itself on the stack when executed." } ;
HELP: define-compound "( word def -- )"
{ $values { "word" "a word" } { "def" "a quotation" } }
{ $description "Defines the word to call a quotation when executed." } ;
HELP: reset-word "( word -- )"
{ $values { "word" "a word" } }
{ $description "Reset word declarations." }
$defining-note ;
HELP: reset-generic "( word -- )"
{ $values { "word" "a word" } }
{ $description "Reset word declarations and generic word properties." }
$defining-note ;
HELP: gensym "( -- word )"
{ $values { "word" "a word" } }
{ $description "Creates an uninterned word that is not equal to any other word in the system. Gensyms have an automatically-generated name based on a prefix and an incrementing counter." }
{ $examples { $example "gensym ." "G:260561" } }
{ $notes "Gensyms are often used as placeholder values that have no meaning of their own but must be unique. For example, the compiler uses gensyms to label sections of assembly code." } ;
HELP: definer "( word -- definer )"
{ $values { "word" "a word" } { "definer" "a word" } }
{ $description "Outputs the parsing word that defines the given word." }
{ $examples
{ $example ": foo ; \ foo definer ." "POSTPONE: :" }
{ $example "SYMBOL: foo \ foo definer ." "POSTPONE: SYMBOL:" }
} ;