removed times*, use repeat instead

examples/dejong.factor

@@ -48,7 +48,7 @@ SYMBOL: d
 
 : draw-dejong ( x0 y0 iterations -- )
     [
-        iterate-dejong 2dup scale-dejong rect> white pixel
+        iterate-dejong 2dup scale-dejong rect> white rgb pixel
     ] times 2drop ; compiled
 
 : dejong ( -- )

examples/factoroids.factor

@@ -129,7 +129,7 @@ M: ship tick ( actor -- ? ) dup [ move ] bind active? ;
 C: ship ( -- ship )
     [
         width get 2 /i  height get 50 - rect> position set
-        white color set
+        white rgb color set
         10 radius set
         0 velocity set
         active on
@@ -154,7 +154,7 @@ C: plasma ( actor dy -- plasma )
     [
         velocity set
         actor-xy
-        blue color set
+        blue rgb color set
         10 len set
         5 radius set
         active on
@@ -195,7 +195,7 @@ SYMBOL: stars
 : random-y 0 height get random-int ;
 : random-position random-x random-y rect> ;
 : random-byte 0 255 random-int ;
-: random-color random-byte random-byte random-byte 255 rgba ;
+: random-color random-byte random-byte random-byte rgb ;
 : random-velocity 0 10 20 random-int 10 /f rect> ;
 
 : random-star ( -- star )
@@ -254,7 +254,7 @@ C: enemy ;
 : spawn-enemy ( -- )
     <enemy> [
         random-x 10 rect> position set
-        red color set
+        red rgb color set
         0 wiggle-x set
         0 velocity set
         10 radius set
@@ -316,7 +316,7 @@ SYMBOL: event
 
 : render ( -- )
     #! Draw the scene.
-    [ black clear-surface draw-stars draw-actors ] with-surface ;
+    [ black rgb clear-surface draw-stars draw-actors ] with-surface ;
 
 : advance ( -- )
     #! Advance game state by one frame.

examples/mandel.factor

@@ -32,7 +32,7 @@ USE: test
 
 : scale 255 * >fixnum ;
 
-: scale-rgba ( r g b -- n )
+: scale-rgb ( r g b -- n )
     scale
     swap scale 8 shift bitor
     swap scale 16 shift bitor
@@ -44,9 +44,9 @@ USE: test
 : <color-map> ( nb-cols -- map )
     [
         dup [
-            360 * over 1 + / 360 / sat val
+            dup 360 * over 1 + / 360 / sat val
-            hsv>rgb 1.0 scale-rgba ,
+            hsv>rgb 1.0 scale-rgb ,
-        ] times*
+        ] repeat
     ] make-list list>vector nip ;
 
 : absq >rect swap sq swap sq + ; inline
@@ -73,14 +73,14 @@ SYMBOL: center
     nb-iter get max-color min <color-map> cols set ;
 
 : c ( #{ i j }# -- c )
-    >rect >r
+    >r
     x-inc get * center get real x-inc get width get 2 / * - + >float
     r>
     y-inc get * center get imaginary y-inc get height get 2 / * - + >float
     rect> ;
 
 : render ( -- )
-    width get height get [
+    [
         c 0 nb-iter get iter dup 0 = [
             drop 0
         ] [

library/bootstrap/boot-stage2.factor

@@ -57,7 +57,6 @@ USE: namespaces
     "/library/math/float.factor"
     "/library/math/complex.factor"
     "/library/words.factor"
-    "/library/math/math-combinators.factor"
     "/library/lists.factor"
     "/library/vectors.factor"
     "/library/strings.factor"

library/bootstrap/boot.factor

@@ -51,7 +51,6 @@ USE: hashtables
     "/library/math/float.factor" parse-resource append,
     "/library/math/complex.factor" parse-resource append,
     "/library/words.factor" parse-resource append,
-    "/library/math/math-combinators.factor" parse-resource append,
     "/library/lists.factor" parse-resource append,
     "/library/vectors.factor" parse-resource append,
     "/library/strings.factor" parse-resource append,

library/bootstrap/image.factor

@@ -285,8 +285,8 @@ M: vector ' ( vector -- pointer )
     ! Now make a rehashing boot quotation
     dup hash>alist [
         >r dup vector-length [
-            f swap pick set-vector-nth
+            [ f swap pick set-vector-nth ] keep
-        ] times* r>
+        ] repeat r>
         [ unswons rot set-hash ] each-with
     ] cons cons
     boot-quot [ append ] change ;

library/compiler/alien.factor

@@ -2,7 +2,7 @@
 
 ! $Id$
 !
-! Copyright (C) 2004 Slava Pestov.
+! Copyright (C) 2004, 2005 Slava Pestov.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:
@@ -40,6 +40,7 @@ USE: parser
 USE: words
 USE: hashtables
 USE: strings
+USE: unparser
 
 ! Command line parameters specify libraries to load.
 !
@@ -68,6 +69,15 @@ M: alien = ( obj obj -- ? )
         2drop f
     ] ifte ;
 
+M: alien unparse ( obj -- str )
+    [
+        "#<" ,
+        dup local-alien? "local-alien" "alien" ? ,
+        " @ " ,
+        alien-address unparse ,
+        ">" ,
+    ] make-string ;
+
 : library ( name -- object )
     dup [ "libraries" get hash ] when ;
 

library/generic/complement.factor

@@ -48,7 +48,12 @@ complement [
 
 complement [
     ( generic vtable definition class -- )
-    drop num-types [ >r 3dup r> add-method ] times* 3drop
+    drop num-types [
+        [
+            >r 3dup r> builtin-type
+            dup [ add-method ] [ 2drop 2drop ] ifte
+        ] keep
+    ] repeat 3drop
 ] "add-method" set-word-property
 
 complement 90 "priority" set-word-property

library/generic/object.factor

@@ -47,8 +47,8 @@ object [
 object [
     ( generic vtable definition class -- )
     drop over vector-length [
-        pick pick -rot set-vector-nth
+        3dup rot set-vector-nth
-    ] times* 3drop
+    ] repeat 3drop
 ] "add-method" set-word-property
 
 object [ drop t ] "predicate" set-word-property

library/hashtables.factor

@@ -105,22 +105,3 @@ PREDICATE: vector hashtable ( obj -- ? )
 
 : alist>hash ( alist -- hash )
     37 <hashtable> swap [ unswons pick set-hash ] each ;
-
-! In case I break hashing:
-
-! : hash* ( key table -- value )
-!     hash>alist assoc* ;
-! 
-! : set-hash ( value key table -- )
-!     dup vector-length [
-!         ( value key table index )
-!         >r 3dup r>
-!         ( value key table value key table index )
-!         [
-!             swap vector-nth
-!             ( value key table value key alist )
-!             set-assoc
-!         ] keep
-!         ( value key table new-assoc index )
-!         pick set-vector-nth
-!     ] times* 3drop ;

library/inference/types.factor

@@ -74,15 +74,8 @@ USE: prettyprint
 ] "infer" set-word-property
 
 : type-value-map ( value -- )
-    [
+    num-types [ dup builtin-type pick swons cons ] project
-        num-types [
+    [ cdr cdr ] subset nip ;
-            dup builtin-type dup [
-                pick swons cons ,
-            ] [
-                2drop
-            ] ifte
-        ] times*
-    ] make-list nip ;
 
 \ type [
     [ object ] ensure-d

library/lists.factor

@@ -161,15 +161,14 @@ M: cons = ( obj cons -- ? )
 
 M: cons hashcode ( cons -- hash ) car hashcode ;
 
-: project ( n quot -- list )
+: (count) ( i n -- list )
-    #! Execute the quotation n times, passing the loop counter
+    2dup >= [ 2drop [ ] ] [ >r dup 1 + r> (count) cons ] ifte ;
-    #! the quotation as it ranges from 0..n-1. Collect results
-    #! in a new list.
-    [ ] rot [ -rot over >r >r call r> cons r> swap ] times*
-    nip reverse ; inline
 
 : count ( n -- [ 0 ... n-1 ] )
-    [ ] project ;
+    0 swap (count) ;
+
+: project ( n quot -- list )
+    >r count r> map ; inline
 
 : head ( list n -- list )
     #! Return the first n elements of the list.

library/math/math-combinators.factor

@@ -1,91 +0,0 @@
-! :folding=indent:collapseFolds=1:
-
-! $Id$
-!
-! Copyright (C) 2003, 2004 Slava Pestov.
-! 
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-IN: math
-USE: kernel
-
-: times ( n quot -- )
-    #! Evaluate a quotation n times.
-    #!
-    #! In order to compile, the code must produce as many values
-    #! as it consumes.
-    tuck >r dup 0 <= [ r> 3drop ] [ 1 - slip r> times ] ifte ;
-    inline
-
-: (times) ( limit n quot -- )
-    pick pick <= [
-        3drop
-    ] [
-        rot pick 1 + pick 3slip (times)
-    ] ifte ; inline
-
-: times* ( n quot -- )
-    #! Evaluate a quotation n times, pushing the index at each
-    #! iteration. The index ranges from 0 to n-1.
-    #!
-    #! In order to compile, the code must consume one more value
-    #! than it produces.
-    0 swap (times) ; inline
-
-: fac ( n -- n! )
-    1 swap [ 1 + * ] times* ;
-
-: 2times-succ ( #{ a b }# #{ c d }# -- z )
-    #! Lexicographically add #{ 0 1 }# to a complex number.
-    #! If d + 1 == b, return #{ c+1 0 }#. Otherwise, #{ c d+1 }#.
-    2dup imaginary 1 + swap imaginary = [
-        nip real 1 +
-    ] [
-        nip >rect 1 + rect>
-    ] ifte ; inline
-
-: 2times<= ( #{ a b }# #{ c d }# -- ? )
-    swap real swap real <= ; inline
-
-: (2times) ( limit n quot -- )
-    pick pick 2times<= [
-        3drop
-    ] [
-        rot pick dupd 2times-succ pick 3slip (2times)
-    ] ifte ; inline
-
-: 2times* ( #{ w h }# quot -- )
-    #! Apply a quotation to each pair of complex numbers
-    #! #{ a b }# such that a < w, b < h.
-    0 swap (2times) ; inline
-
-: (repeat) ( i n quot -- )
-    pick pick >= [
-        3drop
-    ] [
-        [ swap >r call 1 + r> ] keep (repeat)
-    ] ifte ;
-
-: repeat ( n quot -- )
-    #! Execute a quotation n times. The loop counter is kept on
-    #! the stack, and ranges from 0 to n-1.
-    0 -rot (repeat) ;

library/math/math.factor

@@ -114,3 +114,19 @@ M: real abs dup 0 < [ neg ] when ;
 
 : align ( offset width -- offset )
     2dup mod dup 0 number= [ 2drop ] [ - + ] ifte ;
+
+: (repeat) ( i n quot -- )
+    pick pick >= [
+        3drop
+    ] [
+        [ swap >r call 1 + r> ] keep (repeat)
+    ] ifte ; inline
+
+: repeat ( n quot -- )
+    #! Execute a quotation n times. The loop counter is kept on
+    #! the stack, and ranges from 0 to n-1.
+    0 -rot (repeat) ; inline
+
+: times ( n quot -- )
+    #! Evaluate a quotation n times.
+    swap [ >r dup slip r> ] repeat drop ; inline

library/sdl/sdl-ttf.factor

@@ -81,11 +81,14 @@ USE: alien
 : TTF_RenderText_Solid ( font text fg -- surface )
     "surface*" "sdl-ttf" "TTF_RenderText_Solid" [ "void*" "char*" "int" ] alien-invoke ;
 
+: TTF_RenderText_Shaded ( font text fg bg -- surface )
+    "surface*" "sdl-ttf" "TTF_RenderText_Shaded" [ "void*" "char*" "int" "int" ] alien-invoke ;
+
 : TTF_RenderGlyph_Shaded ( font text fg bg -- surface )
     "surface*" "sdl-ttf" "TTF_RenderGlyph_Shaded" [ "void*" "ushort" "int" "int" ] alien-invoke ;
 
 : TTF_RenderText_Blended ( font text fg -- surface )
-    "surface*" "sdl-ttf" "TTF_RenderText_Blended" [ "void*" "ushort" "int" "int" ] alien-invoke ;
+    "surface*" "sdl-ttf" "TTF_RenderText_Blended" [ "void*" "ushort" "int" ] alien-invoke ;
 
 : TTF_RenderGlyph_Blended ( font text fg -- surface )
     "surface*" "sdl-ttf" "TTF_RenderGlyph_Blended" [ "void*" "ushort" "int" ] alien-invoke ;

library/sdl/sdl-utils.factor

@@ -54,26 +54,28 @@ SYMBOL: surface
     #! Set up SDL graphics and call the quotation.
     [ >r init-screen r> call SDL_Quit ] with-scope ; inline
 
-: rgba ( r g b a -- n )
+: rgb ( r g b a -- n )
+    255
     swap 8 shift bitor
     swap 16 shift bitor
     swap 24 shift bitor ;
 
-: black 0 0 0 255 rgba ;
+: black 0 0 0 ;
-: white 255 255 255 255 rgba ;
+: white 255 255 255 ;
-: red 255 0 0 255 rgba ;
+: red 255 0 0 ;
-: green 0 255 0 255 rgba ;
+: green 0 255 0 ;
-: blue 0 0 255 255 rgba ;
+: blue 0 0 255 ;
 
 : clear-surface ( color -- )
     >r surface get 0 0 width get height get r> boxColor ;
 
-: pixel-step ( quot #{ x y }# -- )
+: with-pixels ( quot -- )
-    tuck >r call >r surface get r> r> >rect rot pixelColor ;
+    width get [
-    inline
+        height get [
-
+            [ rot dup slip swap surface get swap ] 2keep
-: with-pixels ( w h quot -- )
+            [ rot pixelColor ] 2keep
-    -rot rect> [ over >r pixel-step r> ] 2times* drop ; inline
+        ] repeat
+    ] repeat drop ; inline
 
 : with-surface ( quot -- )
     #! Execute a quotation, locking the current surface if it

library/sdl/sdl-video.factor

@@ -2,7 +2,7 @@
 
 ! $Id$
 !
-! Copyright (C) 2004 Slava Pestov.
+! Copyright (C) 2004, 2005 Slava Pestov.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:
@@ -60,6 +60,13 @@ BEGIN-STRUCT: rect
     FIELD: ushort h
 END-STRUCT
 
+BEGIN-STRUCT: color
+    FIELD: uchar r
+    FIELD: uchar g
+    FIELD: uchar b
+    FIELD: uchar unused
+END-STRUCT
+
 BEGIN-STRUCT: format
     FIELD: void* palette
     FIELD: uchar  BitsPerPixel
@@ -148,10 +155,9 @@ END-STRUCT
 
 ! SDL_SetGamma: float types
 
-: SDL_FillRect ( surface rect color -- n )
+: SDL_MapRGB ( surface r g b -- rgb )
-    #! If rect is null, fills entire surface.
+    "uint" "sdl" "SDL_MapRGB"
-    "bool" "sdl" "SDL_FillRect"
+    [ "surface*" "uchar" "uchar" "uchar" ] alien-invoke ;
-    [ "surface*" "rect*" "uint" ] alien-invoke ;
 
 : SDL_LockSurface ( surface -- ? )
     "bool" "sdl" "SDL_LockSurface" [ "surface*" ] alien-invoke ;
@@ -159,9 +165,21 @@ END-STRUCT
 : SDL_UnlockSurface ( surface -- )
     "void" "sdl" "SDL_UnlockSurface" [ "surface*" ] alien-invoke ;
 
-: SDL_MapRGB ( surface r g b -- rgb )
+: SDL_FreeSurface ( surface -- )
-    "uint" "sdl" "SDL_MapRGB"
+    "void" "sdl" "SDL_FreeSurface" [ "surface*" ] alien-invoke ;
-    [ "surface*" "uchar" "uchar" "uchar" ] alien-invoke ;
+
+: SDL_UpperBlit ( src srcrect dst dstrect -- )
+    #! The blit function should not be called on a locked
+    #! surface.
+    "int" "sdl" "SDL_UpperBlit" [
+        "surface*" "rect*"
+        "surface*" "rect*"
+    ] alien-invoke ;
+
+: SDL_FillRect ( surface rect color -- n )
+    #! If rect is null, fills entire surface.
+    "bool" "sdl" "SDL_FillRect"
+    [ "surface*" "rect*" "uint" ] alien-invoke ;
 
 : SDL_WM_SetCaption ( title icon -- )
     "void" "sdl" "SDL_WM_SetCaption"

library/strings.factor

@@ -134,12 +134,20 @@ UNION: text string integer ;
         rot str-head swap
     ] ifte ;
 
-: str-each ( str [ code ] -- )
+: (str>list) ( i str -- list )
-    #! Execute the code, with each character of the string
+    2dup str-length >= [
+        2drop [ ]
+    ] [
+        2dup str-nth >r >r 1 + r> (str>list) r> swons
+    ] ifte ;
+
+: str>list ( str -- list )
+    0 swap (str>list) ;
+
+: str-each ( str quot -- )
+    #! Execute the quotation with each character of the string
     #! pushed onto the stack.
-    over str-length [
+    >r str>list r> each ; inline
-        -rot 2dup >r >r >r str-nth r> call r> r>
-    ] times* 2drop ; inline
 
 PREDICATE: integer blank     " \t\n\r" str-contains? ;
 PREDICATE: integer letter    CHAR: a CHAR: z between? ;

library/syntax/prettyprint.factor

@@ -186,7 +186,7 @@ M: hashtable prettyprint* ( indent hashtable -- indent )
 
 : {.} ( vector -- )
     #! Unparse each element on its own line.
-    stack>list [ . ] each ;
+    vector>list reverse [ . ] each ;
 
 : .s datastack  {.} ;
 : .r callstack  {.} ;

library/test/benchmark/empty-loop.factor

@@ -8,7 +8,7 @@ USE: test
     [ ] times ; compiled
 
 : empty-loop-2 ( n -- )
-    [ drop ] times* ; compiled
+    [ ] repeat ; compiled
 
 [ ] [ 5000000 empty-loop-1 ] unit-test
 [ ] [ 5000000 empty-loop-2 ] unit-test

library/test/benchmark/fac.factor

@@ -4,12 +4,22 @@ USE: test
 USE: compiler
 USE: kernel
 
+: (fac) ( n! i -- n! )
+    dup 0 = [
+        drop
+    ] [
+        [ * ] keep 1 - (fac)
+    ] ifte ;
+
+: fac ( n -- n! )
+    1 swap (fac) ;
+
 : small-fac-benchmark
     #! This tests fixnum math.
-    1 swap [ 10 fac 10 [ 1 + / ] times* max ] times ; compiled
+    1 swap [ 10 fac 10 [ [ 1 + / ] keep ] repeat max ] times ; compiled
 
 : big-fac-benchmark
-    10000 fac 10000 [ 1 + / ] times* ; compiled
+    10000 fac 10000 [ [ 1 + / ] keep ] repeat ; compiled
 
 [ 1 ] [ big-fac-benchmark ] unit-test
 

library/test/benchmark/hashtables.factor

@@ -9,10 +9,10 @@ USE: compiler
 ! http://inferno.bell-labs.com/cm/cs/who/bwk/interps/pap.html
 
 : store-hash ( hashtable n -- )
-    [ dup >hex swap pick set-hash ] times* drop ; compiled
+    [ [ dup >hex swap pick set-hash ] keep ] repeat drop ; compiled
 
 : lookup-hash ( hashtable n -- )
-    [ unparse over hash drop ] times* drop ; compiled
+    [ [ unparse over hash drop ] keep ] repeat drop ; compiled
 
 : hashtable-benchmark ( n -- )
     60000 <hashtable> swap 2dup store-hash lookup-hash ; compiled

library/test/benchmark/vectors.factor

@@ -7,7 +7,7 @@ USE: test
 ! http://inferno.bell-labs.com/cm/cs/who/bwk/interps/pap.html
 
 : fill-vector ( n -- vector )
-    dup <vector> swap [ dup pick set-vector-nth ] times* ; compiled
+    dup <vector> swap [ [ dup pick set-vector-nth ] keep ] repeat ; compiled
 
 : copy-elt ( vec-y vec-x n -- )
     #! Copy nth element from vec-x to vec-y.
@@ -15,7 +15,7 @@ USE: test
 
 : copy-vector ( vec-y vec-x n -- )
     #! Copy first n-1 elements from vec-x to vec-y.
-    [ >r 2dup r> copy-elt ] times* 2drop ; compiled
+    [ [ >r 2dup r> copy-elt ] keep ] repeat 2drop ; compiled
 
 : vector-benchmark ( n -- )
     0 <vector> over fill-vector rot copy-vector ; compiled

library/test/generic.factor

@@ -151,3 +151,13 @@ DEFER: bah
 FORGET: bah
 UNION: bah fixnum alien ;
 [ bah ] [ fixnum alien class-or ] unit-test
+
+DEFER: complement-test
+FORGET: complement-test
+GENERIC: complement-test
+
+M: f         complement-test drop "f" ;
+M: general-t complement-test drop "general-t" ;
+
+[ "general-t" ] [ 5 complement-test ] unit-test
+[ "f" ] [ f complement-test ] unit-test

library/test/hashtables.factor

@@ -11,7 +11,7 @@ USE: vectors
 
 : silly-key/value dup dup * swap ;
 
-1000 [ silly-key/value "testhash" get set-hash ] times*
+1000 [ [ silly-key/value "testhash" get set-hash ] keep ] repeat
 
 [ f ]
 [ 1000 count [ silly-key/value "testhash" get hash = not ] subset ]
@@ -40,11 +40,11 @@ unit-test
 16 <hashtable> "testhash" set
 
 t #{ 2 3 }# "testhash" get set-hash
-f 100 fac "testhash" get set-hash
+f 100000000000000000000000000 "testhash" get set-hash
 { } { [ { } ] } "testhash" get set-hash
 
 [ t ] [ #{ 2 3 }# "testhash" get hash ] unit-test
-[ f ] [ 100 fac "testhash" get hash* cdr ] unit-test
+[ f ] [ 100000000000000000000000000 "testhash" get hash* cdr ] unit-test
 [ { } ] [ { [ { } ] } vector-clone "testhash" get hash* cdr ] unit-test
 
 [

library/test/math/math-combinators.factor

@@ -2,19 +2,12 @@ IN: scratchpad
 USE: kernel
 USE: math
 USE: test
+USE: namespaces
 
-[ 0 1 2 3 4 ] [ 5 [ ] times* ] unit-test
+[ ] [ 5 [ ] times ] unit-test
-[ ] [ 0 [ ] times* ] unit-test
+[ ] [ 0 [ ] times ] unit-test
+[ ] [ -1 [ ] times ] unit-test
 
-[ #{ 1 1 }# ] [ #{ 2 3 }# #{ 1 0 }# 2times-succ ] unit-test
+[ ] [ 5 [ ] repeat ] unit-test
-[ #{ 1 2 }# ] [ #{ 2 3 }# #{ 1 1 }# 2times-succ ] unit-test
+[ [ 0 1 2 3 4 ] ] [ [ 5 [ dup , ] repeat ] make-list ] unit-test
-[ #{ 2 0 }# ] [ #{ 3 3 }# #{ 1 2 }# 2times-succ ] unit-test
+[ [ ] ] [ [ -1 [ dup , ] repeat ] make-list ] unit-test
-[ #{ 2 1 }# ] [ #{ 3 3 }# #{ 2 0 }# 2times-succ ] unit-test
-[ #{ 2 0 }# ] [ #{ 2 2 }# #{ 1 1 }# 2times-succ ] unit-test
-
-[ #{ 0 0 }# #{ 0 1 }# #{ 1 0 }# #{ 1 1 }# ]
-[ #{ 2 2 }# [ ] 2times* ] unit-test
-
-[ #{ 0 0 }# #{ 0 1 }# #{ 0 2 }# #{ 1 0 }# #{ 1 1 }# #{ 1 2 }# 
-  #{ 2 0 }# #{ 2 1 }# #{ 2 2 }# ]
-[ #{ 3 3 }# [ ] 2times* ] unit-test

library/test/vectors.factor

@@ -56,14 +56,6 @@ USE: namespaces
 [ 4 [ CHAR: a fill ] vector-project ]
 unit-test
 
-[ { 6 8 10 12 } ]
-[ { 1 2 3 4 } { 5 6 7 8 } vector-zip [ uncons + ] vector-map ]
-unit-test
-
-[ { [[ 1 5 ]] [[ 2 6 ]] [[ 3 7 ]] [[ 4 8 ]] } ]
-[ { 1 2 3 4 } { 5 6 7 8 } vector-zip ]
-unit-test
-
 [ [ ] ] [ 0 { } vector-tail ] unit-test
 [ [ ] ] [ 2 { 1 2 } vector-tail ] unit-test
 [ [ 3 4 ] ] [ 2 { 1 2 3 4 } vector-tail ] unit-test

library/ui/console.factor

@@ -105,9 +105,9 @@ SYMBOL: input-line
     total-lines fix-first-line first-line set ;
 
 ! Rendering
-: background white ;
+: background white rgb ;
-: foreground black ;
+: foreground black rgb ;
-: cursor     red   ;
+: cursor     red   rgb ;
 
 : next-line ( -- )
     0 x set  line-height y [ + ] change ;
@@ -121,10 +121,10 @@ SYMBOL: input-line
 
 : draw-lines ( -- )
     visible-lines available-lines min [
-        first-line get +
+        dup first-line get +
         lines get vector-nth draw-line
         next-line
-    ] times* ;
+    ] repeat ;
 
 : blink-interval 500 ;
 
@@ -158,7 +158,7 @@ SYMBOL: input-line
     scrollbar-top
     width get
     scrollbar-bottom
-    black boxColor ;
+    black rgb boxColor ;
 
 : draw-console ( -- )
     [

library/vectors.factor

@@ -82,12 +82,20 @@ BUILTIN: vector 11
 : >pop> ( stack -- stack )
     dup vector-pop drop ;
 
-: vector-each ( vector code -- )
+: (vector>list) ( i vec -- list )
-    #! Execute the code, with each element of the vector
+    2dup vector-length >= [
+        2drop [ ]
+    ] [
+        2dup vector-nth >r >r 1 + r> (vector>list) r> swons
+    ] ifte ;
+
+: vector>list ( str -- list )
+    0 swap (vector>list) ;
+
+: vector-each ( vector quotation -- )
+    #! Execute the quotation with each element of the vector
     #! pushed onto the stack.
-    over vector-length [
+    >r vector>list r> each ; inline
-        -rot 2dup >r >r >r vector-nth r> call r> r>
-    ] times* 2drop ; inline
 
 : vector-map ( vector code -- vector )
     #! Applies code to each element of the vector, return a new
@@ -113,34 +121,19 @@ BUILTIN: vector 11
     [ rot vector-nappend ] keep
     [ swap vector-nappend ] keep ;
 
-: vector-project ( n quot -- accum )
+: list>vector ( list -- vector )
+    dup length <vector> swap [ over vector-push ] each ;
+
+: vector-project ( n quot -- vector )
     #! Execute the quotation n times, passing the loop counter
     #! the quotation as it ranges from 0..n-1. Collect results
     #! in a new vector.
-    over <vector> rot [
+    project list>vector ; inline
-        -rot 2dup >r >r slip vector-push r> r>
-    ] times* nip ; inline
-
-: vector-zip ( v1 v2 -- v )
-    #! Make a new vector with each pair of elements from the
-    #! first two in a pair.
-    over vector-length over vector-length min [
-        pick pick >r over >r vector-nth r> r> vector-nth cons
-    ] vector-project 2nip ;
 
 : vector-clone ( vector -- vector )
     #! Shallow copy of a vector.
     [ ] vector-map ;
 
-: list>vector ( list -- vector )
-    dup length <vector> swap [ over vector-push ] each ;
-
-: stack>list ( vector -- list )
-    [ ] swap [ swons ] vector-each ;
-
-: vector>list ( vector -- list )
-    stack>list reverse ;
-
 : vector-length= ( vec vec -- ? )
     vector-length swap vector-length number= ;
 
@@ -153,7 +146,7 @@ M: vector = ( obj vec -- ? )
     ] [
         over vector? [
             2dup vector-length= [
-                swap stack>list swap stack>list =
+                swap vector>list swap vector>list =
             ] [
                 2drop f
             ] ifte
@@ -163,9 +156,11 @@ M: vector = ( obj vec -- ? )
     ] ifte ;
 
 M: vector hashcode ( vec -- n )
-    0 swap dup vector-length 4 min [
+    dup vector-length 0 number= [
-        over vector-nth hashcode rot bitxor swap
+        drop 0
-    ] times* drop ;
+    ] [
+        0 swap vector-nth hashcode
+    ] ifte ;
 
 : vector-tail ( n vector -- list )
     #! Return a new list with all elements from the nth