parent
714b0ebc94
commit
e264537a1a
|
@ -281,7 +281,7 @@ HELP: assoc-union
|
|||
|
||||
HELP: assoc-diff
|
||||
{ $values { "assoc1" assoc } { "assoc2" assoc } { "diff" "a new assoc" } }
|
||||
{ $description "Outputs an assoc consisting of all entries from " { $snippet "assoc2" } " whose key is not contained in " { $snippet "assoc1" } "." }
|
||||
{ $description "Outputs an assoc consisting of all entries from " { $snippet "assoc1" } " whose key is not contained in " { $snippet "assoc2" } "." }
|
||||
;
|
||||
HELP: remove-all
|
||||
{ $values { "assoc" assoc } { "seq" "a sequence" } { "subseq" "a new sequence" } }
|
||||
|
|
|
@ -120,7 +120,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
|
|||
[ rot update ] keep [ swap update ] keep ;
|
||||
|
||||
: assoc-diff ( assoc1 assoc2 -- diff )
|
||||
swap [ nip key? not ] curry assoc-filter ;
|
||||
[ nip key? not ] curry assoc-filter ;
|
||||
|
||||
: remove-all ( assoc seq -- subseq )
|
||||
swap [ key? not ] curry filter ;
|
||||
|
|
|
@ -305,7 +305,7 @@ M: float-array ' float-array emit-dummy-array ;
|
|||
|
||||
! Tuples
|
||||
: (emit-tuple) ( tuple -- pointer )
|
||||
[ tuple>array 1 tail-slice ]
|
||||
[ tuple>array rest-slice ]
|
||||
[ class transfer-word tuple-layout ] bi prefix [ ' ] map
|
||||
tuple type-number dup [ emit-seq ] emit-object ;
|
||||
|
||||
|
|
|
@ -22,7 +22,7 @@ SYMBOL: bootstrap-time
|
|||
xref-sources ;
|
||||
|
||||
: load-components ( -- )
|
||||
"exclude" "include"
|
||||
"include" "exclude"
|
||||
[ get-global " " split [ empty? not ] filter ] bi@
|
||||
diff
|
||||
[ "bootstrap." prepend require ] each ;
|
||||
|
|
|
@ -55,7 +55,7 @@ HELP: class
|
|||
{ $values { "object" object } { "class" class } }
|
||||
{ $description "Outputs an object's canonical class. While an object may be an instance of more than one class, the canonical class is either its built-in class, or if the object is a tuple, its tuple class." }
|
||||
{ $class-description "The class of all class words." }
|
||||
{ $examples { $example "USING: classes prettyprint ;" "1.0 class ." "float" } { $example "USING: classes prettyprint ;" "TUPLE: point x y z ;\nT{ point f 1 2 3 } class ." "point" } } ;
|
||||
{ $examples { $example "USING: classes prettyprint ;" "1.0 class ." "float" } { $example "USING: classes prettyprint ;" "IN: scratchpad" "TUPLE: point x y z ;\nT{ point f 1 2 3 } class ." "point" } } ;
|
||||
|
||||
HELP: classes
|
||||
{ $values { "seq" "a sequence of class words" } }
|
||||
|
@ -63,7 +63,7 @@ HELP: classes
|
|||
|
||||
HELP: tuple-class
|
||||
{ $class-description "The class of tuple class words." }
|
||||
{ $examples { $example "USING: classes prettyprint ;" "TUPLE: name title first last ;" "name tuple-class? ." "t" } } ;
|
||||
{ $examples { $example "USING: classes prettyprint ;" "IN: scratchpad" "TUPLE: name title first last ;" "name tuple-class? ." "t" } } ;
|
||||
|
||||
HELP: update-map
|
||||
{ $var-description "Hashtable mapping each class to a set of classes defined in terms of this class. The " { $link define-class } " word uses this information to update generic words when classes are redefined." } ;
|
||||
|
|
|
@ -18,7 +18,7 @@ HELP: SINGLETON:
|
|||
"Defines a new singleton class. The class word itself is the sole instance of the singleton class."
|
||||
}
|
||||
{ $examples
|
||||
{ $example "USING: classes.singleton kernel io ;" "SINGLETON: foo\nGENERIC: bar ( obj -- )\nM: foo bar drop \"a foo!\" print ;\nfoo bar" "a foo!" }
|
||||
{ $example "USING: classes.singleton kernel io ;" "IN: scratchpad" "SINGLETON: foo\nGENERIC: bar ( obj -- )\nM: foo bar drop \"a foo!\" print ;\nfoo bar" "a foo!" }
|
||||
} ;
|
||||
|
||||
HELP: define-singleton-class
|
||||
|
|
|
@ -341,6 +341,7 @@ HELP: new
|
|||
{ $examples
|
||||
{ $example
|
||||
"USING: kernel prettyprint ;"
|
||||
"IN: scratchpad"
|
||||
"TUPLE: employee number name department ;"
|
||||
"employee new ."
|
||||
"T{ employee f f f f }"
|
||||
|
|
|
@ -4,7 +4,7 @@ namespaces quotations sequences.private classes continuations
|
|||
generic.standard effects classes.tuple classes.tuple.private
|
||||
arrays vectors strings compiler.units accessors classes.algebra
|
||||
calendar prettyprint io.streams.string splitting inspector
|
||||
columns ;
|
||||
columns math.order ;
|
||||
IN: classes.tuple.tests
|
||||
|
||||
TUPLE: rect x y w h ;
|
||||
|
@ -88,7 +88,7 @@ C: <empty> empty
|
|||
[ t length ] [ object>> t eq? ] must-fail-with
|
||||
|
||||
[ "<constructor-test>" ]
|
||||
[ "TUPLE: constructor-test ; C: <constructor-test> constructor-test" eval word word-name ] unit-test
|
||||
[ "IN: classes.tuple.test TUPLE: constructor-test ; C: <constructor-test> constructor-test" eval word word-name ] unit-test
|
||||
|
||||
TUPLE: size-test a b c d ;
|
||||
|
||||
|
|
|
@ -79,7 +79,7 @@ IN: dlists.tests
|
|||
[ dlist-push-all ] keep
|
||||
[ dlist-delete-all ] keep
|
||||
dlist>array
|
||||
] 2keep diff assert-same-elements
|
||||
] 2keep swap diff assert-same-elements
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
|
@ -372,7 +372,7 @@ M: value (lazy-load)
|
|||
: (compute-free-vregs) ( used class -- vector )
|
||||
#! Find all vregs in 'class' which are not in 'used'.
|
||||
[ vregs length reverse ] keep
|
||||
[ <vreg> ] curry map diff
|
||||
[ <vreg> ] curry map swap diff
|
||||
>vector ;
|
||||
|
||||
: compute-free-vregs ( -- )
|
||||
|
|
|
@ -17,8 +17,8 @@ C: <predicate-dispatch-engine> predicate-dispatch-engine
|
|||
{
|
||||
{ [ dup empty? ] [ drop [ "Unreachable" throw ] { } ] }
|
||||
{ [ dup length 1 = ] [ first second { } ] }
|
||||
{ [ dup keep-going? ] [ 1 tail-slice prune-redundant-predicates ] }
|
||||
[ [ first second ] [ 1 tail-slice ] bi ]
|
||||
{ [ dup keep-going? ] [ rest-slice prune-redundant-predicates ] }
|
||||
[ [ first second ] [ rest-slice ] bi ]
|
||||
} cond ;
|
||||
|
||||
: sort-methods ( assoc -- assoc' )
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
|
||||
USING: arrays kernel math namespaces tools.test
|
||||
heaps heaps.private math.parser random assocs sequences sorting
|
||||
accessors ;
|
||||
accessors math.order ;
|
||||
IN: heaps.tests
|
||||
|
||||
[ <min-heap> heap-pop ] must-fail
|
||||
|
|
|
@ -5,7 +5,7 @@ sequences words inference.class quotations alien
|
|||
alien.c-types strings sbufs sequences.private
|
||||
slots.private combinators definitions compiler.units
|
||||
system layouts vectors optimizer.math.partial accessors
|
||||
optimizer.inlining ;
|
||||
optimizer.inlining math.order ;
|
||||
|
||||
[ t ] [ T{ literal-constraint f 1 2 } T{ literal-constraint f 1 2 } equal? ] unit-test
|
||||
|
||||
|
|
|
@ -92,7 +92,7 @@ ERROR: no-parent-directory path ;
|
|||
: append-path-empty ( path1 path2 -- path' )
|
||||
{
|
||||
{ [ dup head.? ] [
|
||||
1 tail left-trim-separators append-path-empty
|
||||
rest left-trim-separators append-path-empty
|
||||
] }
|
||||
{ [ dup head..? ] [ drop no-parent-directory ] }
|
||||
[ nip ]
|
||||
|
@ -122,7 +122,7 @@ PRIVATE>
|
|||
{ [ over empty? ] [ append-path-empty ] }
|
||||
{ [ dup empty? ] [ drop ] }
|
||||
{ [ dup absolute-path? ] [ nip ] }
|
||||
{ [ dup head.? ] [ 1 tail left-trim-separators append-path ] }
|
||||
{ [ dup head.? ] [ rest left-trim-separators append-path ] }
|
||||
{ [ dup head..? ] [
|
||||
2 tail left-trim-separators
|
||||
>r parent-directory r> append-path
|
||||
|
|
|
@ -30,6 +30,7 @@ HELP: <mirror>
|
|||
{ $examples
|
||||
{ $example
|
||||
"USING: assocs mirrors prettyprint ;"
|
||||
"IN: scratchpad"
|
||||
"TUPLE: circle center radius ;"
|
||||
"C: <circle> circle"
|
||||
"{ 100 50 } 15 <circle> <mirror> >alist ."
|
||||
|
|
|
@ -87,7 +87,7 @@ HELP: +@
|
|||
{ $description "Adds " { $snippet "n" } " to the value of the variable. A variable value of " { $link f } " is interpreted as being zero." }
|
||||
{ $side-effects "variable" }
|
||||
{ $examples
|
||||
{ $example "USING: namespaces prettyprint ;" "SYMBOL: foo\n1 foo +@\n10 foo +@\nfoo get ." "11" }
|
||||
{ $example "USING: namespaces prettyprint ;" "IN: scratchpad" "SYMBOL: foo\n1 foo +@\n10 foo +@\nfoo get ." "11" }
|
||||
} ;
|
||||
|
||||
HELP: inc
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
IN: namespaces.tests
|
||||
USING: kernel namespaces tools.test words ;
|
||||
IN: namespaces.tests
|
||||
|
||||
H{ } clone "test-namespace" set
|
||||
|
||||
|
|
|
@ -132,7 +132,7 @@ name>char-hook global [
|
|||
"{" ?head-slice [
|
||||
CHAR: } over index cut-slice
|
||||
>r >string name>char-hook get call r>
|
||||
1 tail-slice
|
||||
rest-slice
|
||||
] [
|
||||
6 cut-slice >r hex> r>
|
||||
] if ;
|
||||
|
@ -146,7 +146,7 @@ name>char-hook global [
|
|||
|
||||
: (parse-string) ( str -- m )
|
||||
dup [ "\"\\" member? ] find dup [
|
||||
>r cut-slice >r % r> 1 tail-slice r>
|
||||
>r cut-slice >r % r> rest-slice r>
|
||||
dup CHAR: " = [
|
||||
drop slice-from
|
||||
] [
|
||||
|
@ -513,7 +513,7 @@ SYMBOL: interactive-vocabs
|
|||
] if ;
|
||||
|
||||
: filter-moved ( assoc1 assoc2 -- seq )
|
||||
assoc-diff [
|
||||
swap assoc-diff [
|
||||
drop where dup [ first ] when
|
||||
file get source-file-path =
|
||||
] assoc-filter keys ;
|
||||
|
|
|
@ -242,8 +242,16 @@ HELP: definer
|
|||
{ $values { "defspec" "a definition specifier" } { "start" word } { "end" "a word or " { $link f } } }
|
||||
{ $contract "Outputs the parsing words which delimit the definition." }
|
||||
{ $examples
|
||||
{ $example "USING: definitions prettyprint ;" ": foo ; \\ foo definer . ." ";\nPOSTPONE: :" }
|
||||
{ $example "USING: definitions prettyprint ;" "SYMBOL: foo \\ foo definer . ." "f\nPOSTPONE: SYMBOL:" }
|
||||
{ $example "USING: definitions prettyprint ;"
|
||||
"IN: scratchpad"
|
||||
": foo ; \\ foo definer . ."
|
||||
";\nPOSTPONE: :"
|
||||
}
|
||||
{ $example "USING: definitions prettyprint ;"
|
||||
"IN: scratchpad"
|
||||
"SYMBOL: foo \\ foo definer . ."
|
||||
"f\nPOSTPONE: SYMBOL:"
|
||||
}
|
||||
}
|
||||
{ $notes "This word is used in the implementation of " { $link see } "." } ;
|
||||
|
||||
|
|
|
@ -257,7 +257,7 @@ PRIVATE>
|
|||
|
||||
: tail ( seq n -- tailseq ) (tail) subseq ;
|
||||
|
||||
: rest ( seq -- seq' ) 1 tail ;
|
||||
: rest ( seq -- tailseq ) 1 tail ;
|
||||
|
||||
: head* ( seq n -- headseq ) from-end head ;
|
||||
|
||||
|
|
|
@ -39,9 +39,9 @@ HELP: all-unique?
|
|||
|
||||
HELP: diff
|
||||
{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } }
|
||||
{ $description "Outputs a sequence consisting of elements present in " { $snippet "seq2" } " but not " { $snippet "seq1" } ", comparing elements for equality."
|
||||
{ $description "Outputs a sequence consisting of elements present in " { $snippet "seq1" } " but not " { $snippet "seq2" } ", comparing elements for equality."
|
||||
} { $examples
|
||||
{ $example "USING: sets prettyprint ;" "{ 1 2 3 } { 2 3 4 } diff ." "{ 4 }" }
|
||||
{ $example "USING: sets prettyprint ;" "{ 1 2 3 } { 2 3 4 } diff ." "{ 1 }" }
|
||||
} ;
|
||||
|
||||
HELP: intersect
|
||||
|
|
|
@ -11,7 +11,7 @@ IN: sets.tests
|
|||
[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test
|
||||
|
||||
[ { } ] [ { } { } diff ] unit-test
|
||||
[ { 4 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test
|
||||
[ { 1 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test
|
||||
|
||||
[ V{ } ] [ { } { } union ] unit-test
|
||||
[ V{ 1 2 3 4 } ] [ { 1 2 3 } { 2 3 4 } union ] unit-test
|
||||
|
|
|
@ -25,7 +25,7 @@ IN: sets
|
|||
unique [ key? ] curry filter ;
|
||||
|
||||
: diff ( seq1 seq2 -- newseq )
|
||||
swap unique [ key? not ] curry filter ;
|
||||
unique [ key? not ] curry filter ;
|
||||
|
||||
: union ( seq1 seq2 -- newseq )
|
||||
append prune ;
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
USING: sorting sequences kernel math random tools.test
|
||||
vectors ;
|
||||
USING: sorting sequences kernel math math.order random
|
||||
tools.test vectors ;
|
||||
IN: sorting.tests
|
||||
|
||||
[ [ ] ] [ [ ] natural-sort ] unit-test
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
USING: continuations kernel math namespaces strings
|
||||
USING: continuations kernel math math.order namespaces strings
|
||||
strings.private sbufs tools.test sequences vectors arrays memory
|
||||
prettyprint io.streams.null ;
|
||||
IN: strings.tests
|
||||
|
|
|
@ -190,7 +190,7 @@ HELP: delimiter
|
|||
HELP: parsing
|
||||
{ $syntax ": foo ... ; parsing" }
|
||||
{ $description "Declares the most recently defined word as a parsing word." }
|
||||
{ $examples "In the below example, the " { $snippet "world" } " word is never called, however its body references a parsing word which executes immediately:" { $example "USE: io" "<< : hello \"Hello parser!\" print ; parsing >>\n: world hello ;" "Hello parser!" } } ;
|
||||
{ $examples "In the below example, the " { $snippet "world" } " word is never called, however its body references a parsing word which executes immediately:" { $example "USE: io" "IN: scratchpad" "<< : hello \"Hello parser!\" print ; parsing >>\n: world hello ;" "Hello parser!" } } ;
|
||||
|
||||
HELP: inline
|
||||
{ $syntax ": foo ... ; inline" }
|
||||
|
@ -338,7 +338,7 @@ HELP: SYMBOL:
|
|||
{ $syntax "SYMBOL: word" }
|
||||
{ $values { "word" "a new word to define" } }
|
||||
{ $description "Defines a new symbol word in the current vocabulary. Symbols push themselves on the stack when executed, and are used to identify variables (see " { $link "namespaces" } ") as well as for storing crufties in word properties (see " { $link "word-props" } ")." }
|
||||
{ $examples { $example "USE: prettyprint" "SYMBOL: foo\nfoo ." "foo" } } ;
|
||||
{ $examples { $example "USE: prettyprint" "IN: scratchpad" "SYMBOL: foo\nfoo ." "foo" } } ;
|
||||
|
||||
{ define-symbol POSTPONE: SYMBOL: } related-words
|
||||
|
||||
|
@ -472,6 +472,7 @@ HELP: HOOK:
|
|||
{ $examples
|
||||
{ $example
|
||||
"USING: io namespaces ;"
|
||||
"IN: scratchpad"
|
||||
"SYMBOL: transport"
|
||||
"TUPLE: land-transport ;"
|
||||
"TUPLE: air-transport ;"
|
||||
|
|
|
@ -197,7 +197,7 @@ HELP: execute ( word -- )
|
|||
{ $values { "word" word } }
|
||||
{ $description "Executes a word." }
|
||||
{ $examples
|
||||
{ $example "USING: kernel io words ;" ": twice dup execute execute ;\n: hello \"Hello\" print ;\n\\ hello twice" "Hello\nHello" }
|
||||
{ $example "USING: kernel io words ;" "IN: scratchpad" ": twice dup execute execute ;\n: hello \"Hello\" print ;\n\\ hello twice" "Hello\nHello" }
|
||||
} ;
|
||||
|
||||
HELP: word-props ( word -- props )
|
||||
|
|
Loading…
Reference in New Issue