Merge remote-tracking branch 'origin/master' into modern-harvey3

basis/io/directories/windows/windows.factor

@@ -31,7 +31,7 @@ ERROR: file-delete-failed path error ;
 : (delete-file) ( path -- )
     dup DeleteFile 0 = [
         GetLastError ERROR_ACCESS_DENIED =
-        [ delete-read-only-file ] [ throw-win32-error ] if
+        [ delete-read-only-file ] [ drop win32-error ] if
     ] [ drop ] if ;
 
 M: windows delete-file ( path -- )

basis/io/files/info/info.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel system sequences combinators
+USING: accessors assocs combinators io.files io.files.types
-vocabs vocabs.loader io.files io.files.types math ;
+io.pathnames kernel math system vocabs ;
 IN: io.files.info
 
 ! File info
@@ -34,6 +34,22 @@ HOOK: file-readable? os ( path -- ? )
 HOOK: file-writable? os ( path -- ? )
 HOOK: file-executable? os ( path -- ? )
 
+HOOK: mount-points os ( -- assoc )
+
+M: object mount-points
+    file-systems [ [ mount-point>> ] keep ] H{ } map>assoc ;
+
+: (find-mount-point) ( path assoc -- object )
+    [ resolve-symlinks canonicalize-path-full ] dip
+    2dup at* [
+        2nip
+    ] [
+        drop [ parent-directory ] dip (find-mount-point)
+    ] if ;
+
+: find-mount-point ( path -- object )
+    mount-points (find-mount-point) ;
+
 {
     { [ os unix? ] [ "io.files.info.unix" ] }
     { [ os windows? ] [ "io.files.info.windows" ] }

basis/io/files/info/unix/linux/linux.factor

@@ -68,9 +68,15 @@ frequency pass-number ;
     char: \s [ "/etc/mtab" utf8 file>csv ] with-delimiter
     [ mtab-csv>mtab-entry ] map ;
 
+: (file-system-info) ( path -- file-system-info )
+    [ new-file-system-info ] dip
+    [ file-system-statfs statfs>file-system-info ]
+    [ file-system-statvfs statvfs>file-system-info ] bi
+    file-system-calculations ; inline
+
 : mtab-entry>file-system-info ( mtab-entry -- file-system-info/f )
     '[
-        _ [ mount-point>> file-system-info ] keep
+        _ [ mount-point>> (file-system-info) ] [ ] bi
         {
             [ file-system-name>> >>device-name ]
             [ mount-point>> >>mount-point ]
@@ -78,28 +84,14 @@ frequency pass-number ;
         } cleave
     ] [ { [ libc-error? ] [ errno>> EACCES = ] } 1&& ] ignore-error/f ;
 
+M: linux mount-points
+    parse-mtab [ [ mount-point>> ] keep ] H{ } map>assoc ;
+
 M: linux file-systems
     parse-mtab [ mtab-entry>file-system-info ] map sift ;
 
-: (find-mount-point) ( path mtab-paths -- mtab-entry )
-    2dup at* [
-        2nip
-    ] [
-        drop [ parent-directory ] dip (find-mount-point)
-    ] if ;
-
-: find-mount-point ( path -- mtab-entry )
-    resolve-symlinks
-    parse-mtab [ [ mount-point>> ] keep ] H{ } map>assoc (find-mount-point) ;
-
 M: linux file-system-info ( path -- file-system-info )
-    normalize-path
+    normalize-path [ (file-system-info) ] [ ] bi
-    [
-        [ new-file-system-info ] dip
-        [ file-system-statfs statfs>file-system-info ]
-        [ file-system-statvfs statvfs>file-system-info ] bi
-        file-system-calculations
-    ] keep
     find-mount-point
     {
         [ file-system-name>> >>device-name drop ]

basis/io/files/info/windows/windows.factor

@@ -1,4 +1,3 @@
-! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.c-types alien.data alien.strings ascii
 calendar classes.struct combinators combinators.short-circuit
@@ -19,7 +18,7 @@ TUPLE: windows-file-info < file-info-tuple attributes ;
 
 : get-compressed-file-size ( path -- n )
     { DWORD } [ GetCompressedFileSize ] with-out-parameters
-    over INVALID_FILE_SIZE = [ win32-error-string throw ] [ >64bit ] if ;
+    over INVALID_FILE_SIZE = [ win32-error ] when >64bit ;
 
 : set-windows-size-on-disk ( file-info path -- file-info )
     over attributes>> +compressed+ swap member? [

basis/io/files/temp/macosx/macosx.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2012 Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types alien.syntax cocoa.plists cocoa.runtime
-cocoa.types core-foundation.strings io.directories io.files
+cocoa.types core-foundation.strings io.files io.files.temp
-io.files.temp io.pathnames kernel sequences system ;
+io.pathnames kernel sequences system ;
 IN: io.files.temp.macosx
 
 <PRIVATE

basis/io/files/windows/windows.factor

@@ -1,12 +1,12 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types alien.data alien.strings
-alien.syntax arrays assocs classes.struct combinators
+alien.syntax arrays ascii assocs classes.struct combinators
 combinators.short-circuit continuations destructors environment io
 io.backend io.binary io.buffers io.files io.files.private
-io.files.types io.pathnames io.ports io.streams.c io.streams.null
+io.files.types io.pathnames io.pathnames.private io.ports io.streams.c
-io.timeouts kernel libc literals locals math math.bitwise namespaces
+io.streams.null io.timeouts kernel libc literals locals math math.bitwise
-sequences specialized-arrays system threads tr vectors windows
+namespaces sequences specialized-arrays system threads tr vectors windows
 windows.errors windows.handles windows.kernel32 windows.shell32
 windows.time windows.types windows.winsock splitting ;
 SPECIALIZED-ARRAY: ushort
@@ -117,7 +117,7 @@ M: windows init-io ( -- )
 : handle>file-size ( handle -- n/f )
     (handle>file-size) [
         GetLastError ERROR_INVALID_FUNCTION =
-        [ f ] [ throw-win32-error ] if
+        [ win32-error ] unless f
     ] unless* ;
 
 ERROR: seek-before-start n ;
@@ -346,6 +346,11 @@ PRIVATE>
 M: windows canonicalize-path
     remove-unicode-prefix canonicalize-path* ;
 
+M: windows canonicalize-drive
+    dup windows-absolute-path? [ ":" split1 [ >upper ] dip ":" glue ] when ;
+
+M: windows canonicalize-path-full canonicalize-path canonicalize-drive >windows-path ;
+
 M: windows root-path remove-unicode-prefix root-path* ;
 
 M: windows relative-path remove-unicode-prefix relative-path* ;
@@ -399,8 +404,8 @@ M: windows home
     WIN32_FIND_STREAM_DATA <struct>
     0
     [ FindFirstStream ] keepd
-    over -1 <alien> = [
+    over INVALID_HANDLE_VALUE = [
-        2drop throw-win32-error
+        2drop win32-error f
     ] [
         1vector swap file-streams-rest
     ] if ;

basis/io/mmap/unix/unix.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors destructors io.backend.unix io.mmap
-io.mmap.private kernel libc literals locals system unix
+io.mmap.private kernel libc literals locals system unix unix.ffi ;
-unix.ffi ;
 IN: io.mmap.unix
 
 :: mmap-open ( path length prot flags open-mode -- alien fd )

basis/io/ports/ports.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2010 Slava Pestov, Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien byte-arrays combinators destructors hints
+USING: accessors alien combinators destructors hints io
-io io.backend io.buffers io.encodings io.files io.timeouts
+io.backend io.buffers io.encodings io.files io.timeouts kernel
-kernel kernel.private libc locals math math.order math.private
+kernel.private libc locals math math.order math.private
 namespaces sequences strings system ;
 IN: io.ports
 

basis/io/sockets/secure/windows/windows.factor

@@ -14,7 +14,7 @@ M: openssl ssl-certificate-verification-supported? f ;
 
 : load-windows-cert-store ( string -- HCERTSTORE )
     [ f ] dip CertOpenSystemStore
-    [ win32-error-string throw ] when-zero ;
+    [ win32-error f ] when-zero ;
 
 : X509-NAME. ( X509_NAME -- )
     f 0 X509_NAME_oneline

basis/timers/timers.factor

@@ -29,11 +29,7 @@ M: duration >nanoseconds duration>nanoseconds >integer ;
     [ dupd [ mod ] [ swap - ] bi + + ] [ 2drop f ] if* ;
 
 : next-nanos ( timer -- timer n/f )
-    dup thread>> self eq? [
+    dup thread>> self eq? [ dup next-nanos>> ] [ f ] if ;
-        dup next-nanos>> dup t eq? [
-            drop dup delay-nanos [ >>next-nanos ] keep
-        ] when
-    ] [ f ] if ;
 
 : run-timer ( timer -- timer )
     dup interval-nanos >>next-nanos
@@ -65,7 +61,7 @@ ERROR: timer-already-started timer ;
 
 : start-timer ( timer -- )
     dup thread>> [ timer-already-started ] when
-    t >>next-nanos
+    dup delay-nanos >>next-nanos
     dup '[ _ timer-loop ] "Timer" <thread>
     [ >>thread drop ] [ (spawn) ] bi ;
 
@@ -74,7 +70,8 @@ ERROR: timer-already-started timer ;
 
 : restart-timer ( timer -- )
     dup thread>> [
-        t >>next-nanos [ thread>> ] [ ?interrupt ] bi
+        dup delay-nanos >>next-nanos
+        [ thread>> ] [ ?interrupt ] bi
     ] [
         start-timer
     ] if ;

basis/tools/deploy/deploy-tests.factor

@@ -34,7 +34,7 @@ delete-staging-images
 { } [ "sudoku" shake-and-bake 800000 small-enough? ] long-unit-test
 
 ! [ ] [ "hello-ui" shake-and-bake 1605000 small-enough? ] long-unit-test
-{ } [ "hello-ui" shake-and-bake 2762000 small-enough? ] long-unit-test
+{ } [ "hello-ui" shake-and-bake 2764000 small-enough? ] long-unit-test
 
 { "math-threads-compiler-io-ui" } [
     "hello-ui" deploy-config config>profile
@@ -42,24 +42,24 @@ delete-staging-images
 ] long-unit-test
 
 ! [ ] [ "maze" shake-and-bake 1520000 small-enough? ] long-unit-test
-{ } [ "maze" shake-and-bake 2800000 small-enough? ] long-unit-test
+{ } [ "maze" shake-and-bake 2801000 small-enough? ] long-unit-test
 
 ! [ ] [ "tetris" shake-and-bake 1734000 small-enough? ] long-unit-test
 { } [ "tetris" shake-and-bake 2850000 small-enough? ] long-unit-test
 
 ! [ ] [ "spheres" shake-and-bake 1557000 small-enough? ] long-unit-test
-{ } [ "spheres" shake-and-bake 2820000 small-enough? ] long-unit-test
+{ } [ "spheres" shake-and-bake 2850000 small-enough? ] long-unit-test
 
 ! [ ] [ "terrain" shake-and-bake 2053000 small-enough? ] long-unit-test
-{ } [ "terrain" shake-and-bake 2685300 small-enough? ] long-unit-test
+{ } [ "terrain" shake-and-bake 3385300 small-enough? ] long-unit-test
 
 ! [ ] [ "gpu.demos.raytrace" shake-and-bake 2764000 small-enough? ] long-unit-test
-{ } [ "gpu.demos.raytrace" shake-and-bake 3557800 small-enough? ] long-unit-test
+{ } [ "gpu.demos.raytrace" shake-and-bake 4157800 small-enough? ] long-unit-test
 
 ! { } [ "bunny" shake-and-bake 2559640 small-enough? ] long-unit-test
-{ } [ "bunny" shake-and-bake 2700000 small-enough? ] long-unit-test
+{ } [ "bunny" shake-and-bake 3400000 small-enough? ] long-unit-test
 
-{ } [ "gpu.demos.bunny" shake-and-bake 3750000 small-enough? ] long-unit-test
+{ } [ "gpu.demos.bunny" shake-and-bake 4200000 small-enough? ] long-unit-test
 
 os macosx? [
     [ ] [ "webkit-demo" shake-and-bake 600000 small-enough? ] long-unit-test

basis/windows/errors/errors.factor

@@ -733,16 +733,6 @@ ERROR: windows-error n string ;
 : win32-error<0 ( n -- ) 0 < [ win32-error ] when ;
 : win32-error<>0 ( n -- ) zero? [ win32-error ] unless ;
 
-: n>win32-error-check ( n -- )
-    dup ERROR_SUCCESS = [
-        drop
-    ] [
-        dup n>win32-error-string windows-error
-    ] if ;
-
-: throw-win32-error ( -- * )
-    win32-error-string throw ;
-
 : check-invalid-handle ( handle -- handle )
     dup INVALID_HANDLE_VALUE = [ throw-win32-error ] when ;
 

build.cmd

@@ -39,7 +39,7 @@ echo Deleting staging images from temp/...
 del temp\staging.*.image
 
 echo Updating working copy from %GIT_BRANCH%...
-call git pull git://factorcode.org/git/factor.git %GIT_BRANCH%
+call git pull https://github.com/factor/factor %GIT_BRANCH%
 if errorlevel 1 goto fail
 
 echo Building vm...

core/io/files/files.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2004, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.strings init io io.backend io.encodings io.pathnames
+USING: alien.strings init io io.backend io.encodings
-kernel kernel.private namespaces sequences splitting system ;
+io.pathnames kernel kernel.private namespaces sequences
+splitting system ;
 IN: io.files
 
 <PRIVATE
@@ -55,14 +56,14 @@ HOOK: (file-appender) io-backend ( path -- stream )
 : set-file-lines ( seq path encoding -- )
     [ [ print ] each ] with-file-writer ;
 
-: change-file-lines ( path encoding quot -- )
+: change-file-lines ( ..a path encoding quot: ( ..a seq -- ..b seq' ) -- ..b )
     [ [ file-lines ] dip call ]
     [ drop set-file-lines ] 3bi ; inline
 
 : set-file-contents ( seq path encoding -- )
     [ write ] with-file-writer ;
 
-: change-file-contents ( path encoding quot -- )
+: change-file-contents ( ..a path encoding quot: ( ..a seq -- ..b seq' ) -- ..b )
     [ [ file-contents ] dip call ]
     [ drop set-file-contents ] 3bi ; inline
 

core/io/pathnames/pathnames.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators io.backend kernel math math.order
+USING: accessors assocs combinators io.backend kernel math
-namespaces sequences splitting strings system ;
+math.order namespaces sequences splitting strings system ;
 IN: io.pathnames
 
 SYMBOL: current-directory
@@ -61,13 +61,13 @@ ERROR: no-parent-directory path ;
         [ nip ]
     } cond ;
 
-: windows-absolute-path? ( path -- path ? )
+: windows-absolute-path? ( path -- ? )
     {
         { [ dup "\\\\?\\" head? ] [ t ] }
         { [ dup length 2 < ] [ f ] }
         { [ dup second char: \: = ] [ t ] }
         [ f ]
-    } cond ;
+    } cond nip ;
 
 : special-path? ( path -- rest ? )
     {
@@ -80,12 +80,12 @@ PRIVATE>
 
 : absolute-path? ( path -- ? )
     {
-        { [ dup empty? ] [ f ] }
+        { [ dup empty? ] [ drop f ] }
-        { [ dup special-path? nip ] [ t ] }
+        { [ dup special-path? nip ] [ drop t ] }
         { [ os windows? ] [ windows-absolute-path? ] }
-        { [ dup first path-separator? ] [ t ] }
+        { [ dup first path-separator? ] [ drop t ] }
-        [ f ]
+        [ drop f ]
-    } cond nip ;
+    } cond ;
 
 : append-relative-path ( path1 path2 -- path )
     [ trim-tail-separators ]
@@ -213,6 +213,16 @@ HOOK: canonicalize-path io-backend ( path -- path' )
 
 M: object canonicalize-path canonicalize-path* ;
 
+HOOK: canonicalize-drive io-backend ( path -- path' )
+
+M: object canonicalize-drive ;
+
+HOOK: canonicalize-path-full io-backend ( path -- path' )
+
+M: object canonicalize-path-full canonicalize-path canonicalize-drive ;
+
+: >windows-path ( path -- path' ) H{ { CHAR: / CHAR: \\ } } substitute ;
+
 TUPLE: pathname string ;
 
 C: <pathname> pathname

extra/bencode/bencode-tests.factor

@@ -1,4 +1,4 @@
-USING: bencode tools.test ;
+USING: bencode linked-assocs tools.test ;
 
 { "i42e" } [ 42 >bencode ] unit-test
 { "i0e" } [ 0 >bencode ] unit-test
@@ -8,6 +8,6 @@ USING: bencode tools.test ;
 
 { { "spam" 42 } } [ "l4:spami42ee" bencode> ] unit-test
 
-{ H{ { "bar" "spam" } { "foo" 42 } } } [
+{ LH{ { "bar" "spam" } { "foo" 42 } } } [
     "d3:bar4:spam3:fooi42ee" bencode>
 ] unit-test

extra/bencode/bencode.factor

@@ -1,6 +1,6 @@
-USING: arrays assocs combinators hashtables io
+USING: arrays assocs combinators io io.encodings.ascii
-io.encodings.ascii io.encodings.string io.streams.string kernel
+io.encodings.string io.streams.string kernel linked-assocs math
-math math.parser sequences strings ;
+math.parser sequences strings ;
 IN: bencode
 
 GENERIC: >bencode ( obj -- bencode )
@@ -18,10 +18,10 @@ M: assoc >bencode
     [ [ >bencode ] bi@ append ] { } assoc>map concat
     "d" "e" surround ;
 
-<PRIVATE
-
 DEFER: read-bencode
 
+<PRIVATE
+
 : read-integer ( -- obj )
     "e" read-until char: e assert= string>number ;
 
@@ -31,11 +31,13 @@ DEFER: read-bencode
 : read-dictionary ( -- obj )
     [
         read-bencode [ read-bencode 2array ] [ f ] if* dup
-    ] [ ] produce nip >hashtable ;
+    ] [ ] produce nip >linked-hash ;
 
 : read-string ( prefix -- obj )
     ":" read-until char: \: assert= swap prefix
-    string>number read ascii decode ;
+    string>number read "" like ;
+
+PRIVATE>
 
 : read-bencode ( -- obj )
     read1 {
@@ -46,7 +48,5 @@ DEFER: read-bencode
         [ read-string ]
     } case ;
 
-PRIVATE>
-
 : bencode> ( bencode -- obj )
     [ read-bencode ] with-string-reader ;

extra/game/loop/loop.factor

@@ -1,9 +1,8 @@
 ! Copyright (C) 2009 Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors timers alien.c-types calendar classes.struct
+USING: accessors calendar continuations destructors fry kernel
-continuations destructors fry kernel math math.order memory
+locals math math.order system timers ui ui.gadgets.worlds
-namespaces sequences system ui ui.gadgets.worlds vm
+vocabs.loader ;
-vocabs.loader arrays locals ;
 IN: game.loop
 
 TUPLE: game-loop
@@ -36,8 +35,9 @@ TUPLE: game-loop-error-state error game-loop ;
 <PRIVATE
 
 : last-tick-percent-offset ( loop -- float )
-    [ draw-timer>> iteration-start-nanos>> nano-count swap - ]
+    [ draw-timer>> next-nanos>> nano-count - ]
-    [ tick-interval-nanos>> ] bi /f 1.0 min ;
+    [ tick-interval-nanos>> ] bi /f 1.0 swap -
+    0.0 1.0 clamp ;
 
 GENERIC#: record-benchmarking 1 ( loop quot -- )
 

extra/gpu/demos/bunny/bunny.factor

@@ -104,7 +104,7 @@ UNIFORM-TUPLE: loading-uniforms
     V{ } clone swap (read-line-tokens) ;
 
 : each-line-tokens ( quot -- )
-    input-stream get [ stream-read-line-tokens ] curry each-morsel ; inline
+    [ input-stream get [ stream-read-line-tokens ] curry ] dip while* ; inline
 
 : (parse-bunny-model) ( vs is -- vs is )
     [

extra/llvm/ffi/ffi.factor

@@ -7,8 +7,8 @@ IN: llvm.ffi
 << "llvm" {
     { [ os linux? ] [ "LLVM-3.9" find-so ] }
     { [ os macosx? ] [ "/usr/local/opt/llvm/lib/libLLVM.dylib" ] }
-    [ drop ]
+    [ f ]
-} cond [ cdecl add-library ] when*
+} cond [ cdecl add-library ] [ drop ] if*
 >>
 
 LIBRARY: llvm

extra/mason/disk/disk.factor

@@ -1,26 +1,28 @@
-! Copyright (C) 2010 Slava Pestov.
+! Copyright (C) 2010 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors io.files.info io.pathnames kernel mason.config
+USING: accessors formatting io.files.info io.pathnames kernel
-math math.parser namespaces sequences ;
+mason.config math namespaces ;
 IN: mason.disk
 
-: gb ( -- n ) 30 2^ ; inline
+: Gi ( n -- gibibits ) 30 2^ * ; inline
 
 : sufficient-disk-space? ( -- ? )
-    ! We want at least 300Mb to be available before starting
+    current-directory get find-mount-point mount-point>>
-    ! a build.
+    file-system-info available-space>> 1 Gi > ;
-    "." file-system-info available-space>> gb > ;
 
 : check-disk-space ( -- )
     sufficient-disk-space? [
-        "Less than 1 Gb free disk space." throw
+        "Less than 1 Gi free disk space." throw
     ] unless ;
 
-: mb-str ( n -- string ) gb /i number>string ;
+: Gi-str ( n -- string ) 1 Gi /f ;
+
+: path>disk-usage ( path -- string )
+    find-mount-point mount-point>> file-system-info
+    [ used-space>> ] [ available-space>> ] [ total-space>> ] tri
+    2dup /f 100 *
+    [ [ Gi-str ] tri@ ] dip
+    "%0.2fGi used, %0.2fGi avail, %0.2fGi total, %0.2f%% free" sprintf ;
 
 : disk-usage ( -- string )
-    builds-dir get file-system-info
+    builds-dir get path>disk-usage ;
-    [ used-space>> ] [ total-space>> ] bi
-    [ [ mb-str ] bi@ " / " glue " Gb used" append ]
-    [ [ 100 * ] dip /i number>string "(" "%)" surround ] 2bi
-    " " glue ;

extra/tensors/tensor-slice/tensor-slice.factor

@@ -1,7 +1,12 @@
 USING: accessors kernel locals math math.order sequences ;
 IN: tensors.tensor-slice
 
-TUPLE: step-slice < slice { step integer read-only } ;
+TUPLE: step-slice
+    { from integer read-only initial: 0 }
+    { to integer read-only initial: 0 }
+    { seq read-only }
+    { step integer read-only } ;
+
 :: <step-slice> ( from to step seq -- step-slice )
     step zero? [ "can't be zero" throw ] when
     seq length :> len
@@ -17,10 +22,14 @@ TUPLE: step-slice < slice { step integer read-only } ;
     seq dup slice? [ collapse-slice ] when
     step step-slice boa ;
 
+M: step-slice virtual-exemplar seq>> ; inline
+
 M: step-slice virtual@
-    [ step>> * ] [ from>> + ] [ seq>> ] tri ;
+    [ step>> * ] [ from>> + ] [ seq>> ] tri ; inline
 
 M: step-slice length
     [ to>> ] [ from>> - ] [ step>> ] tri
     dup 0 < [ [ neg 0 max ] dip neg ] when /mod
-    zero? [ 1 + ] unless ;
+    zero? [ 1 + ] unless ; inline
+
+INSTANCE: step-slice virtual-sequence