reverse-slice ==> <reversed>

slava 2006-05-15 03:25:34 +00:00
parent a7be80d994
commit 307bc73f5e
22 changed files with 30 additions and 39 deletions

View File

@ -36,7 +36,7 @@ ARTICLE: "sequence-implementations" "Sequence implementations"
{ $subsection "sbufs" }
"Virtual sequences wrap an underlying sequence to present an alternative view of its elements:"
{ $subsection <slice> }
{ $subsection reverse-slice }
{ $subsection <reversed> }
"Integers support the sequence protocol:"
{ $subsection "sequences-integers" } ;

View File

@ -230,7 +230,7 @@ M: complex ' ( c -- tagged ) >rect complex-tag emit-cons ;
( Strings )
: emit-chars ( seq -- )
big-endian get [ [ reverse-slice ] map ] unless
big-endian get [ [ <reversed> ] map ] unless
[ 0 [ swap 16 shift + ] reduce emit ] each ;
: pack-string ( string -- seq )

View File

@ -61,11 +61,6 @@ M: general-list map ( list quot -- list ) (list-map) ;
M: general-list find ( list quot -- i elt )
0 (list-find) ;
M: general-list reverse-slice ( list -- list )
[ ] [ swons ] reduce ;
M: general-list reverse reverse-slice ;
M: general-list nth ( n list -- element )
over 0 <= [ nip car ] [ >r 1- r> cdr nth ] if ;

View File

@ -103,10 +103,6 @@ M: object like drop ;
: pop ( sequence -- element )
dup peek swap pop* ;
M: object reverse-slice ( seq -- seq ) <reversed> ;
M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
: all-equal? ( seq -- ? ) [ = ] monotonic? ;
: all-eq? ( seq -- ? ) [ eq? ] monotonic? ;

View File

@ -9,8 +9,6 @@ GENERIC: nth ( n sequence -- obj ) flushable
GENERIC: set-nth ( value n sequence -- obj )
GENERIC: thaw ( seq -- mutable-seq ) flushable
GENERIC: like ( seq seq -- seq ) flushable
GENERIC: reverse ( seq -- seq ) flushable
GENERIC: reverse-slice ( seq -- seq ) flushable
: empty? ( seq -- ? ) length zero? ; inline

View File

@ -44,14 +44,6 @@ HELP: like "( seq prototype -- newseq )"
$terpri
"This generic word is flushable, so user-defined methods must satisfy the flushable contract (see " { $link "declarations" } ")." } ;
HELP: reverse "( seq -- reversed )"
{ $values { "seq" "a sequence" } { "reversed" "a sequence" } }
{ $description "Outputs a new sequence with the reverse element order." } ;
HELP: reverse-slice "( seq -- reversed )"
{ $values { "seq" "a sequence" } { "reversed" "a sequence" } }
{ $description "Outputs a virtual sequence sharing storage with " { $snippet "seq" } " but with reverse element order." } ;
HELP: peek "( seq -- elt )"
{ $values { "seq" "a sequence" } { "elt" "an object" } }
{ $description "Outputs the last element of the sequence." }

View File

@ -23,6 +23,8 @@ M: reversed like ( seq reversed -- seq ) delegate like ;
M: reversed thaw ( seq -- seq ) delegate thaw ;
: reverse ( seq -- seq ) [ <reversed> ] keep like ;
! A slice of another sequence.
TUPLE: slice seq from to ;

View File

@ -4,3 +4,11 @@ HELP: <slice> "( m n seq -- slice )"
{ $values { "m" "a non-negative integer" } { "n" "a non-negative integer" } { "seq" "a sequence" } { "slice" "a slice" } }
{ $description "Outputs a new virtual sequence sharing storage with the subrange of elements in " { $snippet "seq" } " with indices starting from and including " { $snippet "m" } ", and up to but not including " { $snippet "n" } "." }
{ $errors "Throws an error if " { $snippet "m" } " or " { $snippet "n" } " is out of bounds." } ;
HELP: reverse "( seq -- reversed )"
{ $values { "seq" "a sequence" } { "reversed" "a sequence" } }
{ $description "Outputs a new sequence with the reverse element order." } ;
HELP: <reversed> "( seq -- reversed )"
{ $values { "seq" "a sequence" } { "reversed" "a sequence" } }
{ $description "Outputs a virtual sequence sharing storage with " { $snippet "seq" } " but with reverse element order." } ;

View File

@ -42,7 +42,7 @@ kernel-internals math namespaces sequences words ;
: reverse-each-parameter ( parameters quot -- )
>r [ parameter-sizes ] keep
[ reverse-slice ] 2apply r> 2each ; inline
[ <reversed> ] 2apply r> 2each ; inline
: reset-freg-counts ( -- )
0 { int-regs float-regs stack-params } [ set ] each-with ;

View File

@ -77,7 +77,7 @@ M: phantom-callstack finalize-height
: phantom-locs ( n phantom -- locs )
#! A sequence of n ds-locs or cs-locs indexing the stack.
swap reverse-slice [ swap <loc> ] map-with ;
swap <reversed> [ swap <loc> ] map-with ;
: phantom-locs* ( phantom -- locs )
dup length swap phantom-locs ;
@ -188,7 +188,7 @@ SYMBOL: phantom-r
} cond ;
: template-match? ( template phantom -- ? )
[ reverse-slice ] 2apply
[ <reversed> ] 2apply
t [ swap first compatible-values? and ] 2reduce ;
: split-template ( template phantom -- slow fast )

View File

@ -53,7 +53,7 @@ sequences strings vectors words prettyprint ;
\ cond [ [ object ] [ ] ] "infer-effect" set-word-prop
\ cond [
pop-literal reverse-slice
pop-literal <reversed>
[ no-cond ] swap alist>quot infer-quot-value
] "infer" set-word-prop

View File

@ -10,7 +10,7 @@ kernel-internals math namespaces sequences words ;
node-classes ?hash [ object ] unless* ;
: node-class# ( node n -- class )
swap [ node-in-d reverse-slice ?nth ] keep node-class ;
swap [ node-in-d <reversed> ?nth ] keep node-class ;
! Variables used by the class inferencer

View File

@ -27,7 +27,7 @@ namespaces sequences vectors words ;
: specialized-def ( word -- quot )
dup word-def swap "specializer" word-prop [
reverse-slice { dup over pick } [
<reversed> { dup over pick } [
make-specializer
] 2each
] when* ;

View File

@ -26,7 +26,7 @@ M: cs-loc v>operand cs-loc-n cs-reg reg-stack ;
2dup dlsym CALL rel-relative rel-dlsym ;
: compile-c-call* ( symbol dll args -- operands )
reverse-slice
<reversed>
[ [ PUSH ] each %alien-invoke ] keep
[ drop EDX POP ] each ;

View File

@ -64,7 +64,7 @@ PREDICATE: word tuple-class "tuple-size" word-prop ;
: default-constructor ( tuple -- )
[ create-constructor ] keep dup [
"slots" word-prop 1 swap tail-slice reverse-slice
"slots" word-prop 1 swap tail-slice <reversed>
[ peek unit , \ keep , ] each
] [ ] make define-constructor ;

View File

@ -4,7 +4,7 @@ IN: io
USING: kernel lists math sequences strings ;
: be> ( seq -- x ) 0 [ >r 8 shift r> bitor ] reduce ;
: le> ( seq -- x ) reverse-slice be> ;
: le> ( seq -- x ) <reversed> be> ;
: nth-byte ( x n -- b ) -8 * shift HEX: ff bitand ;

View File

@ -207,6 +207,6 @@ unit-test
[ { } ] [ 0 { } group ] unit-test
! Pathological case
[ "ihbye" ] [ "hi" reverse-slice "bye" append ] unit-test
[ "ihbye" ] [ "hi" <reversed> "bye" append ] unit-test
[ 10 "hi" "bye" copy-into ] unit-test-fails

View File

@ -75,7 +75,7 @@ M: word summary ( word -- )
: format-sheet ( sheet -- list )
#! We use an idiom to notify format-column if it is
#! formatting the last column.
dup length reverse-slice [ zero? format-column ] 2map
dup length <reversed> [ zero? format-column ] 2map
flip [ " " join ] map ;
DEFER: describe
@ -105,7 +105,7 @@ DEFER: describe
: uses. ( word -- ) uses [ uses. ] sequence-outliner ;
: stack. ( seq -- seq ) reverse-slice >array describe ;
: stack. ( seq -- seq ) <reversed> >array describe ;
: .s datastack stack. ;
: .r retainstack stack. ;

View File

@ -73,7 +73,7 @@ M: gadget children-on ( rect/point gadget -- list )
[ >absolute intersects? ] [ 2drop f ] if ;
: pick-up-list ( rect/point gadget -- gadget/f )
dupd children-on reverse-slice [ inside? ] find-with nip ;
dupd children-on <reversed> [ inside? ] find-with nip ;
: translate ( rect/point -- new-origin )
rect-loc origin [ v+ dup ] change ;

View File

@ -81,13 +81,13 @@ V{ } clone hand-buttons set-global
[ handle-gesture* drop ] each-with ;
: hand-gestures ( new old -- )
drop-prefix reverse-slice
drop-prefix <reversed>
[ mouse-leave ] swap each-gesture
fire-motion
[ mouse-enter ] swap each-gesture ;
: focus-gestures ( new old -- )
drop-prefix reverse-slice
drop-prefix <reversed>
[ lose-focus ] swap each-gesture
[ gain-focus ] swap each-gesture ;
@ -124,7 +124,7 @@ V{ } clone hand-buttons set-global
: under-hand ( -- seq )
#! A sequence whose first element is the world and last is
#! the current gadget, with all parents in between.
hand-gadget get-global parents reverse-slice ;
hand-gadget get-global parents <reversed> ;
: move-hand ( loc world -- )
under-hand >r over hand-loc set-global

View File

@ -20,7 +20,7 @@ TUPLE: listener-gadget pane stack ;
dup empty? [
"Empty stack" write drop
] [
"Stack top: " write reverse-slice
"Stack top: " write <reversed>
[ [ unparse-short ] keep simple-object bl ] each bl
] if
] with-stream* ;

View File

@ -44,7 +44,7 @@ M: world pref-dim* ( world -- dim )
delegate pref-dim* { 1024 768 0 } vmin ;
: focused-ancestors ( world -- seq )
world-focus parents reverse-slice ;
world-focus parents <reversed> ;
: draw-string ( open-fonts string -- )
>r dup world get font-sprites r> (draw-string) ;