HELP: syntax change

slava 2006-08-16 01:23:05 +00:00
parent 81dfc98eff
commit c99c10632c
44 changed files with 632 additions and 574 deletions

View File

@ -1,13 +1,15 @@
+ 0.84:
- declaration to do:
- test what is done in the case of an invalid declaration on an inline
recursive
- doc mashup:
- HELP: should not specify stack effect
- bootstrap speedup with compiling recursives
- load cocoa before 'recompile' call
- figure out what to do for parsing words
- document inference errors
- update docs for declared effects
- better doc for accumulate, link from tree
- declaration to do:
- bootstrap speedup with compiling recursives
- load cocoa before 'recompile' call
- RT_WORD should refer to XTs not word objects.
- fix contribs: boids, automata
- sometimes darcs get fails with the httpd
@ -22,8 +24,6 @@
- [ [ dup call ] dup call ] infer hangs
- graphical module manager tool
- see if alien calls can be made faster
- doc front page: document stack effect notation
- better doc for accumulate, link from tree
+ 0.85:
@ -105,6 +105,8 @@
+ compiler/ffi:
- test what is done in the case of an invalid declaration on an inline
recursive
- ppc64 backend
- we need to optimize [ dup array? [ array? ] [ array? ] if ]
- mac intel: struct returns from objc methods

View File

@ -0,0 +1,3 @@
ARTICLE: "compiler" "The compiler"
"Foo bar"
;

View File

@ -14,8 +14,9 @@ ARTICLE: "conventions" "Conventions"
{ { { $snippet "seq" } } "a sequence" }
{ { { $snippet "str" } } "a string" }
{ { { $snippet "x" } ", " { $snippet "y" } ", " { $snippet "z" } } "a number" }
{ { { $snippet "{ " { $emphasis "a b c" } " }" } } "an array with specific length and elements" }
{ { $snippet "*" } "when this symbol appears by itself in the list of outputs, it means the word unconditionally throws an error" }
}
"The compiler verifies stack effect comments to ensure the correct number of inputs and outputs is listed. See " { $link "compiler" } "."
{ $heading "Word naming conventions" }
"These conventions are not hard and fast, but are usually a good first step in understanding a word's behavior:"
{ $table
@ -35,4 +36,4 @@ ARTICLE: "conventions" "Conventions"
{ $heading "Vocabulary naming conventions" }
"A vocabulary name ending in " { $snippet "-internals" } " contains words which are either implementation detail, unsafe, or both. For example, the " { $snippet "sequence-internals" } " vocabulary contains words which access sequence elements without bounds checking (" { $link "sequences-unsafe" } ")."
$terpri
"You should should avoid using internal words from the Factor library unless absolutely necessary. In your own code, place words in internal vocabularies if you do not want other people to use them unless they have a good reason." ;
"You should should avoid using internal words from the Factor library unless absolutely necessary. Similarly, your own code can place words in internal vocabularies if you do not want other people to use them unless they have a good reason." ;

View File

@ -7,9 +7,11 @@ ARTICLE: "handbook" "Factor documentation"
{ $subsection "changes" }
{ $heading "Survival guide" }
{ $list
{ "Load source files using " { $link run-file } ":"
{ "The basic unit of code, corresponding to a \"function\" in other languages, is called a " { $emphasis "word" } " in Factor." }
{ "Word take inputs from the stack, and leave output values on the stack. This is documented in a " { $emphasis "stack effect comment" } ", for example " { $snippet "( x y -- z )" } " denotes that a word takes two inputs, with " { $snippet "y" } " at the top of the stack, and returns one output. See " { $link "conventions" } " for details." }
{ "You can load source files with " { $link run-file } ":"
{ $code "\"examples/lcd.factor\" run-file" } }
{ { "Load modules from " { $snippet "contrib/" } " using " { $link require } ":" }
{ { "You can load " { $snippet "contrib/" } " modules with " { $link require } ":" }
{ $code "\"httpd\" require" } }
{ { $link .s } " prints the contents of the stack." }
{ { $link . } " prints the object at the top of the stack." }

View File

@ -220,6 +220,7 @@ sequences vectors words ;
"/library/ui/tools/launchpad.factor"
"/library/continuations.facts"
"/library/effects.facts"
"/library/errors.facts"
"/library/kernel.facts"
"/library/modules.facts"
@ -309,6 +310,7 @@ sequences vectors words ;
"/doc/handbook/changes.facts"
"/doc/handbook/cli.facts"
"/doc/handbook/collections.facts"
"/doc/handbook/compiler.facts"
"/doc/handbook/conventions.facts"
"/doc/handbook/cookbook.facts"
"/doc/handbook/dataflow.facts"

View File

@ -50,9 +50,6 @@ parser sequences sequences-internals words ;
compile-all
] with-class<cache
"Initializing native I/O..." print flush
"native-io" get [ init-io ] when
"cocoa" get [
"/library/compiler/alien/objc/load.factor" run-resource
"/library/ui/cocoa/load.factor" run-resource
@ -65,9 +62,11 @@ parser sequences sequences-internals words ;
"Recompiling just in case..." print flush
recompile
! We only do this if we are compiled, otherwise it takes
! too long.
"Initializing native I/O..." print flush
"native-io" get [ init-io ] when
! We only do this if we are compiled, otherwise it
! takes too long.
"Building online help search index..." print flush
H{ } clone parent-graph set-global xref-help
H{ } clone term-index set-global index-help

View File

@ -1,6 +1,6 @@
IN: image
USING: help io ;
HELP: make-image "( architecture -- )"
HELP: make-image
{ $values { "architecture" "a string" } }
{ $description "Creates a bootstrap image from sources, where " { $snippet "architecture" } " is one of " { $snippet "x86" } ", " { $snippet "ppc" } " or " { $snippet "amd64" } ". The new image file is written to the current working directory (see " { $link cwd } ") and is named " { $snippet "boot.image." { $emphasis "architecture" } } "." } ;

View File

@ -1,5 +1,5 @@
IN: kernel-internals
USING: help kernel ;
HELP: boot "( -- )"
{ $description "Called on startup as part of the boot quotation (see " { $link set-boot } ") to initialize the runtime and get ready to run user code." } ;
HELP: boot
{ $description "Called on startup as part of the boot quotation (see " { $link set-boot } ") to initialize the runtime and prepare it for running user code." } ;

View File

@ -2,41 +2,41 @@ IN: arrays
USING: help kernel kernel-internals prettyprint strings
vectors ;
HELP: array f
HELP: array
{ $description "The class of fixed-length arrays. See " { $link "syntax-arrays" } " for syntax and " { $link "arrays" } " for general information." } ;
HELP: <array> "( n elt -- array )"
HELP: <array> ( n elt -- array )
{ $values { "n" "a non-negative integer" } { "elt" "an initial element" } { "array" "a new array" } }
{ $description "Creates a new array with the given length and all elements initially set to " { $snippet "elt" } "." }
{ $see-also <quotation> <string> <sbuf> <vector> } ;
HELP: >array "( seq -- array )"
HELP: >array
{ $values { "seq" "a sequence" } { "array" "an array" } }
{ $description "Outputs a freshly-allocated array with the same elements as a given sequence." }
{ $see-also >string >sbuf >vector >quotation } ;
HELP: 1array "( x -- array )"
HELP: 1array
{ $values { "x" "an object" } { "array" "an array" } }
{ $description "Create a new array with one element." }
{ $see-also 2array 3array ch>string } ;
HELP: 2array "( x y -- array )"
HELP: 2array
{ $values { "x" "an object" } { "y" "an object" } { "array" "an array" } }
{ $description "Create a new array with two elements." }
{ $see-also 1array 3array ch>string } ;
HELP: 3array "( x y z -- array )"
HELP: 3array
{ $values { "x" "an object" } { "y" "an object" } { "z" "an object" } { "array" "an array" } }
{ $description "Create a new array with three elements." }
{ $see-also 1array 2array ch>string } ;
HELP: resize-array "( n array -- newarray )"
HELP: resize-array ( n array -- newarray )
{ $values { "n" "a non-negative integer" } { "array" "an array" } { "newarray" "a new array" } }
{ $description "Creates a new array of " { $snippet "n" } " elements. The contents of the existing array are copied into the new array; if the new array is shorter, only an initial segment is copied, and if the new array is longer the remaining space is filled in with "{ $link f } "." } ;
HELP: byte-array f
HELP: byte-array
{ $description "The class of byte arrays." } ;
HELP: <byte-array> "( n -- byte-array )"
HELP: <byte-array> ( n -- byte-array )
{ $values { "n" "a non-negative integer" } { "byte-array" "a new byte array" } }
{ $description "Creates a new byte array holding " { $snippet "n" } " bytes." } ;

View File

@ -1,6 +1,6 @@
USING: help sequences ;
HELP: flatten "( seq -- seq)"
HELP: flatten
{ $values { "obj" "an object" } { "seq" "a new sequence" } }
{ $description "Recursively descends into lists, arrays, vectors and wrappers. Leaf elements are collected into a new sequence which is output at the end of the traversal." }
{ $notes "This word does not descend into virtual sequences, or user-defined sequences." } ;

View File

@ -1,26 +1,26 @@
IN: graphs
USING: help ;
HELP: add-vertex "( vertex edges graph -- )"
HELP: add-vertex
{ $values { "vertex" "an object" } { "edges" "a quotation with stack effect " { $snippet "( vertex -- seq )" } } { "graph" "a hashtable mapping vertices to sequences of edges" } }
{ $description "Adds a vertex to a directed graph, using the " { $snippet "edges" } " quotation to generate a sequence of edges leaving the vertex." }
{ $side-effects "graph" } ;
HELP: build-graph "( seq edges graph -- )"
HELP: build-graph
{ $values { "seq" "a sequence" } { "edges" "a quotation with stack effect " { $snippet "( vertex -- seq )" } } { "graph" "a hashtable mapping vertices to sequences of edges" } }
{ $description "Removes all vertices from the graph, then reconstructs it using the given sequence of vertices and quotation to generate a sequence of edges leaving each vertex." }
{ $side-effects "graph" } ;
HELP: remove-vertex "( vertex edges graph -- )"
HELP: remove-vertex
{ $values { "vertex" "an object" } { "edges" "a quotation with stack effect " { $snippet "( vertex -- seq )" } } { "graph" "a hashtable mapping vertices to sequences of edges" } }
{ $description "Removes a vertex from a graph, using the quotation to generate a sequence of edges leaving the vertex." }
{ $notes "The " { $snippet "edges" } " quotation must produce the same return value as it did when " { $link add-vertex } " was called, otherwise some vertices of the graph may continue to refer to the removed vertex." }
{ $side-effects "graph" } ;
HELP: in-edges "( vertex graph -- seq )"
HELP: in-edges
{ $values { "vertex" "an object" } { "graph" "a hashtable mapping vertices to sequences of edges" } { "seq" "a sequence of vertices" } }
{ $description "Outputs a sequence of vertices incident to an edge entering the given vertex." } ;
HELP: closure "( vertex quot -- seq )"
{ $values { "vertex" "an object" } { "quot" "a a quotation with stack effect " { $snippet "( vertex -- seq )" } } { "seq" "a sequence of vertices" } }
HELP: closure
{ $values { "obj" "an object" } { "quot" "a a quotation with stack effect " { $snippet "( obj -- seq )" } } { "seq" "a new sequence" } }
{ $description "Outputs a sequence of all vertices reachable from " { $snippet "vertex" } " via edges given by the quotation. This sequence always includes " { $snippet "vertex" } "." } ;

View File

@ -20,7 +20,7 @@ GENERIC: set-fill ( n seq -- )
[ swap >r + 0 swap r> set-nth-unsafe ] 3keep
] repeat 2drop ;
: new-size ( n -- n ) 1+ 3 * ; inline
: new-size ( old -- new ) 1+ 3 * ; inline
: ensure ( n seq -- )
2dup length >= [
@ -39,11 +39,11 @@ TUPLE: bounds-error index seq ;
: bounds-check ( n seq -- n seq )
2dup bounds-check? [ bounds-error ] unless ; inline
: grow-length ( len seq -- )
: grow-length ( n seq -- )
growable-check
2dup length < [ 2dup contract ] when
2dup capacity > [ 2dup expand ] when
set-fill ; inline
: clone-growable ( obj -- obj )
: clone-growable ( seq -- newseq )
(clone) dup underlying clone over set-underlying ; inline

View File

@ -1,49 +1,49 @@
IN: sequences-internals
USING: help kernel sequences ;
HELP: set-fill "( n seq -- )"
HELP: set-fill
{ $values { "n" "a new fill pointer" } { "seq" "a growable sequence" } }
{ $contract "Sets the fill pointer (number of occupied elements in the underlying storage) of a growable sequence." }
{ $side-effects "seq" }
{ $warning "This word is in the " { $vocab-link "sequences-internals" } " vocabulary because it is not safe. Changing the fill pointer to a negative value, or a value higher than the underlying sequence length can lead to memory corruption. User code should use " { $link set-length } " instead." } ;
HELP: underlying "( seq -- underlying )"
HELP: underlying
{ $values { "seq" "a growable sequence" } { "underlying" "the underlying sequence" } }
{ $contract "Outputs the underlying storage of a growable sequence." } ;
HELP: set-underlying "( underlying seq -- )"
HELP: set-underlying
{ $values { "underlying" "a growable sequence" } { "seq" "a vector, string buffer or hashtable" } }
{ $contract "Modifies the underlying storage of a growable sequence." }
{ $warning "This word is in the " { $vocab-link "sequences-internals" } " vocabulary because it is not safe. Setting an underlying sequence shorter than the fill pointer can lead to memory corruption." } ;
HELP: capacity "( seq -- n )"
HELP: capacity
{ $values { "seq" "a vector or string buffer" } { "n" "the capacity of the sequence" } }
{ $description "Pushes the number of elements the sequence can hold without growing." } ;
{ $description "Outputs the number of elements the sequence can hold without growing." } ;
HELP: new-size "( old -- new )"
HELP: new-size
{ $values { "old" "a positive integer" } { "new" "a positive integer" } }
{ $description "Computes the new size of a growable sequence." } ;
HELP: ensure "( n seq -- )"
HELP: ensure
{ $values { "n" "a positive integer" } { "seq" "a growable sequence" } }
{ $description "If " { $snippet "n" } " is less than the length of the sequence, does nothing. Otherwise, if " { $snippet "n" } " also exceeds the capacity of the underlying storage, the underlying storage is grown, and the fill pointer is reset. Finally, if " { $snippet "n" } " is greater than or equal to the length but less than the capacity of the underlying storage, the fill pointer is moved and nothing else is done."
$terpri
"This word is used in the implementation of the " { $link set-nth } " generic for sequences supporting the growable sequence protocol (see " { $link "sequences-growable" } ")."
} ;
HELP: bounds-error "( n seq -- )"
HELP: bounds-error
{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
{ $description "Throws a " { $link bounds-error } "." }
{ $error-description "Thrown by " { $link nth } ", " { $link set-nth } " and " { $link set-length } " if the given index lies beyond the bounds of the sequence." } ;
HELP: bounds-check "( n seq -- n seq )"
HELP: bounds-check
{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
{ $description "Throws an error if " { $snippet "n" } " is negative or if it is greater than or equal to the length of " { $snippet "seq" } ". Otherwise the two inputs remain on the stack." } ;
HELP: grow-length "( n seq -- )"
HELP: grow-length
{ $values { "n" "a positive integer" } { "seq" "a sequence" } }
{ $description "An implementation of the " { $link set-length } " generic for sequences supporting the growable sequence protocol (see " { $link "sequences-growable" } ")." } ;
HELP: clone-growable "( seq -- seq )"
{ $values { "seq" "a sequence" } { "seq" "a fresh sequence" } }
HELP: clone-growable
{ $values { "seq" "a sequence" } { "newseq" "a fresh sequence" } }
{ $description "An implementation of the " { $link clone } " generic for sequences supporting the growable sequence protocol (see " { $link "sequences-growable" } ")." } ;

View File

@ -9,10 +9,10 @@ TUPLE: tombstone ;
: ((empty)) T{ tombstone f } ; inline
: ((tombstone)) T{ tombstone t } ; inline
: hash@ ( key keys -- n )
: hash@ ( key array -- i )
>r hashcode r> array-capacity 2 /i rem 2 * >fixnum ; inline
: probe ( keys i -- hash i )
: probe ( array i -- array i )
2 fixnum+fast over array-capacity fixnum-mod ; inline
: (key@) ( key keys i -- n )
@ -27,7 +27,7 @@ TUPLE: tombstone ;
] if
] if ; inline
: key@ ( key hash -- n )
: key@ ( key hash -- i )
hash-array 2dup hash@ (key@) ; inline
: if-key ( key hash true false -- )
@ -54,7 +54,7 @@ TUPLE: tombstone ;
] if
] if ; inline
: new-key@ ( key hash -- n )
: new-key@ ( key hash -- i )
hash-array 2dup hash@ (new-key@) ; inline
: nth-pair ( n seq -- key value )
@ -63,10 +63,10 @@ TUPLE: tombstone ;
: set-nth-pair ( value key n seq -- )
[ set-array-nth ] 2keep >r 1+ r> set-array-nth ; inline
: hash-count+
: hash-count+ ( hash -- )
dup hash-count 1+ swap set-hash-count ; inline
: hash-deleted+
: hash-deleted+ ( hash -- )
dup hash-deleted 1+ swap set-hash-deleted ; inline
: change-size ( hash old -- )
@ -115,7 +115,7 @@ TUPLE: tombstone ;
IN: hashtables
: <hashtable> ( capacity -- hashtable )
: <hashtable> ( n -- hash )
(hashtable) [ reset-hash ] keep ;
: hash* ( key hash -- value ? )
@ -128,12 +128,12 @@ IN: hashtables
: hash-member? ( key hash -- ? )
[ 3drop t ] [ 3drop f ] if-key ;
: ?hash* ( key hash -- value/f ? )
: ?hash* ( key hash/f -- value/f ? )
dup [ hash* ] [ 2drop f f ] if ;
: hash ( key hash -- value ) hash* drop ; inline
: ?hash ( key hash -- value )
: ?hash ( key hash/f -- value )
dup [ hash ] [ 2drop f ] if ;
: clear-hash ( hash -- )
@ -148,7 +148,7 @@ IN: hashtables
3drop
] if-key ;
: remove-hash* ( key hash -- oldvalue )
: remove-hash* ( key hash -- old )
[ hash ] 2keep remove-hash ;
: ?remove-hash ( key hash -- )
@ -174,14 +174,14 @@ IN: hashtables
: hash+ ( n key hash -- )
[ hash [ 0 ] unless* + ] 2keep set-hash ;
: associate ( value key -- hashtable )
: associate ( value key -- hash )
2 <hashtable> [ set-hash ] keep ;
: hash-keys ( hash -- keys ) 0 swap hash>seq ;
: hash-values ( hash -- keys ) 1 swap hash>seq ;
: hash-values ( hash -- values ) 1 swap hash>seq ;
: hash>alist ( hash -- assoc )
: hash>alist ( hash -- alist )
dup hash-keys swap hash-values 2array flip ;
: alist>hash ( alist -- hash )
@ -195,7 +195,7 @@ IN: hashtables
swap [ 2swap [ >r -rot r> call ] 2keep ] hash-each 2drop ;
inline
: hash-all? ( hash quot -- )
: hash-all? ( hash quot -- ? )
>r hash-array r> all-pairs? ; inline
: hash-all-with? ( obj hash quot -- )
@ -203,12 +203,12 @@ IN: hashtables
[ 2swap [ >r -rot r> call ] 2keep rot ] hash-all? 2nip ;
inline
: subhash? ( h1 h2 -- ? )
: subhash? ( hash1 hash2 -- ? )
swap [
>r swap hash* [ r> = ] [ r> 2drop f ] if
] hash-all-with? ;
: hash-subset ( hash quot -- hash )
: hash-subset ( hash quot -- subhash )
over hash-size <hashtable> rot [
2swap [
>r pick pick >r >r call [
@ -219,7 +219,7 @@ IN: hashtables
] 2keep
] hash-each nip ; inline
: hash-subset-with ( obj hash quot -- hash )
: hash-subset-with ( obj hash quot -- subhash )
swap
[ 2swap [ >r -rot r> call ] 2keep rot ] hash-subset 2nip ;
inline
@ -274,22 +274,19 @@ IN: hashtables
: hash-stack ( key seq -- value )
dup length 1- swap (hash-stack) ;
: hash-intersect ( hash1 hash2 -- hash1/\hash2 )
: hash-intersect ( hash1 hash2 -- intersection )
[ drop swap hash ] hash-subset-with ;
: hash-diff ( hash1 hash2 -- hash2-hash1 )
: hash-diff ( hash1 hash2 -- difference )
[ drop swap hash not ] hash-subset-with ;
: hash-update ( hash1 hash2 -- )
[ swap rot set-hash ] hash-each-with ;
: hash-concat ( seq -- hash )
H{ } clone swap [ dupd hash-update ] each ;
: hash-union ( hash1 hash2 -- hash1\/hash2 )
: hash-union ( hash1 hash2 -- union )
>r clone dup r> hash-update ;
: remove-all ( hash seq -- seq )
: remove-all ( hash seq -- subseq )
[ swap hash-member? not ] subset-with ;
: cache ( key hash quot -- value )

View File

@ -1,256 +1,247 @@
IN: hashtables
USING: hashtables-internals help inspector kernel prettyprint ;
HELP: hashtable f
HELP: hashtable
{ $description "The class of hashtables. See " { $link "syntax-hashtables" } " for syntax and " { $link "hashtables" } " for general information." } ;
HELP: hashcode "( object -- n )"
{ $values { "object" "an object" } { "n" "an integer" } }
{ $contract "Outputs the hashcode of the object. The fundamental invariant that must never be violated is that if two objects are equal under " { $link = } ", they must have the same hashcode." }
{ $notes "If mutable objects are used as hashtable keys, they must not be mutated in such a way that their hashcode changes. Doing so will violate bucket sorting invariants and result in undefined behavior." } ;
HELP: hash@ "( key array -- i )"
HELP: hash@
{ $values { "key" "a key" } { "array" "the underlying array of a hashtable" } { "i" "the index to begin hashtable search" } }
{ $description "Computes the index to begin searching from the hashcode of the key. Always outputs an even value since keys are stored at even indices of the underlying array." } ;
HELP: probe "( array i -- array i )"
HELP: probe
{ $values { "array" "the underlying array of a hashtable" } { "i" "a search index" } }
{ $description "Outputs the next hashtable search index." } ;
HELP: key@ "( key hash -- i )"
HELP: key@
{ $values { "key" "a key" } { "hash" "a hashtable" } { "i" "the index of the key, or -1 if it is not present" } }
{ $description "Searches the hashtable for the key using a linear probing strategy. Searches stop if either the key or an " { $link ((empty)) } " sentinel is found. Searches skip the " { $link ((tombstone)) } " sentinel." }
{ $see-also new-key@ } ;
HELP: new-key@ "( key hash -- i )"
HELP: new-key@
{ $values { "key" "a key" } { "hash" "a hashtable" } { "i" "the index where the key would be stored" } }
{ $description "Searches the hashtable for the key using a linear probing strategy. If the key is not present in the hashtable, outputs the index where it should be stored." }
{ $see-also new-key@ } ;
HELP: if-key "( key hash true false -- )"
HELP: if-key
{ $values { "key" "a key" } { "hash" "a hashtable" } { "true" "a quotation to call if the key is found, with stack effect " { $snippet "( true: index key hash -- )" } } { "false" "a quotation to call if the key is not found" } }
{ $description "Searches the hashtable for the key, calling one of the two quotations depending on the outcome." } ;
HELP: nth-pair "( n seq -- key value )"
HELP: nth-pair
{ $values { "n" "an index in the sequence" } { "seq" "a sequence" } { "key" "the first element of the pair" } { "value" "the second element of the pair" } }
{ $description "Fetches the elements with index " { $snippet "n" } " and " { $snippet "n+1" } ", respectively." }
{ $warning "This word is in the " { $vocab-link "hashtables-internals" } " vocabulary because it does not perform bounds checks." }
{ $see-also set-nth-pair } ;
HELP: set-nth-pair "( key value n seq -- )"
{ $values { "key" "the first element of the pair" } { "value" "the second element of the pair" } { "n" "an index in the sequence" } { "seq" "a sequence" } }
HELP: set-nth-pair
{ $values { "value" "the second element of the pair" } { "key" "the first element of the pair" } { "n" "an index in the sequence" } { "seq" "a sequence" } }
{ $description "Stores a pair of values into the elements with index " { $snippet "n" } " and " { $snippet "n+1" } ", respectively." }
{ $warning "This word is in the " { $vocab-link "hashtables-internals" } " vocabulary because it does not perform bounds checks." }
{ $side-effects "seq" }
{ $see-also nth-pair } ;
HELP: each-pair "( array quot -- )"
HELP: each-pair
{ $values { "array" "an array of pairs" } { "quot" "a quotation with stack effect " { $snippet "( key value -- )" } } }
{ $description "Applies a quotation to successive pairs in the array." }
{ $warning "This word is in the " { $vocab-link "hashtables-internals" } " vocabulary because passing an array of odd length can lead to memory corruption." } ;
HELP: all-pairs? "( array quot -- ? )"
HELP: all-pairs?
{ $values { "array" "an array of pairs" } { "quot" "a quotation with stack effect " { $snippet "( key value -- ? )" } } { "?" "conjunction of quotation outputs" } }
{ $description "Applies a predicate quotation to successive pairs in the array, and outputs true if the array is empty or if the quotation yields true for each pair." }
{ $warning "This word is in the " { $vocab-link "hashtables-internals" } " vocabulary because passing an array of odd length can lead to memory corruption." } ;
HELP: reset-hash "( n hash -- )"
HELP: reset-hash
{ $values { "n" "a positive integer specifying hashtable capacity" } { "hash" "a hashtable" } }
{ $description "Resets the underlying array of the hashtable to a new array with the given capacity. Removes all entries from the hashtable." }
{ $side-effects "hash" } ;
HELP: hash-count+ "( hash -- )"
HELP: hash-count+
{ $values { "hash" "a hashtable" } }
{ $description "Called to increment the hashtable size when a new entry is added with " { $link set-hash } }
{ $side-effects "hash" } ;
HELP: hash-deleted+ "( hash -- )"
HELP: hash-deleted+
{ $values { "hash" "a hashtable" } }
{ $description "Called to increment the deleted entry counter when an entry is removed with " { $link remove-hash } }
{ $side-effects "hash" } ;
HELP: change-size "( hash old -- )"
HELP: change-size
{ $values { "hash" "a hashtable" } { "old" "the key about to be overwritten" } }
{ $description "Called to update the hashtable counters when a new entry is added with " { $link set-hash } "." }
{ $side-effects "hash" } ;
HELP: (set-hash) "( value key hash -- )"
HELP: (set-hash)
{ $values { "value" "a value" } { "key" "a key to add" } { "hash" "a hashtable" } }
{ $description "Stores the key/value pair into the hashtable. This word does not grow the hashtable if it exceeds capacity, therefore a hang can result. User code should use " { $link set-hash } " instead, which grows the hashtable if necessary." }
{ $side-effects "hash" } ;
HELP: grow-hash "( hash -- )"
HELP: grow-hash
{ $values { "hash" "a hashtable" } }
{ $description "Enlarges the capacity of a hashtable. User code does not need to call this word directly." }
{ $see-also (set-hash) ?grow-hash set-hash }
{ $side-effects "hash" } ;
HELP: ?grow-hash "( hash -- )"
HELP: ?grow-hash
{ $values { "hash" "a hashtable" } }
{ $description "Enlarges the capacity of a hashtable if it is almost full. User code does not need to call this word directly." }
{ $see-also (set-hash) grow-hash set-hash }
{ $side-effects "hash" } ;
HELP: hash>seq "( i hash -- seq )"
HELP: hash>seq
{ $values { "i" "0 or 1" } { "hash" "a hashtable" } { "seq" "a sequence of keys or values" } }
{ $description "User code should not call this word. It is unsafe and only used in the implementation of " { $link hash-keys } " and " { $link hash-values } ", both of which are safe." }
{ $warning "This word is in the " { $vocab-link "hashtables-internals" } " vocabulary because passing an invalid value for " { $snippet "i" } " can lead to memory corruption." } ;
HELP: <hashtable> "( n -- hash )"
HELP: <hashtable>
{ $values { "n" "a positive integer specifying hashtable capacity" } { "hash" "a new hashtable" } }
{ $description "Create a new hashtable capable of storing " { $snippet "n" } " key/value pairs before growing." }
{ $see-also clear-hash hash-size hash-empty? } ;
HELP: (hashtable) "( -- hash )"
HELP: (hashtable) ( -- hash )
{ $values { "hash" "a new hashtable" } }
{ $description "Allocates a hashtable stub object without an underlying array. User code should call " { $link <hashtable> } " instead." } ;
HELP: associate "( value key -- hash )"
HELP: associate
{ $values { "value" "a value" } { "key" "a key" } }
{ $description "Create a new hashtable holding one key/value pair." } ;
HELP: clear-hash "( hash -- )"
HELP: clear-hash
{ $values { "hash" "a hashtable" } }
{ $description "Removes all entries from the hashtable." }
{ $see-also remove-hash }
{ $side-effects "hash" } ;
HELP: hash-size "( hash -- n )"
HELP: hash-size
{ $values { "hash" "a hashtable" } { "n" "a non-negative integer" } }
{ $description "Outputs the number of entries stored in the hashtable." } ;
HELP: hash-empty? "( hash -- ? )"
HELP: hash-empty?
{ $values { "hash" "a hashtable" } { "?" "a boolean" } }
{ $description "Tests if the hashtable does not contain any entries." } ;
HELP: hash* "( key hash -- value ? )"
HELP: hash*
{ $values { "key" "an object to look up in the hashtable" } { "hash" "a hashtable" } { "value" "the value associated to the key, or " { $link f } " if the key is not present in the hashtable" } { "?" "a boolean indicating if the key was present" } }
{ $description "Looks up the value associated with a key. The boolean flag can decide between the case of a missing value, and a value of " { $link f } "." }
{ $see-also hash-member? hash ?hash ?hash* } ;
HELP: hash-member? "( key hashtable -- ? )"
HELP: hash-member?
{ $values { "key" "an object to look up in the hashtable" } { "hash" "a hashtable" } }
{ $description "Tests if the hashtable contains a key/value pair whose key is equal to the given key." }
{ $see-also hash hash* ?hash ?hash* } ;
HELP: ?hash* "( key hashtable/f -- ? )"
HELP: ?hash*
{ $values { "key" "an object to look up in the hashtable" } { "hash/f" "a hashtable or " { $link f } } }
{ $description "A variant of " { $link hash* } " overloaded to return " { $link f } " if the given mapping is " { $link f } "." }
{ $see-also hash-member? hash hash* ?hash } ;
HELP: hash "( key hash -- value )"
HELP: hash
{ $values { "key" "an object to look up in the hashtable" } { "hash" "a hashtable" } { "value" "the value associated to the key, or " { $link f } " if the key is not present in the hashtable" } }
{ $description "Looks up the value associated with a key. No distinction is made between a missing value and a value set to " { $link f } "." }
{ $see-also hash-member? hash* ?hash ?hash* } ;
HELP: ?hash "( key hash/f -- ? )"
HELP: ?hash
{ $values { "key" "an object to look up in the hashtable" } { "hash/f" "a hashtable or " { $link f } } { "value" "the value associated to the key, or " { $link f } " if the key is not present in the hashtable" } }
{ $description "A variant of " { $link hash } " overloaded to return " { $link f } " if the given mapping is " { $link f } "." }
{ $see-also hash-member? hash hash* hash ?hash* } ;
HELP: remove-hash "( key hash -- )"
HELP: remove-hash
{ $values { "key" "a key" } { "hash" "a hashtable" } }
{ $description "Removes an entry from the hashtable." }
{ $side-effects "hash" }
{ $see-also clear-hash } ;
HELP: remove-hash* "( key hash -- old )"
{ $values { "value" "a value" } { "key" "a key" } { "hash" "a hashtable" } }
HELP: remove-hash*
{ $values { "key" "a key" } { "hash" "a hashtable" } { "old" "the previous value or " { $link f } } }
{ $description "Stores an entry into the hashtable." }
{ $side-effects "hash" }
{ $see-also hash remove-hash } ;
HELP: set-hash "( value key hash -- )"
HELP: set-hash
{ $values { "value" "a value" } { "key" "a key to add" } { "hash" "a hashtable" } }
{ $description "Stores the key/value pair into the hashtable." }
{ $side-effects "hash" } ;
HELP: hash-keys "( hash -- keys )"
HELP: hash-keys
{ $values { "hash" "a hashtable" } { "keys" "an array of keys" } }
{ $description "Outputs an array of all keys in the hashtable." }
{ $see-also hash-values hash>alist alist>hash } ;
HELP: hash-values "( hash -- keys )"
HELP: hash-values
{ $values { "hash" "a hashtable" } { "values" "an array of values" } }
{ $description "Outputs an array of all values in the hashtable." }
{ $see-also hash-keys hash>alist alist>hash } ;
HELP: hash>alist "( hash -- alist )"
HELP: hash>alist
{ $values { "hash" "a hashtable" } { "alist" "an array of key/value pairs" } }
{ $description "Outputs an array of all key/value pairs in the hashtable. Each pair is itself a two-element array." }
{ $see-also hash-keys hash-values alist>hash } ;
HELP: alist>hash "( alist -- hash )"
HELP: alist>hash
{ $values { "alist" "a sequence of key/value pairs" } { "hash" "a hashtable" } }
{ $description "Constructs a hashtable from a sequence of key/value pairs, where each pair is a two-element sequence. In the case of duplicate keys, later pairs take precedence." }
{ $see-also hash-keys hash-values hash>alist } ;
HELP: hash-each "( hash quot -- )"
HELP: hash-each
{ $values { "hash" "a hashtable" } { "quot" "a quotation with stack effect " { $snippet "( key value -- )" } } }
{ $description "Applies a quotation to each key/value pair in the hashtable." } ;
HELP: hash-each-with "( obj hash quot -- )"
HELP: hash-each-with
{ $values { "obj" "an object" } { "hash" "a hashtable" } { "quot" "a quotation with stack effect " { $snippet "( obj key value -- )" } } }
{ $description "Variant of " { $link hash-each } " which pushes a retained object on each invocation of the quotation." } ;
HELP: hash-all? "( hash quot -- ? )"
HELP: hash-all?
{ $values { "hash" "a hashtable" } { "quot" "a quotation with stack effect " { $snippet "( key value -- ? )" } } { "?" "a boolean" } }
{ $description "Applies a predicate quotation to each key/value pair in the hashtable. Outputs true if the hashtable is empty or the quotation yields true for each entry." } ;
HELP: hash-all-with? "( obj hash quot -- )"
HELP: hash-all-with?
{ $values { "obj" "an object" } { "hash" "a hashtable" } { "quot" "a quotation with stack effect " { $snippet "( obj key value -- ? )" } } { "?" "a boolean" } }
{ $description "Variant of " { $link hash-all? } " which pushes a retained object on each invocation of the quotation." } ;
HELP: hash-subset "( hash quot -- subhash )"
HELP: hash-subset
{ $values { "hash" "a hashtable" } { "quot" "a quotation with stack effect " { $snippet "( key value -- ? )" } } { "subhash" "a new hashtable" } }
{ $description "Constructs a hashtable consisting of all key/value pairs for which the predicate quotation yields true." } ;
HELP: hash-subset-with "( obj hash quot -- )"
HELP: hash-subset-with
{ $values { "obj" "an object" } { "hash" "a hashtable" } { "quot" "a quotation with stack effect " { $snippet "( obj key value -- ? )" } } { "subhash" "a new hashtable" } }
{ $description "Variant of " { $link hash-all? } " which pushes a retained object on each invocation of the quotation." } ;
HELP: subhash? "( hash1 hash2 -- ? )"
HELP: subhash?
{ $values { "hash1" "a hashtable" } { "hash2" "a hashtable" } { "?" "a new hashtable" } }
{ $description "Tests if " { $snippet "hash2" } " contains all key/value pairs of " { $snippet "hash1" } "." } ;
HELP: hash-stack "( key seq -- value )"
HELP: hash-stack
{ $values { "key" "a key" } { "seq" "a sequence of hashtables" } { "value" "a value or " { $link f } } }
{ $description "Looks up the key in every hashtable in the sequence, search from back to front. If the key could not be found, outputs " { $link f } ". This word is used to implement abstractions such as nested scopes; if the sequence is a stack represented by a vector, then the most recently pushed hashtable -- the innermost scope -- will be searched first." } ;
HELP: hash-intersect "( hash1 hash2 -- intersection )"
HELP: hash-intersect
{ $values { "hash1" "a hashtable" } { "hash2" "a hashtable" } { "intersection" "a new hashtable" } }
{ $description "Constructs a hashstable consisting of all key/value pairs from " { $snippet "hash2" } " such that the key is also present in " { $snippet "hash1" } "." }
{ $notes "The values of the keys in " { $snippet "hash1" } " are disregarded, so this word is usually used for set-theoretic calculations where the hashtable in question either has dummy sentinels as values, or the values equal the keys." } ;
HELP: hash-diff "( hash1 hash2 -- difference )"
HELP: hash-diff
{ $values { "hash1" "a hashtable" } { "hash2" "a hashtable" } { "difference" "a new hashtable" } }
{ $description "Constructs a hashstable consisting of all key/value pairs from " { $snippet "hash2" } " such that the key is not present in " { $snippet "hash1" } "" }
{ $notes "The values of the keys in " { $snippet "hash1" } " are disregarded, so this word is usually used for set-theoretic calculations where the hashtable in question either has dummy sentinels as values, or the values equal the keys." } ;
HELP: hash-update "( hash1 hash2 -- )"
HELP: hash-update
{ $values { "hash1" "a hashtable" } { "hash2" "a hashtable" } }
{ $description "Adds all key/value pairs from " { $snippet "hash2" } " to " { $snippet "hash1" } "." }
{ $side-effects "hash" } ;
HELP: hash-concat "( seq -- hash )"
{ $values { "seq" "a sequence of hashtables" } { "hash" "a new hashtable" } }
{ $description "Constructs a hashtable by merging every element of the sequence, with key/value pairs in subsequent hashtables taking precedence." } ;
HELP: hash-union "( hash1 hash2 -- union )"
HELP: hash-union
{ $values { "hash1" "a hashtable" } { "hash2" "a hashtable" } { "union" "a new hashtable" } }
{ $description "Constructs a hashstable consisting of all key/value pairs from " { $snippet "hash1" } " and " { $snippet "hash2" } ", with entries from " { $snippet "hash2" } " taking precedence." }
{ $notes "The values of the keys in " { $snippet "hash1" } " are disregarded, so this word is usually used for set-theoretic calculations where the hashtable in question either has dummy sentinels as values, or the values equal the keys." } ;
HELP: remove-all "( hash seq -- subseq )"
HELP: remove-all
{ $values { "hash" "a hashtable" } { "seq" "a sequence" } { "subseq" "a new sequence" } }
{ $description "Constructs a sequence consisting of all elements from the sequence that appear as keys in the hashtable." }
{ $notes "The values of the keys in the hashtable are disregarded, so this word is usually used for set-theoretic calculations where the hashtable in question either has dummy sentinels as values, or the values equal the keys." } ;
HELP: cache "( key hash quot -- value )"
HELP: cache
{ $values { "key" "a key" } { "hash" "a hashtable" } { "quot" "a quotation with stack effect " { $snippet "( key -- value )" } } { "value" "a previously-retained or freshly-computed value" } }
{ $description "If the key is present in the hashtable, outputs the associated value, otherwise calls the quotation to produce a value and stores the key/value pair into the hashtable." }
{ $side-effects "hash" } ;
HELP: map>hash "( seq quot -- hash )"
HELP: map>hash
{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( key -- value )" } } { "hash" "a hashtable" } { "value" "a previously-retained or freshly-computed value" } }
{ $description "Applies the quotation to each element of the sequence to produce a value corresponding to each key, and constructs a new hashtable from these key/value pairs." } ;

View File

@ -3,7 +3,8 @@
IN: kernel-internals
USING: vectors sequences ;
: namestack* ( -- ns ) 3 getenv { vector } declare ; inline
: namestack* ( -- namestack )
3 getenv { vector } declare ; inline
: >n ( namespace -- ) namestack* push ;
: n> ( -- namespace ) namestack* pop ;
@ -11,33 +12,33 @@ IN: namespaces
USING: arrays hashtables kernel kernel-internals math strings
words ;
: namestack ( -- ns ) namestack* clone ; inline
: set-namestack ( ns -- ) >vector 3 setenv ; inline
: namestack ( -- namestack ) namestack* clone ; inline
: set-namestack ( namestack -- ) >vector 3 setenv ; inline
: namespace ( -- namespace ) namestack* peek ;
: ndrop ( -- ) namestack* pop* ;
: global ( -- g ) 4 getenv { hashtable } declare ; inline
: get ( variable -- value ) namestack* hash-stack ;
: set ( value variable -- ) namespace set-hash ; inline
: on ( var -- ) t swap set ; inline
: off ( var -- ) f swap set ; inline
: get-global ( var -- value ) global hash ; inline
: set-global ( value var -- ) global set-hash ; inline
: on ( variable -- ) t swap set ; inline
: off ( variable -- ) f swap set ; inline
: get-global ( variable -- value ) global hash ; inline
: set-global ( value variable -- ) global set-hash ; inline
: nest ( variable -- hash )
: nest ( variable -- namespace )
dup namespace hash [ ] [ >r H{ } clone dup r> set ] ?if ;
: change ( var quot -- quot: old -- new )
: change ( variable quot -- )
>r dup get r> rot slip set ; inline
: +@ ( n var -- ) [ [ 0 ] unless* + ] change ;
: +@ ( n variable -- ) [ [ 0 ] unless* + ] change ;
: inc ( var -- ) 1 swap +@ ; inline
: inc ( variable -- ) 1 swap +@ ; inline
: dec ( var -- ) -1 swap +@ ; inline
: dec ( variable -- ) -1 swap +@ ; inline
: bind ( namespace quot -- ) swap >n call ndrop ; inline
: bind ( ns quot -- ) swap >n call ndrop ; inline
: counter ( var -- n ) global [ dup inc get ] bind ;
: counter ( variable -- n ) global [ dup inc get ] bind ;
: make-hash ( quot -- hash ) H{ } clone >n call n> ; inline
@ -46,12 +47,12 @@ words ;
! Building sequences
SYMBOL: building
: make ( quot proto -- )
: make ( quot exemplar -- seq )
[
dup thaw building set >r call building get r> like
] with-scope ; inline
: , ( obj -- ) building get push ;
: , ( elt -- ) building get push ;
: % ( seq -- ) building get swap nappend ;
@ -61,8 +62,8 @@ SYMBOL: building
IN: sequences
: concat ( seq -- seq )
: concat ( seq -- newseq )
dup empty? [ [ [ % ] each ] over first make ] unless ;
: join ( seq glue -- seq )
: join ( seq glue -- newseq )
[ swap [ % ] [ dup % ] interleave drop ] over make ;

View File

@ -1,31 +1,31 @@
IN: namespaces
USING: help kernel kernel-internals sequences words ;
HELP: get "( variable -- value )"
HELP: get
{ $values { "variable" "a variable, by convention a symbol" } { "value" "the value, or " { $link f } } }
{ $description "Searches the namestack for a namespace containing the variable, and outputs the associated value. If no such namespace is found, outputs " { $link f } "." } ;
HELP: set "( value variable -- )"
HELP: set
{ $values { "value" "the new value" } { "variable" "a variable, by convention a symbol" } }
{ $description "Assigns a value to the variable in the namespace at the top of the namestack." }
{ $side-effects "variable" } ;
HELP: off "( variable -- )"
HELP: off
{ $values { "variable" "a variable, by convention a symbol" } }
{ $description "Assigns a value of " { $link f } " to the variable." }
{ $side-effects "variable" } ;
HELP: on "( variable -- ) "
HELP: on
{ $values { "variable" "a variable, by convention a symbol" } }
{ $description "Assigns a value of " { $link t } " to the variable." }
{ $side-effects "variable" } ;
HELP: change "( variable quot -- )"
HELP: change
{ $values { "variable" "a variable, by convention a symbol" } { "quot" "a quotation with stack effect " { $snippet "( old -- new )" } } }
{ $description "Applies the quotation to the old value of the variable, and assigns the resulting value to the variable." }
{ $side-effects "variable" } ;
HELP: +@ "( n variable -- )"
HELP: +@
{ $values { "n" "a number" } { "variable" "a variable, by convention a symbol" } }
{ $description "Adds " { $snippet "n" } " to the value of the variable. A variable value of " { $link f } " is interpreted as being zero." }
{ $side-effects "variable" }
@ -33,57 +33,57 @@ HELP: +@ "( n variable -- )"
{ $example "SYMBOL: foo\n1 foo +@\n10 foo +@\nfoo get ." "11" }
} ;
HELP: inc "( variable -- )"
HELP: inc
{ $values { "variable" "a variable, by convention a symbol" } }
{ $description "Increments the value of the variable by 1. A variable value of " { $link f } " is interpreted as being zero." }
{ $side-effects "variable" } ;
HELP: dec "( variable -- )"
HELP: dec
{ $values { "variable" "a variable, by convention a symbol" } }
{ $description "Decrements the value of the variable by 1. A variable value of " { $link f } " is interpreted as being zero." }
{ $side-effects "variable" } ;
HELP: counter "( variable -- n )"
HELP: counter
{ $values { "variable" "a variable, by convention a symbol" } }
{ $description "Increments the value of the variable by 1, and returns its new value." }
{ $notes "This word is useful for generating (somewhat) unique identifiers. For example, the " { $link gensym } " word uses it." }
{ $side-effects "variable" } ;
HELP: with-scope "( quot -- )"
HELP: with-scope
{ $values { "quot" "a quotation" } }
{ $description "Calls the quotation in a new namespace. Any variables set by the quotation are discarded when it returns." } ;
HELP: make-hash "( quot -- hash )"
HELP: make-hash
{ $values { "quot" "a quotation" } { "hash" "a new hashtable" } }
{ $description "Calls the quotation in a new namespace, and outputs this namespace when the quotation returns. Useful for quickly building hashtables." } ;
HELP: bind "( ns quot -- )"
HELP: bind
{ $values { "ns" "a hashtable" } { "quot" "a quotation" } }
{ $description "Calls the quotation in the dynamic scope of " { $snippet "ns" } ". When variables are looked up by the quotation, " { $snippet "ns" } " is checked first, and setting variables in the quotation stores them in " { $snippet "ns" } "." } ;
HELP: namespace "( -- ns )"
HELP: namespace
{ $values { "ns" "a hashtable" } }
{ $description "Outputs the current namespace. Calls to " { $link set } " modify this namespace." } ;
HELP: global "( -- ns )"
HELP: global
{ $values { "ns" "a hashtable" } }
{ $description "Outputs the global namespace. The global namespace is always checked last when looking up variable values." } ;
HELP: set-global "( value variable -- )"
HELP: set-global
{ $values { "value" "the new value" } { "variable" "a variable, by convention a symbol" } }
{ $description "Assigns a value to the variable in the global namespace." }
{ $side-effects "variable" } ;
HELP: nest "( variable -- namespace )"
HELP: nest
{ $values { "variable" "a variable, by convention a symbol" } { "namespace" "a hashtable" } }
{ $description "If the variable is not set in the current namespace, sets it to a new hashtable, and outputs this hashtable. Otherwise, outputs the existing value (which should probably be a hashtable)." }
{ $side-effects "variable" } ;
HELP: namestack* "( -- namestack )"
HELP: namestack*
{ $values { "namestack" "a vector" } }
{ $description "Outputs the current namestack." } ;
HELP: namestack "( -- namestack )"
HELP: namestack
{ $values { "namestack" "a vector" } }
{ $description "Outputs a copy of the current namestack." } ;
@ -91,45 +91,45 @@ HELP: set-namestack "( namestack -- )"
{ $values { "namestack" "a vector" } }
{ $description "Replaces the namestack with a copy of the given vector." } ;
HELP: >n "( ns -- )"
{ $values { "ns" "a hashtable" } }
HELP: >n
{ $values { "namespace" "a hashtable" } }
{ $description "Pushes a namespace on the namestack." } ;
HELP: n> "( -- ns )"
{ $values { "ns" "a hashtable" } }
HELP: n>
{ $values { "namespace" "a hashtable" } }
{ $description "Pops a namespace from the namestack." } ;
HELP: make "( quot exemplar -- seq )"
HELP: make
{ $values { "quot" "a quotation" } { "exemplar" "a sequence" } }
{ $description "Calls the quotation in a new " { $emphasis "dynamic scope" } ". The quotation and any words it calls can execute the " { $link , } " and " { $link % } " words to accumulate elements. When the quotation returns, all accumulated elements are collected into a sequence with the same type as " { $snippet "exemplar" } "." }
{ $examples { $example "[ 1 , 2 , 3 , ] { } make ." "{ 1 2 3 }" } } ;
HELP: , "( elt -- )"
HELP: ,
{ $values { "elt" "an object" } }
{ $description "Adds an element to the end of the sequence being constructed by " { $link make } "." } ;
HELP: % "( seq -- )"
HELP: %
{ $values { "seq" "a sequence" } }
{ $description "Appends a sequence to the end of the sequence being constructed by " { $link make } "." } ;
HELP: # "( n -- )"
HELP: #
{ $values { "n" "a real number" } }
{ $description "Appends the string representation of a real number to the end of the sequence being constructed by " { $link make } "." } ;
HELP: init-namespaces "( -- )"
HELP: init-namespaces
{ $description "Resets the name stack to its initial state, holding a single copy of the global namespace. This word is called during startup and is rarely useful, except in certain situations such as the example below." }
{ $examples
"You can use this word to spawn a new thread which does not inherit the parent thread's name stack:"
{ $code "[ init-namestack do-some-work ] in-thread" }
} ;
HELP: concat "( seq -- newseq )"
HELP: concat
{ $values { "seq" "a sequence" } { "newseq" "a sequence" } }
{ $description "Concatenates a sequence of sequences together into one sequence. The resulting sequence is of the same class as the first element of " { $snippet "seq" } "." }
{ $errors "Throws an error if one of the sequences in " { $snippet "seq" } " contains elements not permitted in sequences of the same class as the first element of " { $snippet "seq" } "." }
{ $see-also join } ;
HELP: join "( seq glue -- newseq )"
HELP: join
{ $values { "seq" "a sequence" } { "glue" "a sequence" } { "newseq" "a sequence" } }
{ $description "Concatenates a sequence of sequences together into one sequence, placing a copy of " { $snippet "glue" } " between each pair of sequences. The resulting sequence is of the same class as " { $snippet "glue" } "." }
{ $errors "Throws an error if one of the sequences in " { $snippet "seq" } " contains elements not permitted in sequences of the same class as " { $snippet "glue" } "." }

View File

@ -19,7 +19,7 @@ C: queue ( -- queue ) ;
: (enque) ( entry queue -- )
[ set-queue-head ] 2keep set-queue-tail ;
: enque ( obj queue -- )
: enque ( elt queue -- )
>r <entry> r> dup queue-empty? [
(enque)
] [
@ -36,7 +36,7 @@ C: queue ( -- queue ) ;
TUPLE: empty-queue ;
: empty-queue ( -- * ) <empty-queue> throw ;
: deque ( queue -- obj )
: deque ( queue -- elt )
dup queue-empty? [
empty-queue
] [

View File

@ -1,26 +1,26 @@
IN: queues
USING: help ;
HELP: queue f
HELP: queue
{ $class-description "A simple first-in-first-out queue. See " { $link "queues" } "." } ;
HELP: <queue> "( -- queue )"
HELP: <queue>
{ $values { "queue" "a new queue" } }
{ $description "Makes a new queue with no elements." } ;
HELP: queue-empty? "( queue -- ? )"
HELP: queue-empty?
{ $values { "queue" "a queue" } { "?" "a boolean" } }
{ $description "Tests if a queue contains no elements." } ;
HELP: deque "( queue -- elt )"
HELP: deque
{ $values { "queue" "a queue" } { "elt" "an object" } }
{ $description "Removes an element from the front of the queue." }
{ $errors "Throws an " { $link empty-queue } " error if the queue has no entries." } ;
HELP: enque "( elt queue -- )"
HELP: enque
{ $values { "elt" "an object" } { "queue" "a queue" } }
{ $description "Adds an element to the back of the queue." } ;
HELP: empty-queue "( -- )"
HELP: empty-queue
{ $description "Throws an " { $link empty-queue } " error." }
{ $error-description "Thrown by " { $link deque } " if the queue has no entries." } ;

View File

@ -1,15 +1,15 @@
IN: strings
USING: arrays help kernel vectors ;
HELP: sbuf f
HELP: sbuf
{ $description "The class of resizable character strings. See " { $link "syntax-sbufs" } " for syntax and " { $link "sbufs" } " for general information." } ;
HELP: <sbuf> "( n -- sbuf )"
HELP: <sbuf> ( n -- sbuf )
{ $values { "n" "a positive integer specifying initial capacity" } { "sbuf" "a new string buffer" } }
{ $description "Creates a new string buffer that can hold " { $snippet "n" } " characters before resizing." }
{ $see-also <array> <quotation> <string> <vector> } ;
HELP: >sbuf "( seq -- sbuf )"
HELP: >sbuf
{ $values { "seq" "a sequence of non-negative integers" } { "sbuf" "a string buffer" } }
{ $description "Outputs a freshly-allocated string buffer with the same elements as a given sequence." }
{ $errors "Throws an error if the sequence contains elements other than real numbers." } ;

View File

@ -40,17 +40,17 @@ IN: sequences
: each-with ( obj seq quot -- )
swap [ with ] each 2drop ; inline
: reduce ( seq identity quot -- value )
: reduce ( seq identity quot -- result )
swapd each ; inline
: map ( seq quot -- seq )
: map ( seq quot -- newseq )
over >r over length [ (map) ] collect r> like 2nip ;
inline
: map-with ( obj list quot -- list )
: map-with ( obj list quot -- newseq )
swap [ with rot ] map 2nip ; inline
: accumulate ( seq identity quot -- values )
: accumulate ( seq identity quot -- newseq )
rot [ pick >r swap call r> ] map-with nip ; inline
: change-nth ( i seq quot -- )
@ -64,19 +64,19 @@ IN: sequences
: inject-with ( obj seq quot -- )
swap [ with rot ] inject 2drop ; inline
: min-length ( seq seq -- n )
: min-length ( seq1 seq2 -- n )
[ length ] 2apply min ;
: max-length ( seq seq -- n )
: max-length ( seq1 seq2 -- n )
[ length ] 2apply max ;
: 2each ( seq seq quot -- )
: 2each ( seq1 seq2 quot -- )
-rot 2dup min-length [ (2each) ] repeat 3drop ; inline
: 2reduce ( seq seq identity quot -- value )
: 2reduce ( seq seq identity quot -- result )
>r -rot r> 2each ; inline
: 2map ( seq seq quot -- seq )
: 2map ( seq1 seq2 quot -- newseq )
-rot
[ 2dup min-length [ (2map) ] collect ] keep like
>r 3drop r> ; inline
@ -84,7 +84,7 @@ IN: sequences
: if-bounds ( i seq quot -- )
>r pick pick bounds-check? r> [ 3drop -1 f ] if ; inline
: find* ( i seq quot -- i elt )
: find* ( n seq quot -- i elt )
[
3dup >r >r >r >r nth-unsafe r> call [
r> dup r> nth-unsafe r> drop
@ -93,7 +93,7 @@ IN: sequences
] if
] if-bounds ; inline
: find-with* ( obj i seq quot -- i elt )
: find-with* ( obj n seq quot -- i elt )
-rot [ with rot ] find* 2swap 2drop ; inline
: find ( seq quot -- i elt )
@ -102,7 +102,7 @@ IN: sequences
: find-with ( obj seq quot -- i elt )
swap [ with rot ] find 2swap 2drop ; inline
: find-last* ( i seq quot -- i elt )
: find-last* ( n seq quot -- i elt )
[
3dup >r >r >r >r nth-unsafe r> call [
r> dup r> nth-unsafe r> drop
@ -111,7 +111,7 @@ IN: sequences
] if
] if-bounds ; inline
: find-last-with* ( obj i seq quot -- i elt )
: find-last-with* ( obj n seq quot -- i elt )
-rot [ with rot ] find-last* 2swap 2drop ; inline
: find-last ( seq quot -- i elt )
@ -132,14 +132,14 @@ IN: sequences
: all-with? ( obj seq quot -- ? )
swap [ with rot ] all? 2nip ; inline
: subset ( seq quot -- seq )
: subset ( seq quot -- subseq )
over >r over length <vector> rot [
-rot [
>r over >r call [ r> r> push ] [ r> r> 2drop ] if
] 2keep
] each r> like nip ; inline
: subset-with ( obj seq quot -- seq )
: subset-with ( obj seq quot -- subseq )
swap [ with rot ] subset 2nip ; inline
: monotonic? ( seq quot -- ? )
@ -161,11 +161,11 @@ IN: sequences
drop swap >r over >r call dup r> r> set-nth
] if ; inline
: copy-into-check ( start to from -- start to from )
: copy-into-check ( n dest src -- n dest src )
pick over length + pick 2dup length >
[ set-length ] [ 2drop ] if ; inline
: copy-into ( start to from -- )
: copy-into ( n dest src -- )
copy-into-check dup length
[ >r pick r> + pick set-nth-unsafe ] 2each 2drop ;
inline

View File

@ -1,57 +1,61 @@
IN: sequences
USING: arrays help math sequences-internals ;
HELP: collect "( n quot -- array )"
HELP: collect
{ $values { "n" "a non-negative integer" } { "quot" "a quotation with stack effect " { $snippet "( n -- value )" } } { "array" "an array with " { $snippet "n" } " elements" } }
{ $description "A primitive mapping operation that applies a quotation to all integers from 0 up to but not including " { $snippet "n" } ", and collects the results in a new array. User code should use " { $link map } " instead." } ;
HELP: each "( seq quot -- )"
HELP: each
{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- )" } } }
{ $description "Applies the quotation to each element of the sequence in turn." } ;
HELP: each-with "( obj seq quot -- )"
HELP: each-with
{ $values { "obj" "an object" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj elt -- )" } } }
{ $description "Variant of " { $link each } " which pushes a retained object on each invocation of the quotation." } ;
HELP: reduce "( seq identity quot -- result )"
{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( prev elt -- next )" } } }
HELP: reduce
{ $values { "seq" "a sequence" } { "identity" "an object" } { "quot" "a quotation with stack effect " { $snippet "( prev elt -- next )" } } { "result" "the final result" } }
{ $description "Combines successive elements of the sequence using a binary operation, and outputs the final result. On the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the sequence." }
{ $examples
{ $example "{ 1 5 3 } 0 [ + ] reduce ." "9" }
} ;
HELP: accumulate "( seq identity quot -- newseq )"
HELP: accumulate
{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( prev elt -- next )" } } }
{ $description "Combines successive elements of the sequence using a binary operation, and outputs a sequence of intermediate results. On the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the sequence." }
{ $examples
{ $example "{ 2 2 2 2 2 } 0 [ + ] accumulate ." "{ 0 2 4 6 8 }" }
} ;
HELP: map "( seq quot -- newseq )"
HELP: map
{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( old -- new )" } } { "newseq" "a new sequence" } }
{ $description "Applies the quotation to each element yielding a new element. The new elements are collected into a sequence of the same class as the input sequence." } ;
HELP: map-with "( obj seq quot -- newseq )"
{ $values { "obj" "an object" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj elt -- new )" } } }
HELP: map-with
{ $values { "obj" "an object" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj elt -- new )" } } { "newseq" "a new sequence" } }
{ $description "Variant of " { $link map } " which pushes a retained object on each invocation of the quotation." } ;
HELP: change-nth "( i seq quot -- )"
HELP: change-nth
{ $values { "i" "a non-negative integer" } { "seq" "a mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- newelt )" } } }
{ $description "Applies the quotation to the " { $snippet "i" } "th element of the sequence, storing the result back into the sequence." }
{ $errors "Throws an error if the sequence is immutable, if the index is out of bounds, or the sequence cannot hold elements of the type output by " { $snippet "quot" } "." }
{ $side-effects "seq" } ;
HELP: inject "( seq quot -- )"
HELP: inject
{ $values { "seq" "a mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( old -- new )" } } }
{ $description "Applies the quotation to each element yielding a new element, storing the new elements back in the original sequence." }
{ $errors "Throws an error if the sequence is immutable, or the sequence cannot hold elements of the type output by " { $snippet "quot" } "." }
{ $side-effects "seq" } ;
HELP: min-length "( seq1 seq2 -- n )"
HELP: inject-with
{ $values { "obj" "an object" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj elt -- new )" } } }
{ $description "Variant of " { $link inject } " which pushes a retained object on each invocation of the quotation." } ;
HELP: min-length
{ $values { "seq1" "a sequence" } { "seq2" "a sequence" } { "n" "a non-negative integer" } }
{ $description "Outputs the minimum of the lengths of the two sequences." } ;
HELP: max-length "( seq1 seq2 -- n )"
HELP: max-length
{ $values { "seq1" "a sequence" } { "seq2" "a sequence" } { "n" "a non-negative integer" } }
{ $description "Outputs the maximum of the lengths of the two sequences." } ;
@ -60,59 +64,59 @@ HELP: 2each "( seq1 seq2 quot -- )"
{ $description "Applies the quotation to pairs of elements from " { $snippet "seq1" } " and " { $snippet "seq2" } "." }
{ $notes "If one sequence is shorter than the other, than only the prefix having the length of the minimum of the two is examined." } ;
HELP: 2reduce "( seq1 seq2 quot -- )"
{ $values { "seq1" "a sequence" } { "seq2" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( prev elt1 elt2 -- next )" } } }
HELP: 2reduce
{ $values { "seq1" "a sequence" } { "seq2" "a sequence" } { "identity" "an object" } { "quot" "a quotation with stack effect " { $snippet "( prev elt1 elt2 -- next )" } } { "result" "the final result" } }
{ $description "Combines successive pairs of elements from the two sequences using a ternary operation. The first input value at each iteration except the first one is the result of the previous iteration. The first input value at the first iteration is " { $snippet "identity" } "." }
{ $examples "The " { $link v. } " word provides a particularly elegant implementation of the dot product." }
{ $notes "If one sequence is shorter than the other, than only the prefix having the length of the minimum of the two is examined." } ;
HELP: 2map "( seq1 seq2 quot -- seq )"
{ $values { "seq1" "a sequence" } { "seq2" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt1 elt2 -- new )" } } }
HELP: 2map
{ $values { "seq1" "a sequence" } { "seq2" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt1 elt2 -- new )" } } { "newseq" "a new sequence" } }
{ $description "Applies the quotation to each pair of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "seq1" } "." }
{ $see-also v+ v- v* v/ }
{ $notes "If one sequence is shorter than the other, than only the prefix having the length of the minimum of the two is examined." } ;
HELP: find "( seq quot -- i elt )"
HELP: find
{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "i" "the index of the first match, or -1" } { "elt" "the first matching element, or " { $link f } } }
{ $description "A simpler variant of " { $link find* } " where the starting index is 0." } ;
HELP: find-with "( obj seq quot -- i elt )"
HELP: find-with
{ $values { "obj" "an object" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj elt -- ? )" } } { "i" "the index of the first match, or -1" } { "elt" "the first matching element, or " { $link f } } }
{ $description "Variant of " { $link find } " which pushes a retained object on each invocation of the quotation." } ;
HELP: find* "( n seq quot -- i elt )"
HELP: find*
{ $values { "n" "a starting index" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } }
{ $description "Applies the quotation to each element of the sequence in turn, until it outputs a true value or the end of the sequence is reached. If the quotation yields a true value for some sequence element, the word outputs the element index and the element itself. Otherwise, the word outputs an index of -1 and " { $link f } " as the element." } ;
HELP: find-with* "( obj n seq quot -- i elt )"
HELP: find-with*
{ $values { "obj" "an object" } { "n" "a starting index" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj elt -- ? )" } } { "i" "the index of the first match, or -1" } { "elt" "the first matching element, or " { $link f } } }
{ $description "Variant of " { $link find* } " which pushes a retained object on each invocation of the quotation." } ;
HELP: find-last "( seq quot -- i elt )"
HELP: find-last
{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "i" "the index of the first match, or -1" } { "elt" "the first matching element, or " { $link f } } }
{ $description "A simpler variant of " { $link find-last* } " where the starting index is one less than the length of the sequence." } ;
HELP: find-last-with "( obj seq quot -- i elt )"
HELP: find-last-with
{ $values { "obj" "an object" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj elt -- ? )" } } { "i" "the index of the first match, or -1" } { "elt" "the first matching element, or " { $link f } } }
{ $description "Variant of " { $link find } " which pushes a retained object on each invocation of the quotation." } ;
HELP: find-last* "( n seq quot -- i elt )"
HELP: find-last*
{ $values { "n" "a starting index" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "i" "the index of the first match, or -1" } { "elt" "the first matching element, or " { $link f } } }
{ $description "Applies the quotation to each element of the sequence in reverse order, until it outputs a true value or the start of the sequence is reached. If the quotation yields a true value for some sequence element, the word outputs the element index and the element itself. Otherwise, the word outputs an index of -1 and " { $link f } " as the element." } ;
HELP: find-last-with* "( obj n seq quot -- i elt )"
HELP: find-last-with*
{ $values { "obj" "an object" } { "n" "a starting index" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj elt -- ? )" } } { "i" "the index of the first match, or -1" } { "elt" "the first matching element, or " { $link f } } }
{ $description "Variant of " { $link find } " which pushes a retained object on each invocation of the quotation." } ;
HELP: contains? "( seq quot -- ? )"
HELP: contains?
{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "?" "a boolean" } }
{ $description "Tests if the sequence contains an element satisfying the predicate, by applying the predicate to each element in turn until a true value is found. If the sequence is empty or if the end of the sequence is reached, outputs " { $link f } "." } ;
HELP: contains-with? "( obj seq quot -- ? )"
HELP: contains-with?
{ $values { "obj" "an object" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj elt -- ? )" } } { "?" "a boolean" } }
{ $description "Variant of " { $link contains? } " which pushes a retained object on each invocation of the quotation." } ;
HELP: all? "( seq quot -- ? )"
HELP: all?
{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "?" "a boolean" } }
{ $description "Tests if all elements in the sequence satisfy the predicate by checking each element in turn. Given an empty sequence, vacuously outputs " { $link t } "." }
{ $notes
@ -121,19 +125,19 @@ HELP: all? "( seq quot -- ? )"
{ $snippet "P[x] for all x <==> not ((not P[x]) for some x)" }
} ;
HELP: all-with? "( obj seq quot -- ? )"
HELP: all-with?
{ $values { "obj" "an object" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj elt -- ? )" } } { "?" "a boolean" } }
{ $description "Variant of " { $link all? } " which pushes a retained object on each invocation of the quotation." } ;
HELP: subset "( seq quot -- subseq )"
HELP: subset
{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "subseq" "a new sequence" } }
{ $description "Applies the quotation to each element in turn, and outputs a new sequence containing the elements of the original sequence for which the quotation output a true value." } ;
HELP: subset-with "( obj seq quot -- subseq )"
HELP: subset-with
{ $values { "obj" "an object" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj elt -- ? )" } } { "subseq" "a new sequence" } }
{ $description "Variant of " { $link subset } " which pushes a retained object on each invocation of the quotation." } ;
HELP: monotonic? "( seq quot -- ? )"
HELP: monotonic?
{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt elt -- ? )" } } { "?" "a boolean" } }
{ $description "Applies the relation to successive pairs of elements in the sequence, testing for a truth value. The relation should be a transitive relation, such as a total order or an equality relation." }
{ $examples
@ -144,22 +148,22 @@ HELP: monotonic? "( seq quot -- ? )"
}
{ $see-also all-eq? all-equal? } ;
HELP: interleave "( seq quot between -- )"
HELP: interleave
{ $values { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- )" } } { "between" "a quotation" } }
{ $description "Applies " { $snippet "quot" } " to each element in turn, also invoking " { $snippet "between" } " in-between each pair of elements." }
{ $example "{ \"a\" \"b\" \"c\" } [ write ] [ \"X\" write ] interleave" "aXbXc" } ;
HELP: cache-nth "( i seq quot -- elt )"
HELP: cache-nth
{ $values { "i" "a non-negative integer" } { "seq" "a mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( i -- elt )" } } }
{ $description "If the sequence does not contain at least " { $snippet "i" } " elements or if the " { $snippet "i" } "th element of the sequence is " { $link f } ", calls the quotation to produce a new value, and stores it back into the sequence. Otherwise, this word outputs the " { $snippet "i" } "th element of the sequence." }
{ $side-effects "seq" } ;
HELP: copy-into "( n dest src -- )"
HELP: copy-into
{ $values { "n" "an index in " { $snippet "dest" } } { "dest" "a mutable sequence" } { "src" "a sequence" } }
{ $description "Copies all elements of " { $snippet "src" } " to " { $snippet "dest" } ", with destination indices starting from " { $snippet "n" } ". Grows " { $snippet "to" } " first if necessary." }
{ $errors "An error is thrown if " { $snippet "to" } " is not resizable, and not large enough to hold the copied elements." } ;
HELP: >sequence "( seq pred quot -- )"
{ $values { "seq" "a sequence" } { "pred" "a quotation with stack effect " { $snippet "( seq -- ? )" } } { "quot" "a quotation with stack effect " { $snippet "( n -- newseq )" } } { "newseq" "a freshly-allocated sequence" } }
HELP: >sequence
{ $values { "seq" "a sequence" } { "pred" "a quotation with stack effect " { $snippet "( seq -- ? )" } } { "quot" "a quotation with stack effect " { $snippet "( n -- newseq )" } } { "newseq" "a new sequence" } }
{ $description "If " { $snippet "pred" } " answers a true value given " { $snippet "seq" } ", clones " { $snippet "seq" } ". Otherwise, calls " { $snippet "quot" } " with the length of " { $snippet "seq" } ", creating a new sequence, and copies the contents of " { $snippet "seq" } " into the new sequence." }
{ $notes "This word is used to implement words which convert one type of sequence into another, for example " { $link >array } "." } ;

View File

@ -24,7 +24,8 @@ words ;
dup [ f "no-effect" set-word-prop ] each
[ try-compile ] each ;
: compile-all ( -- ) vocabs compile-vocabs ;
: compile-all ( -- )
[ vocabs compile-vocabs ] with-class<cache ;
: compile-quot ( quot -- word )
define-temp "compile" get [ dup compile ] when ;

View File

@ -3,15 +3,16 @@
IN: kernel-internals
USING: vectors ;
: catchstack* ( -- cs ) 6 getenv { vector } declare ; inline
: catchstack* ( -- catchstack )
6 getenv { vector } declare ; inline
: (continue-with) 9 getenv ;
IN: errors
USING: kernel kernel-internals ;
: catchstack ( -- cs ) catchstack* clone ; inline
: set-catchstack ( cs -- ) >vector 6 setenv ; inline
: catchstack ( -- catchstack ) catchstack* clone ; inline
: set-catchstack ( catchstack -- ) >vector 6 setenv ; inline
IN: kernel
USING: namespaces sequences ;
@ -22,7 +23,7 @@ TUPLE: continuation data retain call name catch ;
V{ } clone V{ } clone V{ } clone V{ } clone V{ } clone
<continuation> ;
: continuation ( -- interp )
: continuation ( -- continuation )
datastack retainstack callstack namestack catchstack
<continuation> ; inline
@ -36,7 +37,7 @@ TUPLE: continuation data retain call name catch ;
: ifcc ( terminator balance -- )
[ f f continuation 2nip dup ] call 2swap if ; inline
: callcc0 [ drop ] ifcc ; inline
: callcc0 ( quot -- ) [ drop ] ifcc ; inline
: continue ( continuation -- )
>continuation<
@ -47,6 +48,8 @@ TUPLE: continuation data retain call name catch ;
set-datastack ;
inline
: callcc1 [ drop (continue-with) ] ifcc ; inline
: callcc1 ( quot -- obj )
[ drop (continue-with) ] ifcc ; inline
: continue-with swap 9 setenv continue ; inline
: continue-with ( obj continuation -- )
swap 9 setenv continue ; inline

View File

@ -1,44 +1,44 @@
USING: errors help kernel kernel-internals ;
HELP: catchstack* "( -- catchstack )"
HELP: catchstack*
{ $values { "catchstack" "a vector" } }
{ $description "Outputs the current catchstack." } ;
HELP: catchstack "( -- catchstack )"
HELP: catchstack
{ $values { "catchstack" "a vector" } }
{ $description "Outputs a copy of the current catchstack." } ;
HELP: set-catchstack "( catchstack -- )"
HELP: set-catchstack
{ $values { "catchstack" "a vector" } }
{ $description "Replaces the catchstack with a copy of the given vector." } ;
HELP: continuation "( -- continuation )"
HELP: continuation
{ $values { "continuation" "a continuation" } }
{ $description "Reifies the current continuation from the point immediately after which the caller returns." } ;
HELP: >continuation< "( continuation -- data call name catch )"
{ $values { "continuation" "a continuation" } { "data" "a vector" } { "call" "a vector" } { "name" "a vector" } { "catch" "a vector" } }
HELP: >continuation<
{ $values { "continuation" "a continuation" } { "data" "a vector" } { "retain" "a vector" } { "call" "a vector" } { "name" "a vector" } { "catch" "a vector" } }
{ $description "Takes a continuation apart into its four constituents." } ;
HELP: ifcc "( terminator balance -- )"
HELP: ifcc
{ $values { "terminator" "a quotation with stack effect " { $snippet "( continuation -- )" } } { "balance" "a quotation" } }
{ $description "Reifies a continuation from the point immediately after which the caller returns, and passes it to " { $snippet "terminator" } ". When the continuation is restored, execution resumes; " { $snippet "terminator" } " is still on the stack and "{ $snippet "balance" } " is called." }
{ $see-also callcc0 callcc1 } ;
HELP: callcc0 "( quot -- )"
HELP: callcc0
{ $values { "quot" "a quotation with stack effect " { $snippet "( continuation -- )" } } }
{ $description "Applies the quotation to the current continuation, which is reified from the point immediately after which the caller returns. The " { $link continue } " word resumes the continuation." }
{ $see-also ifcc callcc1 continue } ;
HELP: callcc1 "( quot -- obj )"
HELP: callcc1
{ $values { "quot" "a quotation with stack effect " { $snippet "( continuation -- )" } } { "obj" "an object provided when resuming the continuation" } }
{ $description "Applies the quotation to the current continuation, which is reified from the point immediately after which the caller returns. The " { $link continue-with } " word resumes the continuation, passing a value back to the original execution context." }
{ $see-also ifcc callcc0 continue-with } ;
HELP: continue "( continuation -- )"
HELP: continue
{ $values { "continuation" "a continuation" } }
{ $description "Resumes a continuation reified by " { $link callcc0 } "." } ;
HELP: continue-with "( obj continuation -- )"
HELP: continue-with
{ $values { "obj" "an object to pass to the continuation's execution context" } { "continuation" "a continuation" } }
{ $description "Resumes a continuation reified by " { $link callcc1 } ". The object remains on the stack when the continuation resumes executing." } ;

View File

@ -1,19 +1,19 @@
IN: definitions
USING: help words ;
HELP: see "( defspec -- )"
HELP: see
{ $values { "defspec" "a definition specifier" } }
{ $description "Prettyprints a definition." } ;
HELP: where "( defspec -- loc )"
HELP: where
{ $values { "defspec" "a definition specifier" } { "loc" "an array holding a file name string and line number indexed from 1" } }
{ $description "Outputs the location of a definition. If the location is not known, will output " { $snippet "{ f f }" } " or " { $link f } "." } ;
HELP: forget "( defspec -- )"
HELP: forget
{ $values { "defspec" "a definition specifier" } }
{ $description "Forgets about a definition. For example, if it is a word, it will be removed from its vocabulary." } ;
HELP: synopsis "( defspec -- str )"
HELP: synopsis
{ $values { "defspec" "a definition specifier" } { "str" "a string" } }
{ $contract "Outputs a short string describing the definition in Factor pseudo-code." }
{ $examples { $example "\\ append synopsis print" "IN: sequences : append ( seq1 seq2 -- seq )" } } ;

View File

@ -42,7 +42,7 @@ C: effect
")" %
] "" make ;
: stack-effect ( word -- string )
: stack-effect ( word -- effect/f )
dup "declared-effect" word-prop [
effect>string
] [

23
library/effects.facts Normal file
View File

@ -0,0 +1,23 @@
IN: words
HELP: effect
{ $class-description "An object representing a stack effect. Holds a sequence of inputs, a sequence of outputs and a flag indicating if an error is thrown unconditionally." } ;
HELP: effect-height
{ $values { "effect" "a stack effect" } { "n" "an integer" } }
{ $description "Outputs the number of items added to the data stack by the stack effect. This will be negative if the stack effect only removes objects from the stack." } ;
HELP: effect<=
{ $values { "eff1" "a stack effect" } { "eff2" "a stack effect" } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "eff1" } " can be used anywhere " { $snippet "eff2" } " can. What this means is that both stack effects change the stack height by the same amount, the first takes a smaller or equal number of inputs as the second, and either both or neither one terminate execution by throwing an error." } ;
HELP: effect>string
{ $values { "effect" "a stack effect" } { "string" "a string" } }
{ $description "Turns a stack effect object into a string mnemonic." }
{ $examples
{ $example "1 2 <effect> effect>string print" "( object object -- object )" }
} ;
HELP: stack-effect
{ $values { "word" "a word" } { "effect/f" "a stack effect" } }
{ $description "Outputs the stack effect of a word; either a stack effect declared with " { $link POSTPONE: ( } ", or a stack effect inferred with " { $link infer } "." } ;

View File

@ -12,7 +12,7 @@ USING: kernel ;
SYMBOL: error
SYMBOL: error-continuation
: catch ( try -- error )
: catch ( try -- error/f )
[ >c call f c> drop f ] callcc1 nip ; inline
: rethrow ( error -- )

View File

@ -1,43 +1,44 @@
IN: errors
USING: errors help kernel kernel-internals ;
HELP: error f
HELP: error
{ $description "Global variable holding most recently thrown error." }
{ $notes "Only updated by " { $link throw } ", not " { $link rethrow } "." } ;
HELP: error-continuation f
HELP: error-continuation
{ $description "Global variable holding current continuation of most recently thrown error." }
{ $notes "Only updated by " { $link throw } ", not " { $link rethrow } "." } ;
HELP: >c "( continuation -- )"
HELP: >c
{ $values { "continuation" "a continuation" } }
{ $description "Pushes an exception handler continuation on the catch stack. The continuation must have been reified by " { $link callcc1 } "." } ;
HELP: c> "( -- continuation )"
HELP: c>
{ $values { "continuation" "a continuation" } }
{ $description "Pops an exception handler continuation from the catch stack." } ;
HELP: throw "( error -- )"
HELP: throw ( error -- * )
{ $values { "error" "an object" } }
{ $description "Saves the current continuation in the " { $link error-continuation } " global variable and throws an error. Execution does not continue at the point after the " { $link throw } " call. Rather, the innermost catch block is invoked, and execution continues at that point." }
{ $see-also rethrow } ;
HELP: catch "( try -- error/f )"
HELP: catch
{ $values { "try" "a quotation" } { "error/f" "an object" } }
{ $description "Calls the " { $snippet "try" } " quotation. If an error is thrown in the dynamic extent of the quotation, restores the datastack and pushes the error. If the quotation returns successfully, outputs " { $link f } " without restoring the datastack." }
{ $notes "This word cannot differentiate between the case of " { $link f } " being thrown, and no error being thrown. You should never throw " { $link f } ", and you should also use other error handling combinators where possible." }
{ $see-also cleanup recover } ;
HELP: cleanup "( try cleanup -- )"
HELP: cleanup
{ $values { "try" "a quotation" } { "cleanup" "a quotation" } }
{ $description "Calls the " { $snippet "try" } " quotation. If an exception is thrown in the dynamic extent of the " { $snippet "try" } " quotation, restores the datastack, calls the " { $snippet "cleanup" } " quotation, and rethrows the error. If the " { $snippet "try" } " quotation returns successfully, calls the " { $snippet "cleanup" } " quotation without restoring the datastack." }
{ $see-also catch recover } ;
HELP: recover "( try recovery -- )"
HELP: recover
{ $values { "try" "a quotation" } { "recovery" "a quotation with stack effect " { $snippet "( error -- )" } } }
{ $description "Calls the " { $snippet "try" } " quotation. If an exception is thrown in the dynamic extent of the " { $snippet "try" } " quotation, restores the datastack and calls the " { $snippet "recovery" } " quotation to handle the error." }
{ $see-also catch cleanup } ;
HELP: rethrow "( error -- )"
HELP: rethrow
{ $values { "error" "an object" } }
{ $description "Throws an error without saving the current continuation in the " { $link error-continuation } " global variable. This is done so that inspecting the error stacks sheds light on the original cause of the exception, rather than the point where it was rethrown." }
{ $examples
@ -48,11 +49,7 @@ HELP: rethrow "( error -- )"
}
} ;
HELP: error. "( error -- )"
{ $values { "error" "an object" } }
{ $contract "Prints an error in human-readable form." } ;
HELP: condition "( error restarts -- restart )"
HELP: condition
{ $values { "error" "an object" } { "restarts" "a sequence of pairs" } { "restart" "an object" } }
{ $description "Throws a restartable error. The " { $snippet "restarts" } " parameter is a sequence of pairs where the first element in each pair is a human-readable description and the second is an arbitrary object. If the error reaches the top-level error handler, the user will be presented with the list of possible restarts, and upon invoking one with the " { $link :res } " word, execution will continue after the call to " { $link condition } " with the object associated to the chosen restart on the stack." }
{ $examples
@ -65,7 +62,7 @@ HELP: condition "( error restarts -- restart )"
}
} ;
HELP: compute-restarts "( error -- seq )"
HELP: compute-restarts
{ $values { "error" "an object" } { "seq" "a sequence" } }
{ $description "Outputs a sequence of triples, where each triple consists of a human-readable string, an object, and a continuation. Resuming a continuation with the corresponding object restarts execution immediately after the corresponding call to " { $link condition } "."
$terpri

View File

@ -4,12 +4,9 @@ IN: !syntax
USING: arrays help kernel parser sequences syntax words ;
: !HELP:
scan-word bootstrap-word
dup dup location "help-loc" set-word-prop
[
>array unclip swap >r "stack-effect" set-word-prop r>
set-word-help
] f ; parsing
scan-word bootstrap-word dup set-word
dup location "help-loc" set-word-prop
[ >array set-word-help ] f ; parsing
: !ARTICLE:
[

View File

@ -5,7 +5,7 @@ USING: generic kernel-internals math math-internals ;
: 2swap ( x y z t -- z t x y ) rot >r rot r> ; inline
: clear V{ } set-datastack ;
: clear ( -- ) V{ } set-datastack ;
GENERIC: hashcode ( obj -- n )
M: object hashcode drop 0 ;
@ -13,70 +13,81 @@ M: object hashcode drop 0 ;
GENERIC: equal? ( obj obj -- ? )
M: object equal? eq? ;
: = ( obj obj -- ? )
: = ( obj1 obj2 -- ? )
2dup eq? [ 2drop t ] [ equal? ] if ; inline
GENERIC: <=> ( obj1 obj2 -- n )
GENERIC: clone ( obj -- obj )
GENERIC: clone ( obj -- cloned )
M: object clone ;
: set-boot ( quot -- ) 8 setenv ;
: ? ( cond t f -- t/f ) rot [ drop ] [ nip ] if ; inline
: ? ( cond true false -- true/false )
rot [ drop ] [ nip ] if ; inline
: cpu ( -- arch ) 7 getenv ; foldable
: cpu ( -- cpu ) 7 getenv ; foldable
: os ( -- os ) 11 getenv ; foldable
: windows? ( -- ? ) os "windows" = ; inline
: macosx? os "macosx" = ; inline
: macosx? ( -- ? ) os "macosx" = ; inline
: slip >r call r> ; inline
: slip ( quot x -- x ) >r call r> ; inline
: 2slip >r >r call r> r> ; inline
: 2slip ( quot x y -- x y ) >r >r call r> r> ; inline
: keep over >r call r> ; inline
: keep ( x quot -- x ) over >r call r> ; inline
: 2keep over >r pick >r call r> r> ; inline
: 2keep ( x y quot -- x y ) over >r pick >r call r> r> ; inline
: 3keep >r 3dup r> swap >r swap >r swap >r call r> r> r> ;
inline
: 3keep ( x y z quot -- x y z )
>r 3dup r> swap >r swap >r swap >r call r> r> r> ;
inline
: 2apply tuck 2slip call ; inline
: 2apply ( x y quot -- ) tuck 2slip call ; inline
: if* pick [ drop call ] [ 2nip call ] if ; inline
: if* ( cond true false -- )
pick [ drop call ] [ 2nip call ] if ; inline
: ?if >r >r [ nip r> r> drop call ] [ r> drop r> call ] if* ;
inline
: ?if ( default cond true false -- )
>r >r [ nip r> r> drop call ] [ r> drop r> call ] if* ;
inline
: unless [ ] swap if ; inline
: unless ( cond false -- ) [ ] swap if ; inline
: unless* over [ drop ] [ nip call ] if ; inline
: unless* ( cond false -- )
over [ drop ] [ nip call ] if ; inline
: when [ ] if ; inline
: when ( cond true -- ) [ ] if ; inline
: when* dupd [ drop ] if ; inline
: when* ( cond true -- ) dupd [ drop ] if ; inline
: >boolean t f ? ; inline
: and ( a b -- a&b ) f ? ; inline
: or ( a b -- a|b ) t swap ? ; inline
: xor ( a b -- a^b ) [ not ] when ; inline
: >boolean ( obj -- ? ) t f ? ; inline
: and ( obj1 obj2 -- ? ) f ? ; inline
: or ( obj1 obj2 -- ? ) t swap ? ; inline
: xor ( obj1 obj2 -- ? ) [ not ] when ; inline
: with ( obj quot elt -- obj quot )
pick pick >r >r swap call r> r> ; inline
: keep-datastack datastack slip set-datastack drop ; inline
: keep-datastack ( quot -- )
datastack slip set-datastack drop ; inline
IN: kernel-internals
! These words are unsafe. Don't use them.
: declare ( types -- ) drop ;
: declare ( spec -- ) drop ;
: array-capacity 1 slot { fixnum } declare ; inline
: array-nth swap 2 fixnum+fast slot ; inline
: set-array-nth swap 2 fixnum+fast set-slot ; inline
: array-capacity ( array -- n )
1 slot { fixnum } declare ; inline
: array-nth ( n array -- elt )
swap 2 fixnum+fast slot ; inline
: set-array-nth ( elt n array -- )
swap 2 fixnum+fast set-slot ; inline
! Some runtime implementation details
: num-types 19 ; inline
: num-types ( -- n ) 19 ; inline
: tag-mask BIN: 111 ; inline
: num-tags 8 ; inline
: tag-bits 3 ; inline
@ -90,12 +101,12 @@ IN: kernel-internals
: complex-tag BIN: 110 ; inline
: wrapper-tag BIN: 111 ; inline
: cell 17 getenv ; foldable
: cell ( -- n ) 17 getenv ; foldable
IN: kernel
: win32? windows? cell 4 = and ; inline
: win64? windows? cell 8 = and ; inline
: win32? ( -- ? ) windows? cell 4 = and ; inline
: win64? ( -- ? ) windows? cell 8 = and ; inline
IN: memory

View File

@ -1,63 +1,66 @@
USING: generic help kernel kernel-internals math memory
namespaces sequences ;
IN: kernel
USING: generic help kernel math memory namespaces sequences ;
HELP: eq? "( obj1 obj2 -- ? )"
HELP: eq? ( obj1 obj2 -- ? )
{ $values { "obj1" "an object" } { "obj2" "an object" } }
{ $description "Tests if two references point at the same object." } ;
HELP: drop "( x -- )" $shuffle ;
HELP: 2drop "( x y -- )" $shuffle ;
HELP: 3drop "( x y z -- )" $shuffle ;
HELP: dup "( x -- x x )" $shuffle ;
HELP: 2dup "( x y -- x y x y )" $shuffle ;
HELP: 3dup "( x y z -- x y z x y z )" $shuffle ;
HELP: rot "( x y z -- y z x )" $shuffle ;
HELP: -rot "( x y z -- z x y )" $shuffle ;
HELP: dupd "( x y -- x x y )" $shuffle ;
HELP: swapd "( x y z -- y x z )" $shuffle ;
HELP: nip "( x y -- y )" $shuffle ;
HELP: 2nip "( x y z -- z )" $shuffle ;
HELP: tuck "( x y -- y x y )" $shuffle ;
HELP: over "( x y -- x y x )" $shuffle ;
HELP: pick "( x y z -- x y z x )" $shuffle ;
HELP: swap "( x y -- y x )" $shuffle ;
HELP: 2swap "( x y z t -- z t x y )" $shuffle ;
HELP: drop ( x -- ) $shuffle ;
HELP: 2drop ( x y -- ) $shuffle ;
HELP: 3drop ( x y z -- ) $shuffle ;
HELP: dup ( x -- x x ) $shuffle ;
HELP: 2dup ( x y -- x y x y ) $shuffle ;
HELP: 3dup ( x y z -- x y z x y z ) $shuffle ;
HELP: rot ( x y z -- y z x ) $shuffle ;
HELP: -rot ( x y z -- z x y ) $shuffle ;
HELP: dupd ( x y -- x x y ) $shuffle ;
HELP: swapd ( x y z -- y x z ) $shuffle ;
HELP: nip ( x y -- y ) $shuffle ;
HELP: 2nip ( x y z -- z ) $shuffle ;
HELP: tuck ( x y -- y x y ) $shuffle ;
HELP: over ( x y -- x y x ) $shuffle ;
HELP: pick ( x y z -- x y z x ) $shuffle ;
HELP: swap ( x y -- y x ) $shuffle ;
HELP: 2swap ( x y z t -- z t x y ) $shuffle ;
HELP: >r "( x -- r: x )" $shuffle ;
HELP: r> "( r: x -- x )" $shuffle ;
HELP: >r ( x -- )
{ $values { "x" "an object" } } { $description "Moves the top of the data stack to the retain stack." } ;
HELP: datastack "( -- ds )"
HELP: r> ( -- x )
{ $values { "x" "an object" } } { $description "Moves the top of the retain stack to the data stack." } ;
HELP: datastack ( -- ds )
{ $values { "ds" "a vector" } }
{ $description "Outputs the a vector containing a copy of the data stack contents right before the call to this word, with the top of the stack at the end of the vector." } ;
HELP: set-datastack "( ds -- )"
HELP: set-datastack ( ds -- )
{ $values { "ds" "a vector" } }
{ $description "Replaces the data stack contents with a copy of a vector. The end of the vector becomes the top of the stack." } ;
HELP: retainstack "( -- rs )"
HELP: retainstack ( -- rs )
{ $values { "rs" "a vector" } }
{ $description "Outputs the a vector containing a copy of the retain stack contents right before the call to this word, with the top of the stack at the end of the vector." } ;
HELP: set-retainstack "( rs -- )"
HELP: set-retainstack ( rs -- )
{ $values { "rs" "a vector" } }
{ $description "Replaces the retain stack contents with a copy of a vector. The end of the vector becomes the top of the stack." } ;
HELP: callstack "( -- cs )"
HELP: callstack ( -- cs )
{ $values { "cs" "a vector" } }
{ $description "Outputs the a vector containing a copy of the call stack contents right before the call to this word, with the top of the stack at the end of the vector. The call frame of the caller word is " { $emphasis "not" } " included." } ;
HELP: set-callstack "( cs -- )"
HELP: set-callstack ( cs -- )
{ $values { "cs" "a vector" } }
{ $description "Replaces the call stack contents with a copy of a vector. The end of the vector becomes the top of the stack. The current quotation continues executing. The new callstack takes effect when the current quotation returns, resulting in a callframe being popped." } ;
HELP: (clone) "( obj -- newobj )"
HELP: (clone) ( obj -- newobj )
{ $values { "obj" "an object" } { "newobj" "a shallow copy" } }
{ $description "Outputs a byte-by-byte copy of the given object. User code should call " { $link clone } " instead." } ;
HELP: clear "( -- )"
HELP: clear
{ $description "Clears the data stack." } ;
HELP: hashcode "( obj -- n )"
HELP: hashcode
{ $values { "obj" "an object" } { "n" "a fixnum" } }
{ $contract "Outputs the hashcode of the object. The hashcode operation must satisfy the following properties:"
{ $list
@ -67,7 +70,7 @@ HELP: hashcode "( obj -- n )"
}
"If mutable objects are used as hashtable keys, they must not be mutated in such a way that their hashcode changes. Doing so will violate bucket sorting invariants and result in undefined behavior." } ;
HELP: = "( obj1 obj2 -- ? )"
HELP: =
{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } }
{ $contract
"Tests if two objects are equal. If two objects are equal, they should the same printed representation, although the converse is not always true."
@ -87,7 +90,7 @@ HELP: = "( obj1 obj2 -- ? )"
}
} ;
HELP: <=> "( obj1 obj2 -- n )"
HELP: <=>
{ $values { "obj1" "an object" } { "obj2" "an object" } { "n" "an integer" } }
{ $contract
"Compares two objects using an intrinsic partial order, for example, the natural order for real numbers and lexicographic order for strings."
@ -102,71 +105,72 @@ HELP: <=> "( obj1 obj2 -- n )"
}
{ $see-also natural-sort } ;
HELP: clone "( obj -- cloned )"
HELP: clone
{ $values { "obj" "an object" } { "cloned" "a new object" } }
{ $contract "Outputs a new object equal to the given object. This is not guaranteed to actually copy the object; it does nothing with immutable objects, and does not copy words either. However, sequences and tuples can be cloned to obtain a shallow copy of the original." } ;
HELP: set-boot "( quot -- )"
HELP: set-boot
{ $values { "quot" "a quotation" } }
{ $description "Sets the initial quotation called by the runtime as the last stage of startup. The image must be saved for changes to the boot quotation to take effect. Usually the boot quotation should not be changed." } ;
HELP: num-types "( -- n )"
HELP: num-types
{ $values { "n" "a postiive integer" } }
{ $description "Outputs one more than the maximum value from the " { $link type } " primitive." } ;
HELP: type "( object -- n )"
DEFER: type ( object -- n )
HELP: type
{ $values { "object" "an object" } { "n" "a type number" } }
{ $description "Outputs an object's type number, between zero and one less than " { $link num-types } ". This is implementation detail and user code should call " { $link class } " instead." }
{ $see-also type>class tag } ;
HELP: tag "( object -- n )"
{ $values { "object" "an object" } { "n" "a tag number" } }
{ $description "Outputs an object's tag number, between zero and one less than " { $link num-tags } ". This is implementation detail and user code should call " { $link class } " instead." }
{ $see-also type } ;
HELP: ? "( cond true false -- true/false )"
HELP: ?
{ $values { "cond" "a generalized boolean" } { "true" "an object" } { "false" "an object" } { "true/false" "one two input objects" } }
{ $description "Chooses between two values depending on the boolean value of " { $snippet "cond" } "." } ;
HELP: >boolean "( obj -- ? )"
HELP: >boolean
{ $values { "obj" "a generalized boolean" } { "?" "a boolean" } }
{ $description "Convert a generalized boolean into a boolean. That is, " { $link f } " retains its value, whereas anything else becomes " { $link t } "." } ;
HELP: not "( obj -- ? )"
HELP: not ( obj -- ? )
{ $values { "obj" "a generalized boolean" } { "?" "a boolean" } }
{ $description "For " { $link f } " outputs " { $link t } " and for anything else outputs " { $link f } "." } ;
HELP: and "( obj1 obj2 -- ? )"
HELP: and
{ $values { "obj1" "a generalized boolean" } { "obj2" "a generalized boolean" } { "obj" "a generalized boolean" } }
{ $description "Tests if neither object is " { $link f } "." } ;
HELP: or "( obj1 obj2 -- ? )"
HELP: or
{ $values { "obj1" "a generalized boolean" } { "obj2" "a generalized boolean" } { "obj" "a generalized boolean" } }
{ $description "Tests if at least one object is not " { $link f } "." } ;
HELP: cpu "( -- cpu )"
HELP: xor
{ $values { "obj1" "a generalized boolean" } { "obj2" "a generalized boolean" } { "obj" "a generalized boolean" } }
{ $description "Tests if at exactly one object is not " { $link f } "." } ;
HELP: cpu
{ $values { "cpu" "a string" } }
{ $description
"Outputs a string descriptor of the current CPU architecture. Currently, this set of descriptors is:"
{ $code "amd64" "ppc" "x86" }
} ;
HELP: os "( -- os )"
HELP: os
{ $values { "os" "a string" } }
{ $description
"Outputs a string descriptor of the current operating system family. Currently, this set of descriptors is:"
{ $code "freebsd" "linux" "macosx" "solaris" "win32" "unix" }
} ;
HELP: windows? "( -- ? )"
HELP: windows?
{ $values { "?" "a boolean" } }
{ $description "Tests if Factor is running on Windows." } ;
HELP: macosx? "( -- ? )"
HELP: macosx?
{ $values { "?" "a boolean" } }
{ $description "Tests if Factor is running on Mac OS X." } ;
HELP: call "( quot -- )"
HELP: call ( quot -- )
{ $values { "quot" "a quotation" } }
{ $description "Push the current callframe on the callstack, and set the callframe to the given quotation. Conceptually, calls the quotation, as if its definition was substituted at the location of the call." }
{ $examples
@ -174,49 +178,49 @@ HELP: call "( quot -- )"
{ $code "2 [ 2 + 3 * ] call" "2 2 + 3 *" }
} ;
HELP: slip "( quot x -- x )"
HELP: slip
{ $values { "quot" "a quotation" } { "x" "an object" } }
{ $description "Calls a quotation while hiding the top of the stack." } ;
HELP: 2slip "( quot x y -- x y )"
HELP: 2slip
{ $values { "quot" "a quotation" } { "x" "an object" } { "y" "an object" } }
{ $description "Calls a quotation while hiding the top two stack elements." } ;
HELP: keep "( x quot -- x )"
HELP: keep
{ $values { "quot" "a quotation with stack effect " { $snippet "( x -- )" } } { "x" "an object" } }
{ $description "Call a quotation with a value on the stack, restoring the value when the quotation returns." } ;
HELP: 2keep "( x y quot -- x y )"
HELP: 2keep
{ $values { "quot" "a quotation with stack effect " { $snippet "( x y -- )" } } { "x" "an object" } { "y" "an object" } }
{ $description "Call a quotation with two values on the stack, restoring the values when the quotation returns." } ;
HELP: 3keep "( x y z quot -- x y z )"
HELP: 3keep
{ $values { "quot" "a quotation with stack effect " { $snippet "( x y -- )" } } { "x" "an object" } { "y" "an object" } { "z" "an object" } }
{ $description "Call a quotation with three values on the stack, restoring the values when the quotation returns." } ;
HELP: 2apply "( x y quot -- )"
HELP: 2apply
{ $values { "quot" "a quotation with stack effect " { $snippet "( obj -- )" } } { "x" "an object" } { "y" "an object" } }
{ $description "Applies the quotation to " { $snippet "x" } ", then to " { $snippet "y" } "." } ;
HELP: if "( cond true false -- )"
HELP: if ( cond true false -- )
{ $values { "cond" "a generalized boolean" } { "true" "a quotation" } { "false" "a quotation" } }
{ $description "If " { $snippet "cond" } " is " { $link f } ", calls the " { $snippet "false" } " quotation. Otherwise calls the " { $snippet "true" } " quotation."
$terpri
"The " { $snippet "cond" } " value is removed from the stack before either quotation is called." } ;
HELP: when "( cond true -- )"
HELP: when
{ $values { "cond" "a generalized boolean" } { "true" "a quotation" } }
{ $description "If " { $snippet "cond" } " is not " { $link f } ", calls the " { $snippet "true" } " quotation."
$terpri
"The " { $snippet "cond" } " value is removed from the stack before the quotation is called." } ;
HELP: unless "( cond false -- )"
HELP: unless
{ $values { "cond" "a generalized boolean" } { "false" "a quotation" } }
{ $description "If " { $snippet "cond" } " is " { $link f } ", calls the " { $snippet "false" } " quotation."
$terpri
"The " { $snippet "cond" } " value is removed from the stack before the quotation is called." } ;
HELP: if* "( cond true false -- )"
HELP: if*
{ $values { "cond" "a generalized boolean" } { "true" "a quotation with stack effect " { $snippet "( cond -- )" } } { "false" "a quotation" } }
{ $description "Alternative conditional form that preserves the " { $snippet "cond" } " value if it is true."
$terpri
@ -225,37 +229,87 @@ $terpri
"The following two lines are equivalent:"
{ $code "X [ Y ] [ Z ] if*" "X dup [ Y ] [ drop Z ] if" } } ;
HELP: when* "( cond true -- )"
HELP: when*
{ $values { "cond" "a generalized boolean" } { "true" "a quotation with stack effect " { $snippet "( cond -- )" } } }
{ $description "Variant of " { $link if* } " with no false quotation."
$terpri
"The following two lines are equivalent:"
{ $code "X [ Y ] when*" "X dup [ Y ] [ drop ] if" } } ;
HELP: unless* "( cond false -- )"
HELP: unless*
{ $values { "cond" "a generalized boolean" } { "false" "a quotation " } }
{ $description "Variant of " { $link if* } " with no true quotation."
$terpri
"The following two lines are equivalent:"
{ $code "X [ Y ] unless*" "X dup [ ] [ drop Y ] if" } } ;
HELP: ?if "( default cond true false -- )"
HELP: ?if
{ $values { "default" "an object" } { "cond" "a generalized boolean" } { "true" "a quotation with stack effect " { $snippet "( cond -- )" } } { "false" "a quotation with stack effect " { $snippet "( default -- )" } } }
{ $description "If the condition is " { $link f } ", the " { $snippet "false" } " quotation is called with the " { $snippet "default" } " value on the stack. Otherwise, the " { $snippet "true" } " quotation is called with the condition on the stack."
$terpri
"The following two lines are equivalent:"
{ $code "[ X ] [ Y ] ?if" "dup [ nip X ] [ drop Y ] if" } } ;
HELP: keep-datastack "( quot -- )"
HELP: with
{ $values { "obj" "an object" } { "quot" "a quotation with stack effect " { $snippet "( obj elt -- )" } } { "elt" "an object" } }
{ $description "Utility word used to implement curried combinators such as " { $link each-with } " and " { $link map-with } "." } ;
HELP: keep-datastack
{ $values { "quot" "a quotation" } }
{ $description "Calls a quotation, saving the datastack before calling it and restoring it after it returns." } ;
HELP: literalize "( obj -- wrapper )"
{ $values { "obj" "an object" } { "wrapper" "a wrapper or the original object" } }
{ $description "Turns non-self-evaluating objects (words and wrappers) into wrappers that push those objects, and is a no-op on everything else." } ;
HELP: die
{ $description "Starts the front-end processor (FEP), which is a low-level debugger which can inspect memory addresses and the like. The FEP is also entered when a critical error occurs." } ;
HELP: declare "( spec -- )"
{ $values { "spec" "an array of classes" } }
HELP: exit ( n -- )
{ $values { "n" "an integer exit code" } }
{ $description "Exits the Factor process." } ;
HELP: millis ( -- n )
{ $values { "n" "an integer" } }
{ $description "Outputs the number of milliseconds ellapsed since midnight January 1, 1970." } ;
HELP: os-env ( key -- value )
{ $values { "key" "a string" } { "value" "a string" } }
{ $description "Looks up the value of a shell environment variable." }
{ $examples
"This is an operating system-specific feature. On Unix, you can do:"
{ $example "\"USER\" os-env print" "slava" }
} ;
HELP: cell
{ $values { "n" "a positive integer" } }
{ $description "Outputs the pointer size in bytes of the current CPU architecture." } ;
HELP: win32?
{ $values { "?" "a boolean" } }
{ $description "Tests if Factor is running on 32-bit Windows." } ;
HELP: win64?
{ $values { "?" "a boolean" } }
{ $description "Tests if Factor is running on 64-bit Windows." } ;
IN: memory
HELP: generations
{ $values { "n" "a positive integer" } }
{ $description "Outputs the number of generations partitioning the heap." } ;
HELP: image
{ $values { "path" "a path name string" } }
{ $description "Outputs the path name of the currently running Factor image." } ;
HELP: save-image ( path -- )
{ $values { "path" "a path name string" } }
{ $description "Saves a snapshot of the heap to the given file, overwriting the file if it already exists." } ;
HELP: save
{ $description "Saves a snapshot of the heap to the current image file." } ;
IN: kernel-internals
HELP: declare
{ $values { "spec" "an array of class words" } }
{ $description "Declares that the elements at the top of the stack are instances of the classes in " { $snippet "spec" } "." }
{ $warning "The compiler blindly trusts declarations, and false declarations can lead to crashes, memory corruption and other undesirable behavior." }
{ $examples
@ -265,96 +319,55 @@ HELP: declare "( spec -- )"
{ $example "[ { float } declare 2 + 10 * ] f dataflow." "[ 2.0 float+ 10.0 float* ]" }
} ;
HELP: array-capacity "( array -- n )"
HELP: array-capacity
{ $values { "array" "an array" } { "n" "a non-negative fixnum" } }
{ $description "Low-level array length accessor." }
{ $warning "This word is in the " { $vocab-link "kernel-internals" } " vocabulary because it is unsafe. It does not check types, so improper use can corrupt memory." } ;
HELP: array-nth "( n array -- elt )"
HELP: array-nth
{ $values { "n" "a non-negative fixnum" } { "array" "an array" } { "elt" "an object" } }
{ $description "Low-level array element accessor." }
{ $warning "This word is in the " { $vocab-link "kernel-internals" } " vocabulary because it is unsafe. It does not check types or array bounds, and improper use can corrupt memory." } ;
HELP: set-array-nth "( elt n array -- )"
HELP: set-array-nth
{ $values { "elt" "an object" } { "n" "a non-negative fixnum" } { "array" "an array" } }
{ $description "Low-level array element mutator." }
{ $warning "This word is in the " { $vocab-link "kernel-internals" } " vocabulary because it is unsafe. It does not check types or array bounds, and improper use can corrupt memory." } ;
HELP: cell "( -- n )"
{ $values { "n" "a positive integer" } }
{ $description "Outputs the pointer size in bytes of the current CPU architecture." } ;
HELP: tag ( object -- n )
{ $values { "object" "an object" } { "n" "a tag number" } }
{ $description "Outputs an object's tag number, between zero and one less than " { $link num-tags } ". This is implementation detail and user code should call " { $link class } " instead." }
{ $see-also type } ;
HELP: win32? "( -- ? )"
{ $values { "?" "a boolean" } }
{ $description "Tests if Factor is running on 32-bit Windows." } ;
HELP: dispatch ( n array -- )
{ $values { "n" "a fixnum" } { "array" "an array of quotations" } }
{ $description "Calls the " { $snippet "n" } "th quotation in the array." }
{ $warning "This word is in the " { $vocab-link "kernel-internals" } " vocabulary because it is an implementation detail used by the generic word system to accelerate method dispatch. It does not perform type or bounds checks, and user code should not need to call it directly." } ;
HELP: win64? "( -- ? )"
{ $values { "?" "a boolean" } }
{ $description "Tests if Factor is running on 64-bit Windows." } ;
HELP: generations "( -- n )"
{ $values { "n" "a positive integer" } }
{ $description "Outputs the number of generations partitioning the heap." } ;
HELP: image "( -- path )"
{ $values { "path" "a path name string" } }
{ $description "Outputs the path name of the currently running Factor image." } ;
HELP: save-image "( path -- )"
{ $values { "path" "a path name string" } }
{ $description "Saves a snapshot of the heap to the given file, overwriting the file if it already exists." } ;
HELP: save "( -- )"
{ $description "Saves a snapshot of the heap to the current image file." } ;
HELP: die "( -- )"
{ $description "Starts the front-end processor (FEP), which is a low-level debugger which can inspect memory addresses and the like. The FEP is also entered when a critical error occurs." } ;
HELP: exit "( n -- )"
{ $values { "n" "an integer exit code" } }
{ $description "Exits the Factor process." } ;
HELP: getenv "( n -- obj )"
HELP: getenv ( n -- obj )
{ $values { "n" "a non-negative integer" } { "obj" "an object" } }
{ $description "Reads an object from the Factor runtime's environment table. User code never has to read the environment table directly; instead, use one of the callers of this word." } ;
HELP: setenv "( obj n -- )"
HELP: setenv ( obj n -- )
{ $values { "n" "a non-negative integer" } { "obj" "an object" } }
{ $description "Writes an object to the Factor runtime's environment table. User code never has to write to the environment table directly; instead, use one of the callers of this word." } ;
HELP: integer-slot "( obj m -- n )"
HELP: integer-slot ( obj m -- n )
{ $values { "obj" "an object" } { "m" "a non-negative fixnum" } { "n" "an integer" } }
{ $description "Reads the untagged integer stored at the " { $snippet "n" } "th slot of " { $snippet "obj" } "." }
{ $warning "This word is in the " { $vocab-link "kernel-internals" } " vocabulary because it does not perform type or bounds checks, and slot numbers are implementation detail." } ;
HELP: set-integer-slot "( m obj n -- )"
HELP: set-integer-slot ( m obj n -- )
{ $values { "n" "an integer" } { "obj" "an object" } { "m" "a non-negative fixnum" } }
{ $description "Writes an untagged integer to the " { $snippet "n" } "th slot of " { $snippet "obj" } "." }
{ $warning "This word is in the " { $vocab-link "kernel-internals" } " vocabulary because it does not perform type or bounds checks, and slot numbers are implementation detail." } ;
HELP: slot "( obj m -- value )"
HELP: slot ( obj m -- value )
{ $values { "obj" "an object" } { "m" "a non-negative fixnum" } { "value" "an object" } }
{ $description "Reads the object stored at the " { $snippet "n" } "th slot of " { $snippet "obj" } "." }
{ $warning "This word is in the " { $vocab-link "kernel-internals" } " vocabulary because it does not perform type or bounds checks, and slot numbers are implementation detail." } ;
HELP: set-slot "( value obj n -- )"
HELP: set-slot ( value obj n -- )
{ $values { "value" "an object" } { "obj" "an object" } { "m" "a non-negative fixnum" } }
{ $description "Writes " { $snippet "value" } " to the " { $snippet "n" } "th slot of " { $snippet "obj" } "." }
{ $warning "This word is in the " { $vocab-link "kernel-internals" } " vocabulary because it does not perform type or bounds checks, and slot numbers are implementation detail." } ;
HELP: millis "( -- n )"
{ $values { "n" "an integer" } }
{ $description "Outputs the number of milliseconds ellapsed since midnight January 1, 1970." } ;
HELP: os-env "( key -- value )"
{ $values { "key" "a string" } { "value" "a string" } }
{ $description "Looks up the value of a shell environment variable." }
{ $examples
"This is an operating system-specific feature. On Unix, you can do:"
{ $example "\"USER\" os-env print" "slava" }
} ;
HELP: dispatch "( n array -- )"
{ $values { "n" "a fixnum" } { "array" "an array of quotations" } }
{ $description "Calls the " { $snippet "n" } "th quotation in the array." }
{ $warning "This word is in the " { $vocab-link "kernel-internals" } " vocabulary because it is an implementation detail used by the generic word system to accelerate method dispatch. It does not perform type or bounds checks, and user code should not need to call it directly." } ;

View File

@ -9,7 +9,7 @@ TUPLE: module name files tests ;
: module-path ( name -- path )
"/contrib/" swap append ;
: module-paths ( name seq -- seq )
: module-paths ( name seq -- newseq )
>r module-path r> [ "/" swap append3 ] map-with ;
C: module ( name files tests -- module )

View File

@ -1,15 +1,15 @@
IN: modules
USING: help io ;
HELP: module-path "( name -- path )"
HELP: module-path
{ $values { "name" "a module name string" } { "path" "a path name string" } }
{ $description "Outputs the location of the module named " { $snippet "name" } "." } ;
HELP: module-paths "( name seq -- newseq )"
HELP: module-paths
{ $values { "name" "a module name string" } { "seq" "a sequence of strings" } { "newseq" "a new sequence of path name strings" } }
{ $description "Prepend the location of the module named " { $snippet "name" } " to every file name in " { $snippet "seq" } "." } ;
HELP: module-def "( name -- path )"
HELP: module-def
{ $values { "name" "a module name string" } { "path" "a path name string" } }
{ $description "Outputs the location of the module definition file. This word looks for the module definition in two locations:"
{ $list
@ -19,39 +19,39 @@ HELP: module-def "( name -- path )"
}
{ $notes "This file is loaded by " { $link require } ", and should contain the necessary " { $link POSTPONE: REQUIRES: } " and " { $link POSTPONE: PROVIDE: } " declarations for the module." } ;
HELP: modules f
HELP: modules
{ $description "Variable. Hashtable mapping loaded module names to " { $link module } " instances." }
{ $see-also require load-module } ;
HELP: load-module "( name -- )"
HELP: load-module
{ $values { "name" "a module name string" } }
{ $description "Runs the module definition file given by " { $link module-def } ", which loads the module's dependencies and source files." }
{ $notes "Unless you want to explicitly reload the sources of a module (for example, after making changes), you should use " { $link (require) } " or " { $link require } " instead." } ;
HELP: (require) "( name -- )"
HELP: (require)
{ $values { "name" "a module name string" } }
{ $description "Ensures that a module has been loaded, along with all its dependencies."
$terpri
"If this module is already listed in the " { $link modules } " hashtable, this word does nothing. Otherwise, it calls " { $link load-module } "." }
{ $notes "Module definitions should use the " { $link POSTPONE: REQUIRES: } " parsing word instead. In the listener, the " { $link require } " word might be more useful since it recompiles new words after loading the module." } ;
HELP: require "( name -- )"
HELP: require
{ $values { "name" "a module name string" } }
{ $description "Ensures that a module has been loaded, along with all its dependencies, and recompiles all new words. This word is only for interactive use in the listener; to avoid recompiling words multiple times, any user code which needs to load modules should call " { $link (require) } " instead." } ;
HELP: run-resources "( seq -- )"
HELP: run-resources
{ $values { "seq" "a sequence of strings" } }
{ $description "Load a collection of source files identified by resource paths (see " { $link resource-path } ")."
$terpri
"If bootstrapping, this word appends the top-level forms to the currently constructing quotation instead." } ;
HELP: provide "( name files tests -- )"
HELP: provide
{ $values { "name" "a string" } { "files" "a sequence of strings" } { "tests" "a sequence of strings" } }
{ $description "Registers a module definition and loads its source files. Usually instead of calling this word, module definitions use the parsing word " { $link POSTPONE: PROVIDE: } " instead." } ;
HELP: test-module "( name -- )"
HELP: test-module
{ $values { "name" "a module name string" } }
{ $description "Runs the unit test files associated to the module by a previous call to " { $link provide } " or " { $link POSTPONE: PROVIDE: } "." } ;
HELP: test-modules "( -- )"
HELP: test-modules
{ $description "Runs unit test files for all loaded modules." } ;

View File

@ -14,22 +14,22 @@ M: quotation set-nth bounds-check set-nth-unsafe ;
M: quotation nth-unsafe >r >fixnum r> array-nth ;
M: quotation set-nth-unsafe >r >fixnum r> set-array-nth ;
: >quotation ( seq -- array )
: >quotation ( seq -- quot )
[ quotation? ] [ <quotation> ] >sequence ; inline
M: quotation like drop dup quotation? [ >quotation ] unless ;
: make-dip ( quot n -- quot )
: make-dip ( quot n -- newquot )
dup \ >r <array> -rot \ r> <array> append3 >quotation ;
: unit ( a -- quot ) 1array >quotation ;
: unit ( obj -- quot ) 1array >quotation ;
GENERIC: literalize ( obj -- obj )
GENERIC: literalize ( obj -- newobj )
M: object literalize ;
M: word literalize <wrapper> ;
M: wrapper literalize <wrapper> ;
: curry ( obj quot -- quot ) swap literalize add* ;
: curry ( obj quot -- newquot ) swap literalize add* ;
: alist>quot ( default alist -- quot )
: alist>quot ( default assoc -- quot )
[ [ first2 swap % , , \ if , ] [ ] make ] each ;

View File

@ -1,27 +1,27 @@
IN: kernel
USING: arrays help strings vectors ;
HELP: quotation f
HELP: quotation
{ $description "The class of quotations. See " { $link "syntax-quots" } " for syntax and " { $link "quotations" } " for general information." } ;
HELP: <quotation> "( n -- quot )"
HELP: <quotation> ( n -- quot )
{ $values { "n" "a non-negative integer" } { "quot" "a new quotation" } }
{ $description "Creates a new quotation with the given length and all elements initially set to " { $link f } "." }
{ $see-also <array> <string> <sbuf> <vector> } ;
HELP: >quotation "( seq -- quot )"
HELP: >quotation
{ $values { "seq" "a sequence" } { "quot" "a quotation" } }
{ $description "Outputs a freshly-allocated quotation with the same elements as a given sequence." }
{ $see-also >array >string >sbuf >vector } ;
HELP: make-dip "( quot n -- newquot )"
HELP: make-dip
{ $values { "quot" "a quotation" } { "n" "a non-negative integer" } { "newquot" "a new quotation" } }
{ $description "Constructs a quotation which retains the top " { $snippet "n" } " stack items, and applies " { $snippet "quot" } " to what is underneath." }
{ $examples
{ $example "[ 3 + ] 2 make-dip ." "[ >r >r 3 + r> r> ]" }
} ;
HELP: unit "( obj -- quot )"
HELP: unit
{ $values { "obj" "an object" } { "quot" "a new quotation" } }
{ $description "Constructs a quotation holding one element." }
{ $notes
@ -31,23 +31,23 @@ HELP: unit "( obj -- quot )"
}
{ $see-also 1array } ;
HELP: wrapper f
HELP: wrapper
{ $description "The class of wrappers. See " { $link "syntax-words" } " for syntax." } ;
HELP: <wrapper> "( obj -- wrapper )"
HELP: <wrapper> ( obj -- wrapper )
{ $values { "obj" "an object" } { "wrapper" "a new wrapper" } }
{ $description "Creates an object which pushes " { $snippet "obj" } " on the stack when evaluated. User code should call " { $link literalize } " instead, since it avoids wrapping self-evaluating objects (which is redundant)." } ;
HELP: literalize "( obj -- wrapped )"
HELP: literalize
{ $values { "obj" "an object" } { "wrapped" "an object" } }
{ $description "Outputs an object which evaluates to " { $snippet "obj" } ". If " { $snippet "obj" } " is not self-evaluating (for example, it is a word), then it will be wrapped." }
{ $description "Outputs an object which evaluates to " { $snippet "obj" } " when placed in a quotation. If " { $snippet "obj" } " is not self-evaluating (for example, it is a word), then it will be wrapped." }
{ $examples
{ $example "5 literalize ." "5" }
{ $example "[ + ] [ litealize ] map ." "[ \\ + ]" }
}
{ $see-also curry <wrapper> } ;
HELP: curry "( obj quot -- newquot )"
HELP: curry
{ $values { "obj" "an object" } { "quot" "a quotation" } { "newquot" "a quotation" } }
{ $description "Constructs a new quotation which first pushes " { $snippet "obj" } " and then calls " { $snippet "quot" } ". If " { $snippet "obj" } " is not self-evaluating, it will be wrapped." }
{ $examples
@ -55,7 +55,7 @@ HELP: curry "( obj quot -- newquot )"
{ $example "\\ = [ see ] curry ." "[ \\ = see ]" }
} ;
HELP: alist>quot "( default assoc -- quot )"
HELP: alist>quot
{ $values { "default" "a quotation" } { "assoc" "a sequence of quotation pairs" } { "quot" "a new quotation" } }
{ $description "Constructs a quotation which calls the first quotation in each pair of " { $snippet "assoc" } " until one of them outputs a true value, and then calls the second quotation in the corresponding pair. Quotations are called in reverse order, and if no quotation outputs a true value then " { $snippet "default" } " is called." }
{ $notes "This word is used to implement compile-time behavior for " { $link cond } ", and it is also used by the generic word system. Note that unlike " { $link cond } ", the constructed quotation performs the tests starting from the end and not the beginning." } ;

View File

@ -43,7 +43,7 @@ SYMBOL: !t
: !SYMBOL: CREATE dup reset-generic define-symbol ; parsing
DEFER: !PRIMITIVE: parsing
: !DEFER: CREATE reset-generic ; parsing
: !DEFER: CREATE drop ; parsing
: !: CREATE dup reset-generic [ define-compound ] f ; parsing
: !GENERIC: CREATE dup reset-word define-generic ; parsing
: !G: CREATE dup reset-word [ define-generic* ] f ; parsing

View File

@ -141,10 +141,10 @@ HELP: SBUF" "string... \""
{ $description "Reads from the input string until the next occurrence of " { $link POSTPONE: " } ", converts the string to a string buffer, and appends it to the parse tree." }
{ $examples { $example "SBUF\" Hello world\" >string print" "Hello world" } } ;
HELP: ( "comment... )"
{ $values { "comment" "characters" } }
{ $description "Discards all input until the next occurrence of " { $snippet ")" } "." }
{ $notes "Conventionally used to denote a stack effect comment." }
HELP: ( "inputs -- outputs )"
{ $values { "inputs" "a list of tokens" } { "outputs" "a list of tokens" } }
{ $description "Declares the stack effect of the most recently defined word, storing a new " { $link effect } " instance in the " { $snippet "\"declared-effect\"" } " word property." }
{ $notes "Recursive words must have a declared stack effect to compile. See " { $link "compiler" } " for details." }
{ $see-also POSTPONE: ! POSTPONE: #! } ;
HELP: ! "comment..."

View File

@ -9,17 +9,17 @@ namespaces queues sequences vectors ;
: run-queue ( -- queue ) \ run-queue get-global ;
: schedule-thread ( continuation0 -- ) run-queue enque ;
: schedule-thread ( continuation -- ) run-queue enque ;
: schedule-thread-with ( obj continuation1 -- )
: schedule-thread-with ( obj continuation -- )
2array schedule-thread ;
: sleep-queue ( -- vec ) \ sleep-queue get-global ;
: sleep-queue ( -- vector ) \ sleep-queue get-global ;
: sleep-queue* ( -- vec )
: sleep-queue* ( -- vector )
sleep-queue dup [ [ first ] 2apply swap - ] nsort ;
: sleep-time ( sorted-queue -- ms )
: sleep-time ( vector -- ms )
dup empty? [ drop 1000 ] [ peek first millis [-] ] if ;
: stop ( -- )

View File

@ -1,35 +1,46 @@
USING: help threads ;
HELP: run-queue "( -- queue )"
HELP: run-queue
{ $values { "queue" "a queue" } }
{ $description "Outputs the runnable thread queue." } ;
HELP: schedule-thread "( continuation -- )"
{ $values { "continuation" "a continuation" } }
HELP: schedule-thread
{ $values { "continuation" "a continuation reified by " { $link callcc0 } } }
{ $description "Adds a runnable thread to the end of the run queue." } ;
HELP: sleep-queue "( -- vector )"
HELP: schedule-thread-with
{ $values { "obj" "an object" } { "continuation" "a continuation reified by " { $link callcc1 } } }
{ $description "Adds a runnable thread to the end of the run queue. When the thread runs the object is passed to the continuation using " { $link continue-with } "." } ;
HELP: sleep-queue
{ $values { "vector" "a vector" } }
{ $description "Outputs the sleeping thread queue. This is not actually a queue, but a vector of cons cells, where each cons cell consists of a wakeup time and a continuation." } ;
HELP: sleep-queue* "( -- vector )"
HELP: sleep-queue*
{ $values { "vector" "a vector" } }
{ $description "Outputs the sleeping thread queue, sorted by wakeup time." } ;
HELP: sleep-time "( vector -- ms )"
HELP: sleep-time
{ $values { "vector" "a sorted sleep queue" } { "ms" "a non-negative integer" } }
{ $description "Outputs the time until the next sleeping thread is scheduled to wake up, or -1 if there are no sleeping threads. The input must be a sorted sleep queue output by " { $link sleep-queue* } "." } ;
HELP: stop "( -- )"
HELP: stop
{ $description "Stops the current thread." } ;
HELP: yield "( -- )"
HELP: yield
{ $description "Adds the current thread to the end of the run queue, and switches to the next runnable thread." } ;
HELP: sleep "( ms -- )"
HELP: sleep
{ $values { "ms" "a non-negative integer" } }
{ $description "Suspends the current thread for " { $snippet "ms" } " milliseconds. It will not get woken up before this time period elapses, but since the multitasker is co-operative, the precise wakeup time is dependent on when other threads yield." } ;
HELP: in-thread "( quot -- )"
HELP: in-thread
{ $values { "quot" "a quotation" } }
{ $description "Spawns a new thread. The new thread begins running immediately. If an unhandled error occurs in the thread, the error is logged to the default stream in the dynamic extent of the caller of this word." } ;
HELP: idle-thread
{ $description "Runs the idle thread, which services I/O requests and relinquishes control to the operating system until the next Factor thread has to wake up again." }
{ $notes "This word should never be called directly. The idle thread is always running." } ;
HELP: init-threads
{ $description "Called during startup to initialize the threading system. This word should never be called directly." } ;

View File

@ -2,6 +2,10 @@ IN: errors
USING: alien arrays generic help inference kernel math memory
strings vectors ;
HELP: error.
{ $values { "error" "an object" } }
{ $contract "Prints an error in human-readable form." } ;
HELP: restarts f
{ $description "Global variable holding the set of possible restarts for the most recently thrown error." }
{ $notes "Only updated by " { $link throw } ", not " { $link rethrow } "." } ;

View File

@ -23,7 +23,7 @@ SYMBOL: changed-words
M: word <=>
[ dup word-name swap word-vocabulary 2array ] 2apply <=> ;
GENERIC: definer ( word -- word )
GENERIC: definer ( word -- definer )
PREDICATE: word undefined ( obj -- ? ) word-primitive 0 = ;
M: undefined definer drop \ DEFER: ;
@ -66,7 +66,7 @@ SYMBOL: vocabularies
: interned? ( word -- ? ) dup target-word eq? ;
: uses ( word -- uses )
: uses ( word -- seq )
word-def flatten
[ word? ] subset
[ global [ interned? ] bind ] subset
@ -100,7 +100,7 @@ SYMBOL: crossref
dup [ usage ] closure [ unxref-word* ] each
[ uses ] crossref get remove-vertex ;
: define ( word parameter primitive -- )
: define ( word def primitive -- )
pick changed-word
pick unxref-word
pick set-word-primitive
@ -146,10 +146,10 @@ SYMBOL: bootstrapping?
: all-words ( -- seq ) vocabs [ words ] map concat ;
: word-subset ( pred -- seq )
: word-subset ( quot -- seq )
all-words swap subset ; inline
: word-subset-with ( obj pred -- seq )
: word-subset-with ( obj quot -- seq )
all-words swap subset-with ; inline
: xref-words ( -- )
@ -169,7 +169,7 @@ TUPLE: check-create name vocab ;
check-create 2dup lookup dup
[ 2nip ] [ drop <word> dup reveal ] if ;
: constructor-word ( string vocab -- word )
: constructor-word ( name vocab -- word )
>r "<" swap ">" append3 r> create ;
: forget-vocab ( vocab -- )

View File

@ -1,156 +1,156 @@
IN: words
USING: definitions help inspector kernel kernel-internals parser ;
HELP: execute "( word -- )"
HELP: execute ( word -- )
{ $values { "word" "a word" } }
{ $description "Executes a word." }
{ $examples
{ $example ": twice dup execute execute ;\n: hello \"Hello\" print ;\n\\ hello twice" "Hello\nHello" }
} ;
HELP: word-props "( word -- props )"
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 -- )"
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 )"
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 -- )"
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 )"
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 -- )"
HELP: set-word-def ( obj word -- )
{ $values { "obj" "an object" } { "word" "a word" } }
{ $description "Sets a word's primitive parameter." }
$low-level-note ;
HELP: undefined f
{ $description "The class of undefined words." }
HELP: undefined
{ $class-description "The class of undefined words created by " { $link POSTPONE: DEFER: } "." }
{ $see-also POSTPONE: DEFER: } ;
HELP: compound f
{ $description "The class of compound words." }
HELP: compound
{ $description "The class of compound words created by " { $link POSTPONE: : } "." }
{ $see-also POSTPONE: : define-compound } ;
HELP: primitive f
HELP: primitive
{ $description "The class of primitive words." } ;
HELP: symbol f
{ $description "The class of symbols." }
HELP: symbol
{ $description "The class of symbols created by " { $link POSTPONE: SYMBOL: } "." }
{ $see-also POSTPONE: SYMBOL: define-symbol intern-symbol } ;
HELP: init-word "( word -- )"
HELP: init-word
{ $values { "word" "a word" } }
{ $description "Initializes a word output from the " { $link <word> } " primitive." } ;
HELP: word-prop "( word name -- value )"
HELP: word-prop
{ $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 -- )"
HELP: set-word-prop
{ $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 -- )"
HELP: remove-word-prop
{ $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 )"
HELP: 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 -- )"
HELP: set-word-xt
{ $values { "xt" "an execution token integer" } { "word" "a word" } }
{ $description "Sets the machine code address of the word's definition." }
{ $warning "This word is unsafe. Specifying an invalid address can corrupt memory and crash the runtime." }
{ $notes "This word is used by the compiler." } ;
HELP: uses "( word -- seq )"
HELP: uses
{ $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
HELP: crossref
{ $description "Variable. A graph whose vertices are words and edges are usages. See " { $link "graphs" } "." }
{ $see-also usage xref-words } ;
HELP: xref-word "( word -- )"
HELP: xref-word
{ $values { "word" "a word" } }
{ $description "Adds a vertex representing this word, along with edges representing dependencies to the " { $link crossref } " graph." }
$low-level-note ;
HELP: usage "( word -- seq )"
HELP: usage
{ $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: unxref-word* "( word -- )"
HELP: unxref-word*
{ $values { "word" "a word" } }
{ $contract "Updates the word to cope with a callee being redefined." }
$low-level-note ;
HELP: unxref-word "( word -- )"
HELP: unxref-word
{ $values { "word" "a word" } }
{ $description "Remove the vertex representing the word from the " { $link crossref } " graph." }
$low-level-note ;
HELP: define "( word def primitive -- )"
HELP: define
{ $values { "word" "a word" } { "def" "an object" } { "primitive" "a non-negative integer" } }
{ $description "Defines a word and updates cross-referencing." }
$low-level-note
{ $see-also define-symbol define-compound } ;
HELP: define-symbol "( word -- )"
HELP: define-symbol
{ $values { "word" "a word" } }
{ $description "Defines the word to push itself on the stack when executed." } ;
HELP: intern-symbol "( word -- )"
HELP: intern-symbol
{ $values { "word" "a word" } }
{ $description "If the word is undefined, makes it into a symbol which pushes itself on the stack when executed. If the word already has a definition, does nothing." } ;
HELP: define-compound "( word def -- )"
HELP: define-compound
{ $values { "word" "a word" } { "def" "a quotation" } }
{ $description "Defines the word to call a quotation when executed." } ;
HELP: reset-word "( word -- )"
HELP: reset-word
{ $values { "word" "a word" } }
{ $description "Reset word declarations." }
$low-level-note ;
HELP: reset-generic "( word -- )"
HELP: reset-generic
{ $values { "word" "a word" } }
{ $description "Reset word declarations and generic word properties." }
$low-level-note ;
HELP: (word) "( name vocab -- word )"
HELP: (word) ( name vocab -- word )
{ $values { "name" "a string" } { "vocab" "a string" } { "word" "a word" } }
{ $description "Allocates an uninterned word with the specified name and vocabulary. User code should call " { $link gensym } " to create uninterned words and " { $link create } " to create interned words." }
{ $see-also <word> } ;
HELP: <word> "( name vocab -- word )"
HELP: <word>
{ $values { "name" "a string" } { "vocab" "a string" } { "word" "a word" } }
{ $description "Allocates an uninterned word with the specified name and vocabulary, and a blank word properties hashtable. User code should call " { $link gensym } " to create uninterned words and " { $link create } " to create interned words." } ;
HELP: gensym "( -- word )"
HELP: gensym
{ $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: define-temp "( quot -- word )"
HELP: define-temp
{ $values { "quot" "a quotation" } { "word" "a word" } }
{ $description "Creates an uninterned word that will call " { $snippet "quot" } " when executed." }
{ $notes
@ -159,7 +159,7 @@ HELP: define-temp "( quot -- word )"
{ $code "[ 2 2 + . ] define-temp execute" }
} ;
HELP: definer "( word -- definer )"
HELP: definer
{ $values { "word" "a word" } { "definer" "a word" } }
{ $description "Outputs the parsing word that defines the given word." }
{ $examples
@ -167,78 +167,78 @@ HELP: definer "( word -- definer )"
{ $example "SYMBOL: foo \\ foo definer ." "POSTPONE: SYMBOL:" }
} ;
HELP: bootstrapping? f
HELP: bootstrapping?
{ $description "Variable. Set by the library while bootstrap is in progress. Some parsing words need to behave differently during bootstrap." } ;
HELP: vocabularies f
HELP: vocabularies
{ $description "Variable. Holds a hashtable mapping vocabulary names to vocabularies." } ;
HELP: word "( -- word )"
HELP: word
{ $values { "word" "a word" } }
{ $description "Outputs the most recently defined word." }
{ $see-also save-location } ;
HELP: set-word "( -- word )"
HELP: set-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 )"
HELP: vocabs
{ $values { "word" "a sequence of strings" } }
{ $description "Outputs a sequence of all defined vocabulary names." } ;
HELP: vocab "( name -- vocab )"
HELP: 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 -- )"
HELP: ensure-vocab
{ $values { "name" "a string" } }
{ $description "Creates a vocabulary if it does not already exist." } ;
HELP: words "( vocab -- seq )"
HELP: words
{ $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 )"
HELP: all-words
{ $values { "seq" "a sequence of words" } }
{ $description "Outputs a sequence of all words in the dictionary." } ;
HELP: word-subset "( quot -- seq )"
HELP: word-subset
{ $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 "( -- )"
HELP: xref-words
{ $description "Update the " { $link crossref } " graph of word dependencies. Usually this is done automatically." } ;
HELP: lookup "( name vocab -- word )"
HELP: lookup
{ $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 -- )"
HELP: reveal
{ $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: check-create "( name vocab -- name vocab )"
HELP: check-create
{ $values { "name" "a string" } { "vocab" "a string" } }
{ $description "Throws a " { $link check-create } " error if " { $snippet "name" } " or " { $snippet "vocab" } " is not a string." }
{ $error-description "Thrown if " { $link create } " is called with invalid parameters." } ;
HELP: create "( name vocab -- word )"
HELP: create
{ $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 )"
HELP: constructor-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 "( word -- )"
HELP: forget-word
{ $values { "word" "a word" } }
{ $description "Removes a word from its vocabulary. The word becomes uninterned." }
{ $description "Removes a word from its vocabulary. User code should call " { $link forget } " instead, since it also does the right thing when forgetting class words." }
{ $see-also POSTPONE: FORGET: forget-vocab forget } ;
HELP: forget-vocab "( vocab -- )"
HELP: forget-vocab
{ $values { "vocab" "a string" } }
{ $description "Removes a vocabulary. All words in the vocabulary become uninterned." }
{ $see-also forget } ;
@ -247,18 +247,14 @@ 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 -- ? )"
HELP: interned?
{ $values { "word" "a word" } { "?" "a boolean" } }
{ $description "Test if the word is an interned word." } ;
HELP: bootstrap-word "( word -- target )"
HELP: bootstrap-word
{ $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." } ;
HELP: update-xt "( word -- )"
HELP: update-xt ( word -- )
{ $values { "word" "a word" } }
{ $description "Updates a word's execution token based on the value of the " { $link word-primitive } " slot. If the word was compiled, this will lose the compiled definition and make it run in the interpreter." } ;
HELP: stack-effect "( word -- str )"
{ $values { "word" "a word" } { "str" "a string" } }
{ $description "Outputs the stack effect of a word, as a stack picture string. The stack effect is taken from either online help, or a cached inferred effect." } ;