GENERIC: shorten ( n seq -- )
M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ; inline
-
M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ; inline
: empty? ( seq -- ? ) length 0 = ; inline
<PRIVATE
+: move-unsafe ( to from seq -- )
+ 2over =
+ [ 3drop ] [ [ nth-unsafe swap ] [ set-nth-unsafe ] bi ] if ; inline
+
: (filter!) ( ... quot: ( ... elt -- ... ? ) store scan seq -- ... )
2dup length < [
- [ move ] 3keep
+ [ move-unsafe ] 3keep
[ nth-unsafe pick call [ 1 + ] when ] 2keep
[ 1 + ] dip
(filter!)
[ length 1 - ] keep
over 0 < [ bounds-error ] [ nth-unsafe ] if ; inline
+<PRIVATE
+
+: last-unsafe ( seq -- elt ) [ length 1 - ] [ nth-unsafe ] bi ;
+
+PRIVATE>
+
: set-last ( elt seq -- )
[ length 1 - ] keep
over 0 < [ bounds-error ] [ set-nth-unsafe ] if ; inline
2over = [
2drop 2drop
] [
- [ [ 2over + pick ] dip move [ 1 + ] dip ] keep
+ [ [ 2over + pick ] dip move-unsafe [ 1 + ] dip ] keep
move-backward
] if ;
2over = [
2drop 2drop
] [
- [ [ pick [ dup dup ] dip + swap ] dip move 1 - ] keep
+ [ [ pick [ dup dup ] dip + swap ] dip move-unsafe 1 - ] keep
move-forward
] if ;
[ [ { } ] dip dup 1 + ] dip replace-slice ;
: pop ( seq -- elt )
- [ length 1 - ] [ [ nth ] [ shorten ] 2bi ] bi ;
+ [ length 1 - ] keep over 0 >=
+ [ [ nth-unsafe ] [ shorten ] 2bi ]
+ [ bounds-error ] if ;
: exchange ( m n seq -- )
[ nip bounds-check 2drop ]
[ rest ] [ first-unsafe ] bi ;
: unclip-last ( seq -- butlast last )
- [ but-last ] [ last ] bi ;
+ [ but-last ] [ last-unsafe ] bi ;
: unclip-slice ( seq -- rest-slice first )
[ rest-slice ] [ first-unsafe ] bi ; inline
[ find-last ] (map-find) ; inline
: unclip-last-slice ( seq -- butlast-slice last )
- [ but-last-slice ] [ last ] bi ; inline
+ [ but-last-slice ] [ last-unsafe ] bi ; inline
<PRIVATE