-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: cursors math tools.test make ;
+! (c)2010 Joe Groff bsd license
+USING: accessors cursors make math sequences sorting tools.test ;
+FROM: cursors => each map assoc-each assoc>map ;
IN: cursors.tests
-[ 2 t ] [ { 2 3 } [ even? ] find ] unit-test
-[ 3 t ] [ { 2 3 } [ odd? ] find ] unit-test
-[ f f ] [ { 2 4 } [ odd? ] find ] unit-test
+[ { 1 2 3 4 } ] [
+ [ T{ linear-cursor f 1 1 } T{ linear-cursor f 5 1 } [ value>> , ] -each ]
+ { } make
+] unit-test
-[ { 2 3 } ] [ { 1 2 } [ 1 + ] map ] unit-test
-[ { 2 3 } ] [ { 1 2 } [ [ 1 + , ] each ] { 2 3 } make ] unit-test
+[ { 1 3 } ] [
+ [ T{ linear-cursor f 1 2 } T{ linear-cursor f 5 2 } [ value>> , ] -each ]
+ { } make
+] unit-test
-[ t ] [ { } [ odd? ] all? ] unit-test
-[ t ] [ { 1 3 5 } [ odd? ] all? ] unit-test
-[ f ] [ { 1 3 5 6 } [ odd? ] all? ] unit-test
+[ B{ 1 2 3 4 5 } ] [ [ { 1 2 3 4 5 } [ , ] each ] B{ } make ] unit-test
+[ B{ } ] [ [ { } [ , ] each ] B{ } make ] unit-test
+[ { 2 4 6 8 10 } ] [ { 1 2 3 4 5 } [ 2 * ] map ] unit-test
-[ t ] [ { } [ odd? ] all? ] unit-test
-[ t ] [ { 1 3 5 } [ odd? ] any? ] unit-test
-[ f ] [ { 2 4 6 } [ odd? ] any? ] unit-test
+[ { "roses: lutefisk" "tulips: lox" } ]
+[
+ [
+ { { "roses" "lutefisk" } { "tulips" "lox" } }
+ [ ": " glue , ] assoc-each
+ ] { } make
+] unit-test
-[ { 1 3 5 } ] [ { 1 2 3 4 5 6 } [ odd? ] filter ] unit-test
+[ { "roses: lutefisk" "tulips: lox" } ]
+[
+ { { "roses" "lutefisk" } { "tulips" "lox" } }
+ [ ": " glue ] { } assoc>map
+] unit-test
-[ { } ]
-[ { 1 2 } { } [ + ] 2map ] unit-test
+[ { "roses: lutefisk" "tulips: lox" } ]
+[
+ [
+ H{ { "roses" "lutefisk" } { "tulips" "lox" } }
+ [ ": " glue , ] assoc-each
+ ] { } make natural-sort
+] unit-test
-[ { 11 } ]
-[ { 1 2 } { 10 } [ + ] 2map ] unit-test
+[ { "roses: lutefisk" "tulips: lox" } ]
+[
+ H{ { "roses" "lutefisk" } { "tulips" "lox" } }
+ [ ": " glue ] { } assoc>map natural-sort
+] unit-test
-[ { 11 22 } ]
-[ { 1 2 } { 10 20 } [ + ] 2map ] unit-test
+: compile-test-each ( xs -- )
+ [ , ] each ;
-[ { } ]
-[ { 1 2 } { } { } [ + + ] 3map ] unit-test
+: compile-test-map ( xs -- ys )
+ [ 2 * ] map ;
-[ { 111 } ]
-[ { 1 2 } { 10 } { 100 200 } [ + + ] 3map ] unit-test
+: compile-test-assoc-each ( xs -- )
+ [ ": " glue , ] assoc-each ;
-[ { 111 222 } ]
-[ { 1 2 } { 10 20 } { 100 200 } [ + + ] 3map ] unit-test
+: compile-test-assoc>map ( xs -- ys )
+ [ ": " glue ] { } assoc>map ;
-: test-3map ( -- seq )
- { 1 2 } { 10 20 } { 100 200 } [ + + ] 3map ;
+[ B{ 1 2 3 4 5 } ] [ [ { 1 2 3 4 5 } compile-test-each ] B{ } make ] unit-test
+[ { 2 4 6 8 10 } ] [ { 1 2 3 4 5 } compile-test-map ] unit-test
+
+[ { "roses: lutefisk" "tulips: lox" } ]
+[ [ { { "roses" "lutefisk" } { "tulips" "lox" } } compile-test-assoc-each ] { } make ] unit-test
+
+[ { "roses: lutefisk" "tulips: lox" } ]
+[ { { "roses" "lutefisk" } { "tulips" "lox" } } compile-test-assoc>map ] unit-test
-[ { 111 222 } ] [ test-3map ] unit-test
-! Copyright (C) 2009 Slava Pestov, Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays generalizations kernel math sequences
-sequences.private fry ;
+! (c)2010 Joe Groff bsd license
+USING: accessors assocs combinators.short-circuit fry hashtables
+kernel locals math math.functions sequences sequences.private ;
+FROM: hashtables.private => tombstone? ;
IN: cursors
-GENERIC: cursor-done? ( cursor -- ? )
-GENERIC: cursor-get-unsafe ( cursor -- obj )
-GENERIC: cursor-advance ( cursor -- )
+!
+! basic cursor protocol
+!
+
+MIXIN: cursor
+
+GENERIC: cursor-compatible? ( cursor cursor -- ? )
GENERIC: cursor-valid? ( cursor -- ? )
-GENERIC: cursor-write ( obj cursor -- )
+GENERIC: cursor= ( cursor cursor -- ? )
+GENERIC: cursor<= ( cursor cursor -- ? )
+GENERIC: cursor>= ( cursor cursor -- ? )
+GENERIC: cursor-distance-hint ( cursor cursor -- n )
+
+M: cursor cursor<= cursor= ; inline
+M: cursor cursor>= cursor= ; inline
+M: cursor cursor-distance-hint 2drop 0 ; inline
+
+!
+! cursor iteration
+!
+
+MIXIN: forward-cursor
+INSTANCE: forward-cursor cursor
+
+GENERIC: inc-cursor ( cursor -- cursor' )
+
+MIXIN: bidirectional-cursor
+INSTANCE: bidirectional-cursor forward-cursor
+
+GENERIC: dec-cursor ( cursor -- cursor' )
+
+MIXIN: random-access-cursor
+INSTANCE: random-access-cursor bidirectional-cursor
+
+GENERIC# cursor+ 1 ( cursor n -- cursor' )
+GENERIC# cursor- 1 ( cursor n -- cursor' )
+GENERIC: cursor-distance ( cursor cursor -- n )
+GENERIC: cursor< ( cursor cursor -- ? )
+GENERIC: cursor> ( cursor cursor -- ? )
+
+M: random-access-cursor inc-cursor 1 cursor+ ; inline
+M: random-access-cursor dec-cursor -1 cursor+ ; inline
+M: random-access-cursor cursor- neg cursor+ ; inline
+M: random-access-cursor cursor<= { [ cursor= ] [ cursor< ] } 2|| ; inline
+M: random-access-cursor cursor>= { [ cursor= ] [ cursor> ] } 2|| ; inline
+M: random-access-cursor cursor-distance-hint cursor-distance ; inline
+
+!
+! input cursors
+!
+
+ERROR: invalid-cursor cursor ;
+
+MIXIN: input-cursor
+
+GENERIC: cursor-value ( cursor -- value )
+<PRIVATE
+GENERIC: cursor-value-unsafe ( cursor -- value )
+PRIVATE>
+M: input-cursor cursor-value-unsafe cursor-value ; inline
+M: input-cursor cursor-value
+ dup cursor-valid? [ cursor-value-unsafe ] [ invalid-cursor ] if ; inline
+
+!
+! output cursors
+!
+
+MIXIN: output-cursor
+
+GENERIC: set-cursor-value ( value cursor -- )
+<PRIVATE
+GENERIC: set-cursor-value-unsafe ( value cursor -- )
+PRIVATE>
+M: output-cursor set-cursor-value-unsafe set-cursor-value ; inline
+M: output-cursor set-cursor-value
+ dup cursor-valid? [ set-cursor-value-unsafe ] [ invalid-cursor ] if ; inline
+
+!
+! basic iterator
+!
+
+: -each ( ... begin end quot: ( ... cursor -- ... ) -- ... )
+ [ '[ dup _ cursor>= ] ]
+ [ '[ _ keep inc-cursor ] ] bi* until drop ; inline
+
+!
+! numeric cursors
+!
+
+TUPLE: numeric-cursor
+ { value read-only } ;
+
+M: numeric-cursor cursor-valid? drop t ; inline
+
+M: numeric-cursor cursor= [ value>> ] bi@ = ; inline
+
+M: numeric-cursor cursor<= [ value>> ] bi@ <= ; inline
+M: numeric-cursor cursor< [ value>> ] bi@ < ; inline
+M: numeric-cursor cursor> [ value>> ] bi@ > ; inline
+M: numeric-cursor cursor>= [ value>> ] bi@ >= ; inline
+
+INSTANCE: numeric-cursor input-cursor
+
+M: numeric-cursor cursor-value value>> ; inline
+
+!
+! linear cursor
+!
+
+TUPLE: linear-cursor < numeric-cursor
+ { delta read-only } ;
+C: <linear-cursor> linear-cursor
+
+INSTANCE: linear-cursor random-access-cursor
+
+M: linear-cursor cursor-compatible?
+ [ linear-cursor? ] both? ; inline
+
+M: linear-cursor inc-cursor
+ [ value>> ] [ delta>> ] bi [ + ] keep <linear-cursor> ; inline
+M: linear-cursor dec-cursor
+ [ value>> ] [ delta>> ] bi [ - ] keep <linear-cursor> ; inline
+M: linear-cursor cursor+
+ [ [ value>> ] [ delta>> ] bi ] dip [ * + ] keep <linear-cursor> ; inline
+M: linear-cursor cursor-
+ [ [ value>> ] [ delta>> ] bi ] dip [ * - ] keep <linear-cursor> ; inline
+
+GENERIC: up/i ( distance delta -- distance' )
+M: integer up/i [ 1 - + ] keep /i ; inline
+M: real up/i / ceiling >integer ; inline
+
+M: linear-cursor cursor-distance
+ [ [ value>> ] bi@ - ] [ nip delta>> ] 2bi up/i ; inline
+
+!
+! quadratic cursor
+!
+
+TUPLE: quadratic-cursor < numeric-cursor
+ { delta read-only }
+ { delta2 read-only } ;
+
+C: <quadratic-cursor> quadratic-cursor
+
+INSTANCE: quadratic-cursor bidirectional-cursor
+
+M: quadratic-cursor cursor-compatible?
+ [ linear-cursor? ] both? ; inline
+
+M: quadratic-cursor inc-cursor
+ [ value>> ] [ delta>> [ + ] keep ] [ delta2>> [ + ] keep ] tri <quadratic-cursor> ; inline
+
+M: quadratic-cursor dec-cursor
+ [ value>> ] [ delta>> ] [ delta2>> ] tri [ - [ - ] keep ] keep <quadratic-cursor> ; inline
+
+!
+! collections
+!
+
+MIXIN: collection
+
+GENERIC: begin-cursor ( collection -- cursor )
+GENERIC: end-cursor ( collection -- cursor )
+
+: all- ( collection quot -- begin end quot )
+ [ [ begin-cursor ] [ end-cursor ] bi ] dip ; inline
+
+!
+! containers
+!
+
+MIXIN: container
+INSTANCE: container collection
+
+: -container- ( quot -- quot' )
+ '[ cursor-value-unsafe @ ] ; inline
+
+: container- ( container quot -- begin end quot' )
+ all- -container- ; inline
+
+: each ( ... container quot: ( ... x -- ... ) -- ... ) container- -each ; inline
+
+!
+! sequence cursor
+!
+
+TUPLE: sequence-cursor
+ { seq read-only }
+ { n fixnum read-only } ;
+C: <sequence-cursor> sequence-cursor
+
+INSTANCE: sequence container
+
+M: sequence begin-cursor 0 <sequence-cursor> ; inline
+M: sequence end-cursor dup length <sequence-cursor> ; inline
+
+INSTANCE: sequence-cursor random-access-cursor
+
+M: sequence-cursor cursor-compatible?
+ {
+ [ [ sequence-cursor? ] both? ]
+ [ [ seq>> ] bi@ eq? ]
+ } 2&& ; inline
+
+M: sequence-cursor cursor-valid?
+ [ n>> ] [ seq>> ] bi bounds-check? ; inline
+
+M: sequence-cursor cursor= [ n>> ] bi@ = ; inline
+M: sequence-cursor cursor<= [ n>> ] bi@ <= ; inline
+M: sequence-cursor cursor>= [ n>> ] bi@ >= ; inline
+M: sequence-cursor cursor< [ n>> ] bi@ < ; inline
+M: sequence-cursor cursor> [ n>> ] bi@ > ; inline
+M: sequence-cursor inc-cursor [ seq>> ] [ n>> ] bi 1 + <sequence-cursor> ; inline
+M: sequence-cursor dec-cursor [ seq>> ] [ n>> ] bi 1 - <sequence-cursor> ; inline
+M: sequence-cursor cursor+ [ [ seq>> ] [ n>> ] bi ] dip + <sequence-cursor> ; inline
+M: sequence-cursor cursor- [ [ seq>> ] [ n>> ] bi ] dip - <sequence-cursor> ; inline
+M: sequence-cursor cursor-distance ( cursor cursor -- n )
+ [ n>> ] bi@ - ; inline
+
+INSTANCE: sequence-cursor input-cursor
+
+M: sequence-cursor cursor-value-unsafe [ n>> ] [ seq>> ] bi nth-unsafe ; inline
+M: sequence-cursor cursor-value [ n>> ] [ seq>> ] bi nth ; inline
+
+INSTANCE: sequence-cursor output-cursor
+
+M: sequence-cursor set-cursor-value-unsafe [ n>> ] [ seq>> ] bi set-nth-unsafe ; inline
+M: sequence-cursor set-cursor-value [ n>> ] [ seq>> ] bi set-nth ; inline
+
+!
+! pipe cursor
+!
+
+TUPLE: pipe-cursor
+ { from read-only }
+ { to read-only } ;
+C: <pipe-cursor> pipe-cursor
-ERROR: cursor-ended cursor ;
+INSTANCE: pipe-cursor forward-cursor
-: cursor-get ( cursor -- obj )
- dup cursor-done?
- [ cursor-ended ] [ cursor-get-unsafe ] if ; inline
+M: pipe-cursor cursor-compatible? [ from>> ] bi@ cursor-compatible? ; inline
+M: pipe-cursor cursor-valid? [ from>> ] [ to>> ] bi [ cursor-valid? ] both? ; inline
+M: pipe-cursor cursor= [ from>> ] bi@ cursor= ; inline
+M: pipe-cursor inc-cursor [ from>> inc-cursor ] [ to>> inc-cursor ] bi <pipe-cursor> ; inline
-: find-done? ( cursor quot -- ? )
- over cursor-done?
- [ 2drop t ] [ [ cursor-get-unsafe ] dip call ] if ; inline
+INSTANCE: pipe-cursor output-cursor
-: cursor-until ( cursor quot -- )
- [ find-done? not ]
- [ drop cursor-advance ] bi-curry bi-curry while ; inline
-
-: cursor-each ( cursor quot -- )
- [ f ] compose cursor-until ; inline
+M: pipe-cursor set-cursor-value-unsafe to>> set-cursor-value-unsafe ; inline
+M: pipe-cursor set-cursor-value to>> set-cursor-value ; inline
-: cursor-find ( cursor quot -- obj ? )
- [ cursor-until ] [ drop ] 2bi
- dup cursor-done? [ drop f f ] [ cursor-get t ] if ; inline
+: -pipe- ( begin end quot to -- begin' end' quot' )
+ swap [ '[ _ <pipe-cursor> ] bi@ ] dip '[ from>> @ ] ; inline
-: cursor-any? ( cursor quot -- ? )
- cursor-find nip ; inline
+!
+! pusher cursor
+!
-: cursor-all? ( cursor quot -- ? )
- [ not ] compose cursor-any? not ; inline
+TUPLE: pusher-cursor
+ { growable read-only } ;
+C: <pusher-cursor> pusher-cursor
-: cursor-map-quot ( quot to -- quot' )
- [ [ call ] dip cursor-write ] 2curry ; inline
+INSTANCE: pusher-cursor forward-cursor
-: cursor-map ( from to quot -- )
- swap cursor-map-quot cursor-each ; inline
+! XXX define a protocol for stream cursors that don't actually move
+M: pusher-cursor cursor-compatible? 2drop f ; inline
+M: pusher-cursor cursor-valid? drop t ; inline
+M: pusher-cursor cursor= 2drop f ; inline
+M: pusher-cursor inc-cursor ; inline
-: cursor-write-if ( obj quot to -- )
- [ over [ call ] dip ] dip
- [ cursor-write ] 2curry when ; inline
+INSTANCE: pusher-cursor output-cursor
-: cursor-filter-quot ( quot to -- quot' )
- [ cursor-write-if ] 2curry ; inline
+M: pusher-cursor set-cursor-value growable>> push ; inline
-: cursor-filter ( from to quot -- )
- swap cursor-filter-quot cursor-each ; inline
+!
+! Create cursors into new sequences
+!
-TUPLE: from-sequence { seq sequence } { n integer } ;
+: new-growable-cursor ( begin end exemplar -- cursor result )
+ [ swap cursor-distance-hint ] dip new-resizable [ <pusher-cursor> ] keep ; inline
-: >from-sequence< ( from-sequence -- n seq )
- [ n>> ] [ seq>> ] bi ; inline
+GENERIC# new-sequence-cursor 1 ( begin end exemplar -- cursor result )
-M: from-sequence cursor-done? ( cursor -- ? )
- >from-sequence< length >= ;
+M: random-access-cursor new-sequence-cursor
+ [ swap cursor-distance ] dip new-sequence [ begin-cursor ] keep ; inline
+M: forward-cursor new-sequence-cursor
+ new-growable-cursor ; inline
-M: from-sequence cursor-valid?
- >from-sequence< bounds-check? not ;
+: -into-sequence- ( begin end quot exemplar -- begin' end' quot' result )
+ swap [ [ 2dup ] dip new-sequence-cursor ] dip swap [ swap -pipe- ] dip ; inline
-M: from-sequence cursor-get-unsafe
- >from-sequence< nth-unsafe ;
+: -into-growable- ( begin end quot exemplar -- begin' end' quot' result )
+ swap [ [ 2dup ] dip new-growable-cursor ] dip swap [ swap -pipe- ] dip ; inline
-M: from-sequence cursor-advance
- [ 1 + ] change-n drop ;
+!
+! map
+!
-: >input ( seq -- cursor )
- 0 from-sequence boa ; inline
+: -map- ( quot -- quot' )
+ '[ _ keep set-cursor-value-unsafe ] ; inline
-: iterate ( seq quot iterator -- )
- [ >input ] 2dip call ; inline
+: -map ( ... begin end quot: ( ... cursor -- ... value ) -- ... )
+ -map- -each ; inline
-: each ( seq quot -- ) [ cursor-each ] iterate ; inline
-: find ( seq quot -- ? ) [ cursor-find ] iterate ; inline
-: any? ( seq quot -- ? ) [ cursor-any? ] iterate ; inline
-: all? ( seq quot -- ? ) [ cursor-all? ] iterate ; inline
+! XXX generalize exemplar
+: -map-as ( ... begin end quot: ( ... cursor -- ... value ) exemplar -- ... newseq )
+ [ -into-sequence- [ -map ] dip ] keep like ; inline
-TUPLE: to-sequence { seq sequence } { exemplar sequence } ;
+: map! ( ... container quot: ( ... x -- ... newx ) -- ... container )
+ [ container- -map ] keep ; inline
+: map-as ( ... container quot: ( ... x -- ... newx ) exemplar -- ... newseq )
+ [ container- ] dip -map-as ; inline
+: map ( ... container quot: ( ... x -- ... newx ) -- ... newcontainer )
+ over map-as ; inline
-M: to-sequence cursor-write
- seq>> push ;
+!
+! assoc cursors
+!
-: freeze ( cursor -- seq )
- [ seq>> ] [ exemplar>> ] bi like ; inline
+MIXIN: assoc-cursor
-: >output ( seq -- cursor )
- [ [ length ] keep new-resizable ] keep
- to-sequence boa ; inline
+GENERIC: cursor-key-value ( cursor -- key value )
-: transform ( seq quot transformer -- newseq )
- [ [ >input ] [ >output ] bi ] 2dip
- [ call ]
- [ 2drop freeze ] 3bi ; inline
+: -assoc- ( quot -- quot' )
+ '[ cursor-key-value @ ] ; inline
-: map ( seq quot -- ) [ cursor-map ] transform ; inline
-: filter ( seq quot -- newseq ) [ cursor-filter ] transform ; inline
+: assoc- ( assoc quot -- begin end quot' )
+ all- -assoc- ; inline
-: find-done2? ( cursor cursor quot -- ? )
- 2over [ cursor-done? ] either?
- [ 3drop t ] [ [ [ cursor-get-unsafe ] bi@ ] dip call ] if ; inline
+: assoc-each ( ... assoc quot: ( ... k v -- ... ) -- ... )
+ assoc- -each ; inline
+: assoc>map ( ... assoc quot: ( ... k v -- ... newx ) exemplar -- ... newcontainer )
+ [ assoc- ] dip -map-as ; inline
-: cursor-until2 ( cursor cursor quot -- )
- [ find-done2? not ]
- [ drop [ cursor-advance ] bi@ ] bi-curry bi-curry bi-curry while ; inline
+INSTANCE: input-cursor assoc-cursor
-: cursor-each2 ( cursor cursor quot -- )
- [ f ] compose cursor-until2 ; inline
+M: input-cursor cursor-key-value
+ cursor-value first2 ; inline
-: cursor-map2 ( from to quot -- )
- swap cursor-map-quot cursor-each2 ; inline
+!
+! hashtable cursor
+!
-: iterate2 ( seq1 seq2 quot iterator -- )
- [ [ >input ] bi@ ] 2dip call ; inline
+TUPLE: hashtable-cursor
+ { hashtable hashtable read-only }
+ { n fixnum read-only } ;
+<PRIVATE
+C: <hashtable-cursor> hashtable-cursor
+PRIVATE>
-: transform2 ( seq1 seq2 quot transformer -- newseq )
- [ over >output [ [ >input ] [ >input ] bi* ] dip ] 2dip
- [ call ]
- [ 2drop nip freeze ] 4 nbi ; inline
+INSTANCE: hashtable-cursor forward-cursor
-: 2each ( seq1 seq2 quot -- ) [ cursor-each2 ] iterate2 ; inline
-: 2map ( seq1 seq2 quot -- ) [ cursor-map2 ] transform2 ; inline
+M: hashtable-cursor cursor-compatible?
+ {
+ [ [ hashtable-cursor? ] both? ]
+ [ [ hashtable>> ] bi@ eq? ]
+ } 2&& ; inline
-: find-done3? ( cursor1 cursor2 cursor3 quot -- ? )
- [ 3 ndrop t ] swap '[ [ cursor-get-unsafe ] tri@ @ ]
- [ 3 ndup 3 narray [ cursor-done? ] any? ] 2dip if ; inline
+M: hashtable-cursor cursor-valid? ( cursor -- ? )
+ [ n>> ] [ hashtable>> array>> ] bi bounds-check? ; inline
-: cursor-until3 ( cursor cursor quot -- )
- [ find-done3? not ]
- [ drop [ cursor-advance ] tri@ ]
- bi-curry bi-curry bi-curry bi-curry while ; inline
+M: hashtable-cursor cursor= ( cursor cursor -- ? )
+ [ n>> ] bi@ = ; inline
+M: hashtable-cursor cursor-distance-hint ( cursor cursor -- n )
+ nip hashtable>> assoc-size ; inline
-: cursor-each3 ( cursor cursor quot -- )
- [ f ] compose cursor-until3 ; inline
+<PRIVATE
+: (inc-hashtable-cursor) ( array n -- n' )
+ [ 2dup swap { [ length < ] [ nth-unsafe tombstone? ] } 2&& ] [ 2 + ] while nip ; inline
+PRIVATE>
-: cursor-map3 ( from to quot -- )
- swap cursor-map-quot cursor-each3 ; inline
+M: hashtable-cursor inc-cursor ( cursor -- cursor' )
+ [ hashtable>> dup array>> ] [ n>> 2 + ] bi
+ (inc-hashtable-cursor) <hashtable-cursor> ; inline
-: iterate3 ( seq1 seq2 seq3 quot iterator -- )
- [ [ >input ] tri@ ] 2dip call ; inline
+INSTANCE: hashtable-cursor assoc-cursor
+
+M: hashtable-cursor cursor-key-value
+ [ n>> ] [ hashtable>> array>> ] bi
+ [ nth-unsafe ] [ [ 1 + ] dip nth-unsafe ] 2bi ; inline
-: transform3 ( seq1 seq2 seq3 quot transformer -- newseq )
- [ pick >output [ [ >input ] [ >input ] [ >input ] tri* ] dip ] 2dip
- [ call ]
- [ 2drop 2nip freeze ] 5 nbi ; inline
+INSTANCE: hashtable collection
-: 3each ( seq1 seq2 seq3 quot -- ) [ cursor-each3 ] iterate3 ; inline
-: 3map ( seq1 seq2 seq3 quot -- ) [ cursor-map3 ] transform3 ; inline
+M: hashtable begin-cursor
+ dup array>> 0 (inc-hashtable-cursor) <hashtable-cursor> ; inline
+M: hashtable end-cursor
+ dup array>> length <hashtable-cursor> ; inline
projects / factor.git / commitdiff