reverse the arguments of diff, assoc-diff

fix lots of usings
fix help-lint
db4
Doug Coleman 2008-04-26 02:01:06 -05:00
parent 714b0ebc94
commit e264537a1a
27 changed files with 46 additions and 35 deletions

View File

@ -281,7 +281,7 @@ HELP: assoc-union
HELP: assoc-diff HELP: assoc-diff
{ $values { "assoc1" assoc } { "assoc2" assoc } { "diff" "a new assoc" } } { $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 HELP: remove-all
{ $values { "assoc" assoc } { "seq" "a sequence" } { "subseq" "a new sequence" } } { $values { "assoc" assoc } { "seq" "a sequence" } { "subseq" "a new sequence" } }

View File

@ -120,7 +120,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
[ rot update ] keep [ swap update ] keep ; [ rot update ] keep [ swap update ] keep ;
: assoc-diff ( assoc1 assoc2 -- diff ) : assoc-diff ( assoc1 assoc2 -- diff )
swap [ nip key? not ] curry assoc-filter ; [ nip key? not ] curry assoc-filter ;
: remove-all ( assoc seq -- subseq ) : remove-all ( assoc seq -- subseq )
swap [ key? not ] curry filter ; swap [ key? not ] curry filter ;

View File

@ -305,7 +305,7 @@ M: float-array ' float-array emit-dummy-array ;
! Tuples ! Tuples
: (emit-tuple) ( tuple -- pointer ) : (emit-tuple) ( tuple -- pointer )
[ tuple>array 1 tail-slice ] [ tuple>array rest-slice ]
[ class transfer-word tuple-layout ] bi prefix [ ' ] map [ class transfer-word tuple-layout ] bi prefix [ ' ] map
tuple type-number dup [ emit-seq ] emit-object ; tuple type-number dup [ emit-seq ] emit-object ;

View File

@ -22,7 +22,7 @@ SYMBOL: bootstrap-time
xref-sources ; xref-sources ;
: load-components ( -- ) : load-components ( -- )
"exclude" "include" "include" "exclude"
[ get-global " " split [ empty? not ] filter ] bi@ [ get-global " " split [ empty? not ] filter ] bi@
diff diff
[ "bootstrap." prepend require ] each ; [ "bootstrap." prepend require ] each ;

View File

@ -55,7 +55,7 @@ HELP: class
{ $values { "object" object } { "class" 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." } { $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." } { $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 HELP: classes
{ $values { "seq" "a sequence of class words" } } { $values { "seq" "a sequence of class words" } }
@ -63,7 +63,7 @@ HELP: classes
HELP: tuple-class HELP: tuple-class
{ $class-description "The class of tuple class words." } { $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 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." } ; { $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." } ;

View File

@ -18,7 +18,7 @@ HELP: SINGLETON:
"Defines a new singleton class. The class word itself is the sole instance of the singleton class." "Defines a new singleton class. The class word itself is the sole instance of the singleton class."
} }
{ $examples { $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 HELP: define-singleton-class

View File

@ -341,6 +341,7 @@ HELP: new
{ $examples { $examples
{ $example { $example
"USING: kernel prettyprint ;" "USING: kernel prettyprint ;"
"IN: scratchpad"
"TUPLE: employee number name department ;" "TUPLE: employee number name department ;"
"employee new ." "employee new ."
"T{ employee f f f f }" "T{ employee f f f f }"

View File

@ -4,7 +4,7 @@ namespaces quotations sequences.private classes continuations
generic.standard effects classes.tuple classes.tuple.private generic.standard effects classes.tuple classes.tuple.private
arrays vectors strings compiler.units accessors classes.algebra arrays vectors strings compiler.units accessors classes.algebra
calendar prettyprint io.streams.string splitting inspector calendar prettyprint io.streams.string splitting inspector
columns ; columns math.order ;
IN: classes.tuple.tests IN: classes.tuple.tests
TUPLE: rect x y w h ; TUPLE: rect x y w h ;
@ -88,7 +88,7 @@ C: <empty> empty
[ t length ] [ object>> t eq? ] must-fail-with [ t length ] [ object>> t eq? ] must-fail-with
[ "<constructor-test>" ] [ "<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 ; TUPLE: size-test a b c d ;

View File

@ -79,7 +79,7 @@ IN: dlists.tests
[ dlist-push-all ] keep [ dlist-push-all ] keep
[ dlist-delete-all ] keep [ dlist-delete-all ] keep
dlist>array dlist>array
] 2keep diff assert-same-elements ] 2keep swap diff assert-same-elements
] unit-test ] unit-test
[ ] [ [ ] [

View File

@ -372,7 +372,7 @@ M: value (lazy-load)
: (compute-free-vregs) ( used class -- vector ) : (compute-free-vregs) ( used class -- vector )
#! Find all vregs in 'class' which are not in 'used'. #! Find all vregs in 'class' which are not in 'used'.
[ vregs length reverse ] keep [ vregs length reverse ] keep
[ <vreg> ] curry map diff [ <vreg> ] curry map swap diff
>vector ; >vector ;
: compute-free-vregs ( -- ) : compute-free-vregs ( -- )

View File

@ -17,8 +17,8 @@ C: <predicate-dispatch-engine> predicate-dispatch-engine
{ {
{ [ dup empty? ] [ drop [ "Unreachable" throw ] { } ] } { [ dup empty? ] [ drop [ "Unreachable" throw ] { } ] }
{ [ dup length 1 = ] [ first second { } ] } { [ dup length 1 = ] [ first second { } ] }
{ [ dup keep-going? ] [ 1 tail-slice prune-redundant-predicates ] } { [ dup keep-going? ] [ rest-slice prune-redundant-predicates ] }
[ [ first second ] [ 1 tail-slice ] bi ] [ [ first second ] [ rest-slice ] bi ]
} cond ; } cond ;
: sort-methods ( assoc -- assoc' ) : sort-methods ( assoc -- assoc' )

View File

@ -3,7 +3,7 @@
USING: arrays kernel math namespaces tools.test USING: arrays kernel math namespaces tools.test
heaps heaps.private math.parser random assocs sequences sorting heaps heaps.private math.parser random assocs sequences sorting
accessors ; accessors math.order ;
IN: heaps.tests IN: heaps.tests
[ <min-heap> heap-pop ] must-fail [ <min-heap> heap-pop ] must-fail

View File

@ -5,7 +5,7 @@ sequences words inference.class quotations alien
alien.c-types strings sbufs sequences.private alien.c-types strings sbufs sequences.private
slots.private combinators definitions compiler.units slots.private combinators definitions compiler.units
system layouts vectors optimizer.math.partial accessors 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 [ t ] [ T{ literal-constraint f 1 2 } T{ literal-constraint f 1 2 } equal? ] unit-test

View File

@ -92,7 +92,7 @@ ERROR: no-parent-directory path ;
: append-path-empty ( path1 path2 -- path' ) : append-path-empty ( path1 path2 -- path' )
{ {
{ [ dup head.? ] [ { [ dup head.? ] [
1 tail left-trim-separators append-path-empty rest left-trim-separators append-path-empty
] } ] }
{ [ dup head..? ] [ drop no-parent-directory ] } { [ dup head..? ] [ drop no-parent-directory ] }
[ nip ] [ nip ]
@ -122,7 +122,7 @@ PRIVATE>
{ [ over empty? ] [ append-path-empty ] } { [ over empty? ] [ append-path-empty ] }
{ [ dup empty? ] [ drop ] } { [ dup empty? ] [ drop ] }
{ [ dup absolute-path? ] [ nip ] } { [ dup absolute-path? ] [ nip ] }
{ [ dup head.? ] [ 1 tail left-trim-separators append-path ] } { [ dup head.? ] [ rest left-trim-separators append-path ] }
{ [ dup head..? ] [ { [ dup head..? ] [
2 tail left-trim-separators 2 tail left-trim-separators
>r parent-directory r> append-path >r parent-directory r> append-path

View File

@ -30,6 +30,7 @@ HELP: <mirror>
{ $examples { $examples
{ $example { $example
"USING: assocs mirrors prettyprint ;" "USING: assocs mirrors prettyprint ;"
"IN: scratchpad"
"TUPLE: circle center radius ;" "TUPLE: circle center radius ;"
"C: <circle> circle" "C: <circle> circle"
"{ 100 50 } 15 <circle> <mirror> >alist ." "{ 100 50 } 15 <circle> <mirror> >alist ."

View File

@ -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." } { $description "Adds " { $snippet "n" } " to the value of the variable. A variable value of " { $link f } " is interpreted as being zero." }
{ $side-effects "variable" } { $side-effects "variable" }
{ $examples { $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 HELP: inc

View File

@ -1,5 +1,5 @@
IN: namespaces.tests
USING: kernel namespaces tools.test words ; USING: kernel namespaces tools.test words ;
IN: namespaces.tests
H{ } clone "test-namespace" set H{ } clone "test-namespace" set

View File

@ -132,7 +132,7 @@ name>char-hook global [
"{" ?head-slice [ "{" ?head-slice [
CHAR: } over index cut-slice CHAR: } over index cut-slice
>r >string name>char-hook get call r> >r >string name>char-hook get call r>
1 tail-slice rest-slice
] [ ] [
6 cut-slice >r hex> r> 6 cut-slice >r hex> r>
] if ; ] if ;
@ -146,7 +146,7 @@ name>char-hook global [
: (parse-string) ( str -- m ) : (parse-string) ( str -- m )
dup [ "\"\\" member? ] find dup [ dup [ "\"\\" member? ] find dup [
>r cut-slice >r % r> 1 tail-slice r> >r cut-slice >r % r> rest-slice r>
dup CHAR: " = [ dup CHAR: " = [
drop slice-from drop slice-from
] [ ] [
@ -513,7 +513,7 @@ SYMBOL: interactive-vocabs
] if ; ] if ;
: filter-moved ( assoc1 assoc2 -- seq ) : filter-moved ( assoc1 assoc2 -- seq )
assoc-diff [ swap assoc-diff [
drop where dup [ first ] when drop where dup [ first ] when
file get source-file-path = file get source-file-path =
] assoc-filter keys ; ] assoc-filter keys ;

View File

@ -242,8 +242,16 @@ HELP: definer
{ $values { "defspec" "a definition specifier" } { "start" word } { "end" "a word or " { $link f } } } { $values { "defspec" "a definition specifier" } { "start" word } { "end" "a word or " { $link f } } }
{ $contract "Outputs the parsing words which delimit the definition." } { $contract "Outputs the parsing words which delimit the definition." }
{ $examples { $examples
{ $example "USING: definitions prettyprint ;" ": foo ; \\ foo definer . ." ";\nPOSTPONE: :" } { $example "USING: definitions prettyprint ;"
{ $example "USING: definitions prettyprint ;" "SYMBOL: foo \\ foo definer . ." "f\nPOSTPONE: SYMBOL:" } "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 } "." } ; { $notes "This word is used in the implementation of " { $link see } "." } ;

View File

@ -257,7 +257,7 @@ PRIVATE>
: tail ( seq n -- tailseq ) (tail) subseq ; : tail ( seq n -- tailseq ) (tail) subseq ;
: rest ( seq -- seq' ) 1 tail ; : rest ( seq -- tailseq ) 1 tail ;
: head* ( seq n -- headseq ) from-end head ; : head* ( seq n -- headseq ) from-end head ;

View File

@ -39,9 +39,9 @@ HELP: all-unique?
HELP: diff HELP: diff
{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } } { $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 } { $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 HELP: intersect

View File

@ -11,7 +11,7 @@ IN: sets.tests
[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test [ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test
[ { } ] [ { } { } diff ] 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{ } ] [ { } { } union ] unit-test
[ V{ 1 2 3 4 } ] [ { 1 2 3 } { 2 3 4 } union ] unit-test [ V{ 1 2 3 4 } ] [ { 1 2 3 } { 2 3 4 } union ] unit-test

View File

@ -25,7 +25,7 @@ IN: sets
unique [ key? ] curry filter ; unique [ key? ] curry filter ;
: diff ( seq1 seq2 -- newseq ) : diff ( seq1 seq2 -- newseq )
swap unique [ key? not ] curry filter ; unique [ key? not ] curry filter ;
: union ( seq1 seq2 -- newseq ) : union ( seq1 seq2 -- newseq )
append prune ; append prune ;

View File

@ -1,5 +1,5 @@
USING: sorting sequences kernel math random tools.test USING: sorting sequences kernel math math.order random
vectors ; tools.test vectors ;
IN: sorting.tests IN: sorting.tests
[ [ ] ] [ [ ] natural-sort ] unit-test [ [ ] ] [ [ ] natural-sort ] unit-test

View File

@ -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 strings.private sbufs tools.test sequences vectors arrays memory
prettyprint io.streams.null ; prettyprint io.streams.null ;
IN: strings.tests IN: strings.tests

View File

@ -190,7 +190,7 @@ HELP: delimiter
HELP: parsing HELP: parsing
{ $syntax ": foo ... ; parsing" } { $syntax ": foo ... ; parsing" }
{ $description "Declares the most recently defined word as a parsing word." } { $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 HELP: inline
{ $syntax ": foo ... ; inline" } { $syntax ": foo ... ; inline" }
@ -338,7 +338,7 @@ HELP: SYMBOL:
{ $syntax "SYMBOL: word" } { $syntax "SYMBOL: word" }
{ $values { "word" "a new word to define" } } { $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" } ")." } { $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 { define-symbol POSTPONE: SYMBOL: } related-words
@ -472,6 +472,7 @@ HELP: HOOK:
{ $examples { $examples
{ $example { $example
"USING: io namespaces ;" "USING: io namespaces ;"
"IN: scratchpad"
"SYMBOL: transport" "SYMBOL: transport"
"TUPLE: land-transport ;" "TUPLE: land-transport ;"
"TUPLE: air-transport ;" "TUPLE: air-transport ;"

View File

@ -197,7 +197,7 @@ HELP: execute ( word -- )
{ $values { "word" word } } { $values { "word" word } }
{ $description "Executes a word." } { $description "Executes a word." }
{ $examples { $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 ) HELP: word-props ( word -- props )