reverse-slice ==> <reversed>
parent
a7be80d994
commit
307bc73f5e
|
@ -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" } ;
|
||||
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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? ;
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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." }
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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." } ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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* ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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. ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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* ;
|
||||
|
|
|
@ -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) ;
|
||||
|
|
Loading…
Reference in New Issue