arrays are now better supported, various cleanups

TODO.FACTOR.txt

@@ -1,6 +1,3 @@
-- mersenne 42 runs out of memory
-- uncrossref: don't clear infer-effect of words with an infer quotation
-
 + ui:
 
 - fix up the min thumb size hack
@@ -67,7 +64,7 @@
 - better handling of random arrangements of html words when
   prettyprinting
 - friendlier .factor-rc load error handling
-- reader syntax for arrays, byte arrays, displaced aliens
+- reader syntax for byte arrays, displaced aliens
 - out of memory error when printing global namespace
 - merge timers with sleeping tasks
 - what about tasks and timers between image restarts
@@ -81,7 +78,6 @@
 - set-path: iterative
 - parse-command-line: no unswons of cli args
 - >c/c>: vector stack
-- word: when bootstrapping, 'word' var is not cleared
 - search: slow
 - investigate if rehashing on startup is really necessary
 - vectorize >n, n>, (get)
@@ -97,13 +93,6 @@
 - utf16, utf8 encoding
 - fix i/o on generic x86/ppc unix
 - if two tasks write to a unix stream, the buffer can overflow
-
-+ nice to have libraries:
-
-- regexps
-- XML
 - real Unicode support (strings are already 16 bits and can be extended
   to 21 if the need arises, but we need full character classification
   predicates, comparison, case conversion, sorting...)
-- full Win32 binding
-- Cairo binding

examples/raytracer.factor

@@ -1,18 +1,17 @@
 ! Factor port of the raytracer benchmark from
 ! http://www.ffconsultancy.com/free/ray_tracer/languages.html
 
-USING: generic io kernel lists math namespaces sequences test
+USING: arrays generic io kernel lists math namespaces sequences ;
-vectors ;
 IN: ray
 
 ! parameters
 : light
     #! Normalized { -1 -3 2 }.
-    {
+    @{
         -0.2672612419124244
         -0.8017837257372732
         0.5345224838248488
-    } ; inline
+    }@ ; inline
 
 : oversampling 4 ; inline
 
@@ -76,7 +75,7 @@ M: group intersect-scene ( hit ray group -- hit )
         drop
     ] if-ray-sphere ;
 
-: initial-hit << hit f { 0.0 0.0 0.0 } INF >> ;
+: initial-hit << hit f @{ 0.0 0.0 0.0 }@ INF >> ;
 
 : initial-intersect ( ray scene -- hit )
     initial-hit -rot intersect-scene ;
@@ -107,12 +106,12 @@ DEFER: create ( level c r -- scene )
     over >r create-center r> 2.0 / >r >r 1 - r> r> create ;
 
 : create-offsets ( quot -- )
-    {
+    @{
-        { -1.0 1.0 -1.0 }
+        @{ -1.0 1.0 -1.0 }@
-        { 1.0 1.0 -1.0 }
+        @{ 1.0 1.0 -1.0 }@
-        { -1.0 1.0 1.0 }
+        @{ -1.0 1.0 1.0 }@
-        { 1.0 1.0 1.0 }
+        @{ 1.0 1.0 1.0 }@
-    } swap each ; inline
+    }@ swap each ; inline
 
 : create-bound ( c r -- sphere ) 3.0 * <sphere> ;
 
@@ -126,14 +125,14 @@ DEFER: create ( level c r -- scene )
     pick 1 = [ <sphere> nip ] [ create-group ] ifte ;
 
 : ss-point ( dx dy -- point )
-    >r oversampling /f r> oversampling /f 0.0 3vector ;
+    >r oversampling /f r> oversampling /f 0.0 3array ;
 
 : ss-grid ( -- ss-grid )
     oversampling [ oversampling [ ss-point ] map-with ] map ;
 
 : ray-grid ( point ss-grid -- ray-grid )
     [
-        [ v+ normalize { 0.0 0.0 -4.0 } swap <ray> ] map-with
+        [ v+ normalize @{ 0.0 0.0 -4.0 }@ swap <ray> ] map-with
     ] map-with ;
 
 : ray-pixel ( scene point -- n )
@@ -143,7 +142,7 @@ DEFER: create ( level c r -- scene )
 : pixel-grid ( -- grid )
     size reverse [
         size [
-            size 0.5 * - swap size 0.5 * - size >float 3vector
+            size 0.5 * - swap size 0.5 * - size >float 3array
         ] map-with
     ] map ;
 
@@ -156,7 +155,7 @@ DEFER: create ( level c r -- scene )
     pixel-grid [ [ ray-pixel ] map-with ] map-with ;
 
 : run ( -- string )
-    levels { 0.0 -1.0 0.0 } 1.0 create ray-trace [
+    levels @{ 0.0 -1.0 0.0 }@ 1.0 create ray-trace [
         size size pnm-header
         [ [ oversampling sq / pnm-pixel ] each ] each
     ] "" make ;

library/alien/aliens.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: alien
-USING: hashtables io kernel lists math
+USING: arrays hashtables io kernel lists math namespaces parser ;
-namespaces parser sequences-internals ;
 
 UNION: c-ptr byte-array alien displaced-alien ;
 

library/alien/c-types.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: alien
-USING: assembler compiler compiler-backend errors generic
+USING: arrays assembler compiler compiler-backend errors generic
 hashtables kernel kernel-internals lists math namespaces parser
 sequences sequences-internals strings words ;
 

library/alien/compiler.factor

@@ -163,7 +163,8 @@ global [
 ] bind
 
 M: compound (uncrossref)
-    dup word-def \ alien-invoke swap member? [
+    dup word-def \ alien-invoke swap member?
+    over "infer" word-prop or [
         drop
     ] [
         dup { "infer-effect" "base-case" "no-effect" }

library/bootstrap/boot-stage1.factor

@@ -26,7 +26,6 @@ sequences io vectors words ;
         "/library/kernel.factor"
 
         "/library/collections/sequences.factor"
-        "/library/collections/arrays.factor"
 
         "/library/math/math.factor"
         "/library/math/integer.factor"
@@ -40,6 +39,7 @@ sequences io vectors words ;
         "/library/collections/virtual-sequences.factor"
         "/library/collections/sequence-combinators.factor"
         "/library/collections/sequences-epilogue.factor"
+        "/library/collections/arrays.factor"
         "/library/collections/strings.factor"
         "/library/collections/sbuf.factor"
         "/library/collections/assoc.factor"

library/bootstrap/image.factor

@@ -189,7 +189,7 @@ M: cons ' ( c -- tagged )
 ( Strings )
 
 : emit-chars ( seq -- )
-    big-endian get [ [ reverse ] map ] unless
+    big-endian get [ [ reverse-slice ] map ] unless
     [ 0 [ swap 16 shift + ] reduce emit ] each ;
 
 : pack-string ( string -- seq )
@@ -219,7 +219,7 @@ M: string ' ( string -- pointer )
     align-here r> ;
 
 M: tuple ' ( tuple -- pointer )
-    <mirror> tuple-type emit-array ;
+    tuple>array tuple-type emit-array ;
 
 M: vector ' ( vector -- pointer )
     dup array-type emit-array swap length
@@ -232,7 +232,7 @@ M: vector ' ( vector -- pointer )
 ( Hashes )
 
 M: hashtable ' ( hashtable -- pointer )
-    dup buckets>vector array-type emit-array
+    dup underlying array-type emit-array
     swap hash-size
     object-tag here-as >r
     hashtable-type >header emit
@@ -288,6 +288,7 @@ M: hashtable ' ( hashtable -- pointer )
         "Image length: " write image get length .
         "Object cache size: " write objects get hash-size .
         image get
+        \ word global remove-hash
     ] with-scope ;
 
 : make-image ( name -- )
@@ -295,7 +296,6 @@ M: hashtable ' ( hashtable -- pointer )
     [
         begin
         "/library/bootstrap/boot-stage1.factor" run-resource
-        namespace global [ "foobar" set ] bind
         end
     ] with-image
 

library/bootstrap/init.factor

@@ -10,7 +10,6 @@ namespaces parser threads words ;
     init-threads
     init-io
     "HOME" os-env [ "." ] unless* "~" set
-    init-search-path
     init-assembler
     init-error-handler
     default-cli-args

library/bootstrap/primitives.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: image
-USING: alien generic hashtables io kernel kernel-internals lists
+USING: arrays alien generic hashtables io kernel
-math namespaces sequences strings vectors words ;
+kernel-internals lists math namespaces sequences strings vectors
+words ;
 
 ! Some very tricky code creating a bootstrap embryo in the
 ! host image.
@@ -150,7 +151,7 @@ vocabularies get [ "syntax" set [ reveal ] each ] bind
     { "dlsym" "alien"                       }
     { "dlclose" "alien"                     }
     { "<alien>" "alien"                     }
-    { "<byte-array>" "sequences-internals"   }
+    { "<byte-array>" "arrays"               }
     { "<displaced-alien>" "alien"           }
     { "alien-signed-cell" "alien"           }
     { "set-alien-signed-cell" "alien"       }
@@ -188,10 +189,10 @@ vocabularies get [ "syntax" set [ reveal ] each ] bind
     { "set-integer-slot" "kernel-internals" }
     { "char-slot" "kernel-internals"        }
     { "set-char-slot" "kernel-internals"    }
-    { "resize-array" "sequences-internals"   }
+    { "resize-array" "arrays"               }
     { "resize-string" "strings"             }
     { "<hashtable>" "hashtables"            }
-    { "<array>" "sequences-internals"        }
+    { "<array>" "arrays"                    }
     { "<tuple>" "kernel-internals"          }
     { "begin-scan" "memory"                 }
     { "next-object" "memory"                }
@@ -207,6 +208,9 @@ vocabularies get [ "syntax" set [ reveal ] each ] bind
     { "expired?" "alien"                    }
     { "<wrapper>" "kernel"                  }
     { "(clone)" "kernel-internals"          }
+    { "array>tuple" "generic"               }
+    { "tuple>array" "generic"               }
+    { "array>vector" "vectors"              }
 } dup length 3 swap [ + ] map-with [ make-primitive ] 2each
 
 : set-stack-effect ( { vocab word effect } -- )
@@ -257,7 +261,7 @@ FORGET: set-stack-effect
 : define-builtin ( symbol type# predicate slotspec -- )
     >r >r >r
     dup intern-symbol
-    dup r> 1vector "types" set-word-prop
+    dup r> 1array "types" set-word-prop
     dup builtin define-class
     dup r> builtin-predicate
     dup r> intern-slots 2dup "slots" set-word-prop
@@ -308,8 +312,8 @@ null null define-class
 
 "displaced-alien" "alien" create 7 "displaced-alien?" "alien" create { } define-builtin
 
-"array?" "sequences-internals" create t "inline" set-word-prop
+"array?" "arrays" create t "inline" set-word-prop
-"array" "sequences-internals" create 8 "array?" "sequences-internals" create
+"array" "arrays" create 8 "array?" "arrays" create
 { } define-builtin
 
 "f" "!syntax" create 9 "not" "kernel" create
@@ -369,9 +373,9 @@ null null define-class
 "tuple" "kernel" create 18 "tuple?" "kernel" create
 { } define-builtin
 
-"byte-array?" "sequences-internals" create t "inline" set-word-prop
+"byte-array?" "arrays" create t "inline" set-word-prop
-"byte-array" "sequences-internals" create 19
+"byte-array" "arrays" create 19
-"byte-array?" "sequences-internals" create
+"byte-array?" "arrays" create
 { } define-builtin
 
 ! Define general-t type, which is any object that is not f.

library/collections/arrays.factor

@@ -1,22 +1,20 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 
-! An array is a range of memory storing pointers to other
+IN: kernel-internals
-! objects. Arrays are not used directly, and their access words
+USING: kernel math math-internals sequences sequences-internals ;
-! are not bounds checked. Examples of abstractions built on
-! arrays include vectors, hashtables, and tuples.
 
-! These words are unsafe. I'd say "do not call them", but that
+: array= ( seq seq -- ? )
-! Java-esque. By all means, do use arrays if you need something
+    #! This is really only used to compare tuples.
-! low-level... but be aware that vectors are usually a better
+    over array-capacity over array-capacity number= [
-! choice.
+        dup array-capacity [
+            >r 2dup r> tuck swap array-nth >r swap array-nth r> =
+        ] all? 2nip
+    ] [
+        2drop f
+    ] ifte ; flushable
 
-IN: sequences-internals
+IN: arrays
-USING: kernel kernel-internals math-internals sequences ;
-
-: array-capacity ( a -- n ) 1 slot ; inline
-: array-nth ( n a -- obj ) swap 2 fixnum+ slot ; inline
-: set-array-nth ( obj n a -- ) swap 2 fixnum+ set-slot ; inline
 
 M: array clone (clone) ;
 M: array length array-capacity ;
@@ -26,15 +24,27 @@ M: array nth-unsafe array-nth ;
 M: array set-nth-unsafe set-array-nth ;
 M: array resize resize-array ;
 
+: >array ( seq -- array )
+    [ length <array> 0 over ] keep copy-into ; inline
+
+M: array like drop dup array? [ >array ] unless ;
+
 M: byte-array clone (clone) ;
 M: byte-array length array-capacity ;
 M: byte-array resize resize-array ;
 
-IN: kernel-internals
+: 1array ( x -- { x } )
+    1 <array> [ 0 swap set-array-nth ] keep ; flushable
 
-: make-tuple ( class size -- tuple )
+: 2array ( x y -- @{ x y }@ )
-    #! Internal allocation function. Do not call it directly,
+    2 <array>
-    #! since you can fool the runtime and corrupt memory by
+    [ 1 swap set-array-nth ] keep
-    #! specifying an incorrect size. Note that this word is also
+    [ 0 swap set-array-nth ] keep ; flushable
-    #! handled specially by the compiler's type inferencer.
+
-    <tuple> [ 2 set-slot ] keep ; flushable
+: 3array ( x y z -- @{ x y z }@ )
+    3 <array>
+    [ 2 swap set-array-nth ] keep
+    [ 1 swap set-array-nth ] keep
+    [ 0 swap set-array-nth ] keep ; flushable
+
+: zero-array ( n -- array ) 0 <repeated> >array ;

library/collections/hashtables.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: hashtables
-USING: generic kernel lists math sequences vectors
+USING: arrays generic kernel lists math sequences vectors
 kernel-internals sequences-internals ;
 
 ! A hashtable is implemented as an array of buckets. The
@@ -102,9 +102,6 @@ IN: hashtables
 : hash-clear ( hash -- )
     0 over set-hash-size [ f -rot set-hash-bucket ] each-bucket ;
 
-: buckets>vector ( hash -- vector )
-    underlying >vector ;
-
 : alist>hash ( alist -- hash )
     dup length 1 max <hashtable> swap
     [ unswons pick set-hash ] each ; foldable

library/collections/sequence-combinators.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: sequences-internals
-USING: generic kernel kernel-internals math vectors ;
+USING: arrays generic kernel kernel-internals math vectors ;
 
 : (map) ( quot seq i -- quot seq value )
     pick pick >r >r swap nth-unsafe swap call r> r> rot ; inline
@@ -40,11 +40,11 @@ G: find ( seq quot -- i elt | quot: elt -- ? )
     swap [ with rot ] find 2swap 2drop ; inline
 
 : collect ( n generator -- vector | quot: n -- value )
-    #! Primitive mapping out of an integer sequence into a
+    #! Primitive mapping out of an integer sequence into an
-    #! vector. Used by map and 2map. Don't call, use map
+    #! array. Used by map and 2map. Don't call, use map
     #! instead.
-    >r [ empty-vector ] keep r> swap [
+    >r [ <array> ] keep r> swap [
-        [ rot >r [ swap call ] keep r> set-nth-unsafe ] 3keep
+        [ rot >r [ swap call ] keep r> set-array-nth ] 3keep
     ] repeat drop ; inline
 
 G: map [ over ] standard-combination ; inline

library/collections/sequence-eq.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: sequences
-USING: kernel kernel-internals lists math sequences-internals
+USING: arrays kernel lists math sequences-internals strings
-strings vectors ;
+vectors ;
 
 ! Note that the sequence union does not include lists, or user
 ! defined tuples that respond to the sequence protocol.

library/collections/sequences-epilogue.factor

@@ -127,7 +127,8 @@ M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
     #! An example illustrates this word best:
     #! { { 1 2 3 } { 4 5 6 } } ==> { { 1 4 } { 2 5 } { 3 6 } }
     dup empty? [
-        dup first length [ swap [ nth ] map-with ] map-with
+        dup first [ length ] keep like
+        [ swap [ nth ] map-with ] map-with
     ] unless ; flushable
 
 : max-length ( seq -- n )

library/collections/vectors.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: vectors
-USING: errors generic kernel kernel-internals lists math
+USING: arrays errors generic kernel kernel-internals lists math
 math-internals sequences sequences-internals ;
 
 M: vector set-length ( len vec -- ) grow-length ;
@@ -28,18 +28,7 @@ M: vector clone ( vector -- vector ) clone-growable ;
 
 M: general-list like drop >list ;
 
-M: vector like drop dup vector? [ >vector ] unless ;
+M: vector like
-
+    drop dup vector? [
-: 1vector ( x -- { x } )
+        dup array? [ array>vector ] [ >vector ] ifte
-    1 empty-vector [ 0 swap set-nth ] keep ; flushable
+    ] unless ;
-
-: 2vector ( x y -- { x y } )
-    2 empty-vector
-    [ 1 swap set-nth ] keep
-    [ 0 swap set-nth ] keep ; flushable
-
-: 3vector ( x y z -- { x y z } )
-    3 empty-vector
-    [ 2 swap set-nth ] keep
-    [ 1 swap set-nth ] keep
-    [ 0 swap set-nth ] keep ; flushable

library/collections/virtual-sequences.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: sequences
-USING: generic kernel math sequences-internals vectors ;
+USING: errors generic kernel math sequences-internals vectors ;
 
 ! A repeated sequence is the same element n times.
 TUPLE: repeated length object ;
@@ -17,7 +17,7 @@ TUPLE: reversed ;
 
 C: reversed [ set-delegate ] keep ;
 
-: reversed@ delegate [ length swap - 1 - ] keep ;
+: reversed@ delegate [ length swap - 1 - ] keep ; inline
 
 M: reversed nth ( n seq -- elt ) reversed@ nth ;
 
@@ -31,27 +31,30 @@ M: reversed set-nth-unsafe ( elt n seq -- )
 M: reversed thaw ( seq -- seq ) delegate reverse ;
 
 ! A slice of another sequence.
-TUPLE: slice seq from to step ;
+TUPLE: slice seq from to ;
 
 : collapse-slice ( from to slice -- from to seq )
     dup slice-from swap slice-seq >r tuck + >r + r> r> ;
 
+: check-slice ( from to seq -- )
+    length over < [ "Slice longer than sequence" throw ] when
+    > [ "Slice start is after slice end" throw ] when ;
+
 C: slice ( from to seq -- seq )
     #! A slice of a slice collapses.
     >r dup slice? [ collapse-slice ] when r>
+    >r 3dup check-slice r>
     [ set-slice-seq ] keep
-    >r 2dup > -1 1 ? r>
-    [ set-slice-step ] keep
     [ set-slice-to ] keep
     [ set-slice-from ] keep ;
 
-: <range> ( from to -- seq ) 0 <slice> ;
+: <range> ( from to -- seq ) dup <slice> ;
 
 M: slice length ( range -- n )
-    dup slice-to swap slice-from - abs ;
+    dup slice-to swap slice-from - ;
 
 : slice@ ( n slice -- n seq )
-    [ [ slice-step * ] keep slice-from + ] keep slice-seq ;
+    [ slice-from + ] keep slice-seq ; inline
 
 M: slice nth ( n slice -- obj ) slice@ nth ;
 

library/compiler/basic-blocks.factor

@@ -1,5 +1,5 @@
 IN: compiler-backend
-USING: hashtables kernel lists math namespaces sequences vectors ;
+USING: arrays hashtables kernel lists math namespaces sequences ;
 
 : (split-blocks) ( n linear -- )
     2dup length = [
@@ -153,7 +153,7 @@ M: %indirect trim-dead* ( tail vop -- ) ?dead-literal ;
         0 r-height set
         {{ }} clone vreg-contents set
         dup simplify-stack
-        d-height get %inc-d r-height get %inc-r 2vector append
+        d-height get %inc-d r-height get %inc-r 2array append
         trim-dead
     ] { } make ;
 

library/compiler/intrinsics.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: compiler-frontend
-USING: assembler compiler-backend generic hashtables inference
+USING: arrays assembler compiler-backend generic hashtables
-kernel kernel-internals lists math math-internals namespaces
+inference kernel kernel-internals lists math math-internals
-sequences vectors words ;
+namespaces sequences words ;
 
 : node-peek ( node -- value ) node-in-d peek ;
 
@@ -89,7 +89,7 @@ sequences vectors words ;
 
 : value/vreg-list ( in -- list )
     [ 0 swap length 1 - ] keep
-    [ >r 2dup r> 3vector >r 1 - >r 1 + r> r> ] map 2nip ;
+    [ >r 2dup r> 3array >r 1 - >r 1 + r> r> ] map 2nip ;
 
 : values>vregs ( in -- in )
     value/vreg-list

library/compiler/vops.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: compiler-backend
-USING: errors generic hashtables kernel lists math namespaces
+USING: arrays errors generic hashtables kernel lists math
-parser sequences vectors words ;
+namespaces parser sequences words ;
 
 ! The linear IR is the second of the two intermediate
 ! representations used by Factor. It is basically a high-level
@@ -51,15 +51,15 @@ M: f basic-block? drop f ;
 
 : empty-vop f f f ;
 : label-vop ( label) >r f f r> ;
-: label/src-vop ( label src) 1vector swap f swap ;
+: label/src-vop ( label src) 1array swap f swap ;
-: src-vop ( src) 1vector f f ;
+: src-vop ( src) 1array f f ;
-: dest-vop ( dest) 1vector dup f ;
+: dest-vop ( dest) 1array dup f ;
-: src/dest-vop ( src dest) >r 1vector r> 1vector f ;
+: src/dest-vop ( src dest) >r 1array r> 1array f ;
-: 2-in-vop ( in1 in2) 2vector f f ;
+: 2-in-vop ( in1 in2) 2array f f ;
-: 3-in-vop ( in1 in2 in3) 3vector f f ;
+: 3-in-vop ( in1 in2 in3) 3array f f ;
-: 2-in/label-vop ( in1 in2 label) >r 2vector f r> ;
+: 2-in/label-vop ( in1 in2 label) >r 2array f r> ;
-: 2-vop ( in dest) [ 2vector ] keep 1vector f ;
+: 2-vop ( in dest) [ 2array ] keep 1array f ;
-: 3-vop ( in1 in2 dest) >r 2vector r> 1vector f ;
+: 3-vop ( in1 in2 dest) >r 2array r> 1array f ;
 
 ! miscellanea
 TUPLE: %prologue ;
@@ -201,7 +201,7 @@ C: %set-slot make-vop ;
 
 : %set-slot ( value obj n )
     #! %set-slot writes to vreg obj.
-    rot <vreg> rot <vreg> rot <vreg> over >r 3vector r> 1vector
+    rot <vreg> rot <vreg> rot <vreg> over >r 3array r> 1array
     f <%set-slot> ;
 
 M: %set-slot basic-block? drop t ;
@@ -218,7 +218,7 @@ TUPLE: %fast-set-slot ;
 C: %fast-set-slot make-vop ;
 : %fast-set-slot ( value obj n )
     #! %fast-set-slot writes to vreg obj.
-    >r >r <vreg> r> <vreg> r> over >r 3vector r> 1vector f
+    >r >r <vreg> r> <vreg> r> over >r 3array r> 1array f
     <%fast-set-slot> ;
 M: %fast-set-slot basic-block? drop t ;
 

library/generic/math-combination.factor

@@ -50,7 +50,7 @@ TUPLE: no-math-method left right generic ;
 : math-vtable ( picker quot -- )
     [
         swap , \ tag ,
-        [ num-tags swap map % ] { } make ,
+        [ num-tags swap map % ] @{ }@ make ,
         \ dispatch ,
     ] [ ] make ; inline
 

library/generic/slots.factor

@@ -4,8 +4,8 @@
 ! Some code for defining slot accessors and mutators. Used to
 ! implement tuples, as well as builtin types.
 IN: generic
-USING: kernel kernel-internals lists math namespaces parser
+USING: arrays kernel kernel-internals lists math namespaces
-sequences strings vectors words ;
+parser sequences strings words ;
 
 : define-typecheck ( class generic def -- )
     #! Just like:
@@ -33,7 +33,7 @@ sequences strings vectors words ;
     dup [ first2 create ] when ;
 
 : intern-slots ( spec -- spec )
-    [ first3 swap ?create swap ?create 3vector ] map ;
+    [ first3 swap ?create swap ?create 3array ] map ;
 
 : define-slots ( class spec -- )
     #! Define a collection of slot readers and writers for the
@@ -43,11 +43,11 @@ sequences strings vectors words ;
     [ first3 define-slot ] each-with ;
 
 : reader-word ( class name -- word )
-    >r word-name "-" r> append3 "in" get 2vector ;
+    >r word-name "-" r> append3 "in" get 2array ;
 
 : writer-word ( class name -- word )
     [ swap "set-" % word-name % "-" % % ] "" make
-    "in" get 2vector ;
+    "in" get 2array ;
 
 : simple-slot ( class name -- reader writer )
     [ reader-word ] 2keep writer-word ;
@@ -58,5 +58,5 @@ sequences strings vectors words ;
     #! set-<class>-<slot>. Slot numbering is consecutive and
     #! begins at base.
     over length [ + ] map-with
-    [ >r dupd simple-slot r> -rot 3vector ] 2map nip
+    [ >r dupd simple-slot r> -rot 3array ] 2map nip
     intern-slots ;

library/generic/tuple.factor

@@ -72,32 +72,6 @@ words ;
     dup r> tuple-slots
     default-constructor ;
 
-! A sequence of all slots in a tuple, used for equality testing.
-TUPLE: mirror tuple ;
-
-C: mirror ( tuple -- mirror )
-    over tuple? [ "Not a tuple" throw ] unless
-    [ set-mirror-tuple ] keep ;
-
-M: mirror nth-unsafe ( n mirror -- elt )
-    mirror-tuple array-nth ;
-
-M: mirror nth ( n mirror -- elt )
-    bounds-check nth-unsafe ;
-
-M: mirror set-nth-unsafe ( n mirror -- elt )
-    mirror-tuple set-array-nth ;
-
-M: mirror set-nth ( n mirror -- elt )
-    bounds-check set-nth-unsafe ;
-
-M: mirror length ( mirror -- len )
-    mirror-tuple array-capacity ;
-
-: literal-tuple ( seq -- tuple )
-    dup first "tuple-size" word-prop <tuple>
-    [ <mirror> 0 swap rot copy-into ] keep ;
-
 M: tuple clone ( tuple -- tuple )
     #! Clone a tuple and its delegate.
     (clone) dup delegate clone over set-delegate ;
@@ -115,11 +89,7 @@ M: tuple = ( obj tuple -- ? )
     2dup eq? [
         2drop t
     ] [
-        over tuple? [
+        over tuple? [ array= ] [ 2drop f ] ifte
-            swap <mirror> swap <mirror> sequence=
-        ] [
-            2drop f
-        ] ifte
     ] ifte ;
 
 tuple [ 2drop f ] "class<" set-word-prop

library/help/tutorial.factor

@@ -9,9 +9,9 @@ sequences strings styles ;
 
 : <underline> ( -- gadget )
     <gadget>
-    dup << gradient f { 1 0 0 } { 64 64 64 } { 255 255 255 } >>
+    dup << gradient f @{ 1 0 0 }@ @{ 64 64 64 }@ @{ 255 255 255 }@ >>
     interior set-paint-prop
-    { 0 10 0 } over set-gadget-dim ;
+    @{ 0 10 0 }@ over set-gadget-dim ;
 
 GENERIC: tutorial-line ( object -- gadget )
 
@@ -362,8 +362,9 @@ M: general-list tutorial-line
     ] ;
 
 : tutorial-theme
-    dup { 204 204 255 } background set-paint-prop
+    dup @{ 204 204 255 }@ background set-paint-prop
-    dup << gradient f { 0 1 0 } { 204 204 255 } { 255 204 255 } >> interior set-paint-prop
+    dup << gradient f @{ 0 1 0 }@ @{ 204 204 255 }@ @{ 255 204 255 }@ >>
+    interior set-paint-prop
     dup "Sans Serif" font set-paint-prop
     18 font-size set-paint-prop ;
 

library/inference/branches.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: inference
-USING: errors generic hashtables interpreter kernel lists math
+USING: arrays errors generic hashtables interpreter kernel math
 namespaces parser prettyprint sequences strings vectors words ;
 
 : unify-lengths ( seq -- seq )
@@ -11,7 +11,7 @@ namespaces parser prettyprint sequences strings vectors words ;
     [ [ required-inputs ] keep append ] map-with ;
 
 : unify-length ( seq seq -- seq )
-    2vector unify-lengths first2 ;
+    2array unify-lengths first2 ;
 
 : unify-values ( seq -- value )
     #! If all values in list are equal, return the value.

library/inference/call-optimizers.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: optimizer
-USING: errors generic hashtables inference kernel lists math
+USING: arrays errors generic hashtables inference kernel lists
-math-internals sequences vectors words ;
+math math-internals sequences words ;
 
 ! A system for associating dataflow optimizers with words.
 
@@ -48,7 +48,7 @@ math-internals sequences vectors words ;
     #! If a not is followed by an #ifte, flip branches and
     #! remove the note.
     dup flip-subst node-successor dup
-    dup node-children first2 swap 2vector swap set-node-children ;
+    dup node-children first2 swap 2array swap set-node-children ;
 
 \ not {
     { [ dup node-successor #ifte? ] [ flip-branches ] }

library/inference/class-infer.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: optimizer
-USING: generic hashtables inference kernel kernel-internals
+USING: arrays generic hashtables inference kernel
-namespaces sequences vectors words ;
+kernel-internals namespaces sequences words ;
 
 ! Infer possible classes of values in a dataflow IR.
 
@@ -106,7 +106,7 @@ M: node child-ties ( node -- seq )
     ] ifte ;
 
 \ make-tuple [
-    dup node-in-d first literal-value 1vector
+    dup node-in-d first literal-value 1array
 ] "output-classes" set-word-prop
 
 : output-classes ( node -- seq )
@@ -130,7 +130,7 @@ M: #shuffle infer-classes* ( node -- )
 
 M: #ifte child-ties ( node -- seq )
     node-in-d first dup general-t <class-tie>
-    swap f <literal-tie> 2vector ;
+    swap f <literal-tie> 2array ;
 
 M: #dispatch child-ties ( node -- seq )
     dup node-in-d first

library/inference/dataflow.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: inference
-USING: generic interpreter kernel lists namespaces parser
+USING: arrays generic interpreter kernel lists namespaces parser
-sequences vectors words ;
+sequences words ;
 
 ! Recursive state. An alist, mapping words to labels.
 SYMBOL: recursive-state
@@ -152,7 +152,7 @@ SYMBOL: current-node
     current-node get    current-node off ;
 
 : unnest-node ( new-node dataflow current -- new-node )
-    >r >r dataflow-graph get 1vector over set-node-children
+    >r >r dataflow-graph get 1array over set-node-children
     r> dataflow-graph set
     r> current-node set ;
 

library/inference/inline-methods.factor

@@ -1,16 +1,16 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: optimizer
-USING: generic hashtables inference kernel lists math namespaces
+USING: arrays generic hashtables inference kernel lists math
-sequences vectors words ;
+namespaces sequences words ;
 
 ! Method inlining optimization
 
 GENERIC: dispatching-values ( node word -- seq )
 
-M: object dispatching-values 2drop { } ;
+M: object dispatching-values 2drop @{ }@ ;
 
-M: simple-generic dispatching-values drop node-in-d peek 1vector ;
+M: simple-generic dispatching-values drop node-in-d peek 1array ;
 
 M: 2generic dispatching-values drop node-in-d 2 swap tail* ;
 
@@ -71,4 +71,4 @@ M: 2generic dispatching-values drop node-in-d 2 swap tail* ;
 : optimize-predicate ( #call -- node )
     dup node-param "predicating" word-prop >r
     dup dup node-in-d node-classes* first r> class<
-    1vector inline-literals ;
+    1array inline-literals ;

library/inference/known-words.factor

@@ -1,8 +1,8 @@
 IN: inference
-USING: alien assembler errors generic hashtables interpreter io
+USING: arrays alien assembler errors generic hashtables
-io-internals kernel kernel-internals lists math math-internals
+interpreter io io-internals kernel kernel-internals lists math
-memory parser sequences sequences-internals strings vectors
+math-internals memory parser sequences strings vectors words
-words prettyprint ;
+prettyprint ;
 
 ! We transform calls to these words into 'branched' forms;
 ! eg, there is no VOP for fixnum<=, only fixnum<= followed
@@ -56,7 +56,7 @@ words prettyprint ;
 \ ifte [ [ object general-list general-list ] [ ] ] "infer-effect" set-word-prop
 
 \ ifte [
-    2 #drop node, pop-d pop-d swap 2vector
+    2 #drop node, pop-d pop-d swap 2array
     #ifte pop-d drop infer-branches
 ] "infer" set-word-prop
 
@@ -501,3 +501,12 @@ words prettyprint ;
 
 \ (clone) [ [ object ] [ object ] ] "infer-effect" set-word-prop
 \ (clone) t "flushable" set-word-prop
+
+\ array>tuple [ [ array ] [ tuple ] ] "infer-effect" set-word-prop
+\ array>tuple t "flushable" set-word-prop
+
+\ tuple>array [ [ tuple ] [ array ] ] "infer-effect" set-word-prop
+\ tuple>array t "flushable" set-word-prop
+
+\ array>vector [ [ array ] [ vector ] ] "infer-effect" set-word-prop
+\ array>vector t "flushable" set-word-prop

library/kernel.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: kernel
-USING: generic kernel-internals vectors ;
+USING: generic kernel-internals math-internals vectors ;
 
 : 2swap ( x y z t -- z t x y ) rot >r rot r> ; inline
 
@@ -111,3 +111,18 @@ M: wrapper = ( obj wrapper -- ? )
 
 : keep-datastack ( quot -- )
     datastack slip set-datastack drop ;
+
+IN: kernel-internals
+
+! These words are unsafe. Don't use them.
+
+: array-capacity ( a -- n ) 1 slot ; inline
+: array-nth ( n a -- obj ) swap 2 fixnum+ slot ; inline
+: set-array-nth ( obj n a -- ) swap 2 fixnum+ set-slot ; inline
+
+: make-tuple ( class size -- tuple )
+    #! Internal allocation function. Do not call it directly,
+    #! since you can fool the runtime and corrupt memory by
+    #! specifying an incorrect size. Note that this word is also
+    #! handled specially by the compiler's type inferencer.
+    <tuple> [ 2 set-slot ] keep ; flushable

library/math/matrices.factor

@@ -1,11 +1,9 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: math
-USING: generic kernel sequences vectors ;
+USING: arrays generic kernel sequences ;
 
 ! Vectors
-: zero-vector ( n -- vector ) 0 <repeated> >vector ;
-
 : vneg ( v -- v ) [ neg ] map ;
 
 : n*v ( n v -- v ) [ * ] map-with ;
@@ -53,27 +51,16 @@ USING: generic kernel sequences vectors ;
     #! Cross product of two 3-dimensional vectors.
     [ 1 2 cross-minor ] 2keep
     [ 2 0 cross-minor ] 2keep
-    0 1 cross-minor 3vector ;
+    0 1 cross-minor 3array ;
 
 ! Matrices
 
-! A diagonal of a matrix stored as a sequence of rows.
-TUPLE: diagonal index ;
-
-C: diagonal ( seq -- diagonal ) [ set-delegate ] keep ;
-
-: diagonal@ ( n diag -- n vec ) dupd delegate nth ;
-
-M: diagonal nth ( n diag -- elt ) diagonal@ nth ;
-
-M: diagonal set-nth ( elt n diag -- ) diagonal@ set-nth ;
-
 : zero-matrix ( m n -- matrix )
-    swap [ drop zero-vector ] map-with ;
+    swap [ drop zero-array ] map-with ;
 
 : identity-matrix ( n -- matrix )
     #! Make a nxn identity matrix.
-    dup zero-matrix dup <diagonal> [ drop 1 ] nmap ;
+    dup [ swap [ = 1 0 ? ] map-with ] map-with ;
 
 ! Matrix operations
 : mneg ( m -- m ) [ vneg ] map ;
@@ -99,5 +86,3 @@ M: diagonal set-nth ( elt n diag -- ) diagonal@ set-nth ;
 : v.m ( v m -- v ) flip [ v. ] map-with ;
 : m.v ( m v -- v ) swap [ v. ] map-with ;
 : m.  ( m m -- m ) flip swap [ m.v ] map-with ;
-
-: trace ( matrix -- tr ) <diagonal> product ;

library/sdl/sdl-event.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: sdl USING: alien generic kernel sequences-internals ;
+IN: sdl USING: alien arrays generic kernel ;
 
 BEGIN-ENUM: 0
     ENUM: SDL_NOEVENT         ! Unused (do not remove)

library/styles.factor

@@ -3,12 +3,12 @@
 IN: styles
 
 ! Colors are RGB triples.
-: black { 0   0   0   } ;
+: black @{ 0   0   0   }@ ;
-: gray  { 128 128 128 } ;
+: gray  @{ 128 128 128 }@ ;
-: white { 255 255 255 } ;
+: white @{ 255 255 255 }@ ;
-: red   { 255 0   0   } ;
+: red   @{ 255 0   0   }@ ;
-: green { 0   255 0   } ;
+: green @{ 0   255 0   }@ ;
-: blue  { 0   0   255 } ;
+: blue  @{ 0   0   255 }@ ;
 
 SYMBOL: foreground ! Used for text and outline shapes.
 SYMBOL: background ! Used for filled shapes.

library/syntax/generic.factor

@@ -3,8 +3,8 @@
 
 ! Bootstrapping trick; see doc/bootstrap.txt.
 IN: !syntax
-USING: generic kernel lists namespaces parser sequences syntax
+USING: arrays generic kernel lists namespaces parser sequences
-words ;
+syntax words ;
 
 : GENERIC:
     #! GENERIC: bar == G: bar simple-combination ;
@@ -51,4 +51,4 @@ words ;
 
 ! Tuples.
 : << f ; parsing
-: >> reverse literal-tuple swons ; parsing
+: >> reverse >array array>tuple swons ; parsing

library/syntax/parse-syntax.factor

@@ -3,7 +3,7 @@
 
 ! Bootstrapping trick; see doc/bootstrap.txt.
 IN: !syntax
-USING: alien errors generic hashtables kernel lists math
+USING: alien arrays errors generic hashtables kernel lists math
 namespaces parser sequences strings syntax vectors
 words ;
 
@@ -50,6 +50,10 @@ SYMBOL: t
 : [[ f ; parsing
 : ]] first2 swons swons ; parsing
 
+! Arrays
+: @{ f ; parsing
+: }@ reverse >array swons ; parsing
+
 ! Vectors
 : { f ; parsing
 : } reverse >vector swons ; parsing

library/syntax/prettyprint.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2003, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: prettyprint
-USING: alien generic hashtables io kernel lists math namespaces
+USING: alien arrays generic hashtables io kernel lists math
-parser sequences strings styles vectors words ;
+namespaces parser sequences strings styles vectors words ;
 
 ! State
 SYMBOL: column
@@ -155,7 +155,7 @@ M: block pprint-section* ( block -- )
 : end-blocks ( -- ) last-block? [ (block>) end-blocks ] unless ;
 
 C: pprinter ( -- stream )
-    <block> 1vector over set-pprinter-stack ;
+    <block> 1 <vector> [ push ] keep over set-pprinter-stack ;
 
 : do-pprint ( pprinter -- )
     [
@@ -226,6 +226,7 @@ M: string pprint* ( str -- str ) "\"" pprint-string ;
 M: sbuf pprint* ( str -- str ) "SBUF\" " pprint-string ;
 
 M: word pprint* ( word -- )
+    dup interned? [ "( uninterned )" f text ] unless
     dup "pprint-before-hook" word-prop call
     dup pprint-word
     "pprint-after-hook" word-prop call ;
@@ -269,14 +270,17 @@ M: dll pprint* ( obj -- str ) dll-path "DLL\" " pprint-string ;
     swap pprint* swap pprint-elements pprint* ;
 
 M: complex pprint* ( num -- )
-    >rect 2vector \ #{ \ }# pprint-sequence ;
+    >rect 2array \ #{ \ }# pprint-sequence ;
 
 M: cons pprint* ( list -- )
    [
-       dup list? [ \ [ \ ] ] [ uncons 2vector \ [[ \ ]] ] ifte
+       dup list? [ \ [ \ ] ] [ uncons 2array \ [[ \ ]] ] ifte
        pprint-sequence
    ] check-recursion ;
 
+M: array pprint* ( vector -- )
+    [ \ @{ \ }@ pprint-sequence ] check-recursion ;
+
 M: vector pprint* ( vector -- )
     [ \ { \ } pprint-sequence ] check-recursion ;
 
@@ -286,7 +290,7 @@ M: hashtable pprint* ( hashtable -- )
 M: tuple pprint* ( tuple -- )
     [
         \ << pprint*
-        <mirror> dup first pprint*
+        tuple>array dup first pprint*
         <block 1 swap tail-slice pprint-elements block>
         \ >> pprint*
     ] check-recursion ;
@@ -302,7 +306,7 @@ M: wrapper pprint* ( wrapper -- )
     dup wrapped word? [
         \ \ pprint-word wrapped pprint-word
     ] [
-        wrapped 1vector \ W[ \ ]W pprint-sequence
+        wrapped 1array \ W[ \ ]W pprint-sequence
     ] ifte ;
 
 : with-pprint ( quot -- )

library/test/alien.factor

@@ -1,5 +1,5 @@
 IN: temporary
-USING: alien kernel kernel-internals namespaces test ;
+USING: arrays alien kernel kernel-internals namespaces test ;
 
 [ t ] [ 0 <alien> 0 <alien> = ] unit-test
 [ f ] [ 0 <alien> 1024 <alien> = ] unit-test

library/test/collections/arrays.factor

@@ -0,0 +1,17 @@
+IN: temporary
+USING: arrays kernel sequences sequences-internals test vectors ;
+
+[ -2 @{ "a" "b" "c" }@ nth ] unit-test-fails
+[ 10 @{ "a" "b" "c" }@ nth ] unit-test-fails
+[ "hi" -2 @{ "a" "b" "c" }@ set-nth ] unit-test-fails
+[ "hi" 10 @{ "a" "b" "c" }@ set-nth ] unit-test-fails
+[ f ] [ @{ "a" "b" "c" }@ dup clone eq? ] unit-test
+[ "hi" ] [ "hi" 1 @{ "a" "b" "c" }@ clone [ set-nth ] keep second ] unit-test
+[ { "a" "b" "c" } ] [ @{ "a" "b" "c" }@ >vector ] unit-test
+[ f ] [ @{ "a" "b" "c" }@ dup >array eq? ] unit-test
+[ t ] [ @{ "a" "b" "c" }@ dup @{ }@ like eq? ] unit-test
+[ t ] [ @{ "a" "b" "c" }@ dup array>vector underlying eq? ] unit-test
+[ { "a" "b" "c" } ] [ @{ "a" "b" "c" }@ array>vector ] unit-test
+[ @{ "a" "b" "c" }@ ] [ @{ "a" }@ @{ "b" "c" }@ append ] unit-test
+[ @{ "a" "b" "c" "d" "e" }@ ]
+[ @{ "a" }@ @{ "b" "c" }@ @{ "d" "e" }@ append3 ] unit-test

library/test/collections/hashtables.factor

@@ -7,6 +7,7 @@ USE: namespaces
 USE: test
 USE: vectors
 USE: sequences
+USE: sequences-internals
 
 16 <hashtable> "testhash" set
 
@@ -63,7 +64,7 @@ f 100000000000000000000000000 "testhash" get set-hash
 [ 4 ] [
     "hey"
     {{ [[ "hey" 4 ]] [[ "whey" 5 ]] }} 2dup (hashcode)
-    swap buckets>vector nth assoc
+    swap underlying nth assoc
 ] unit-test
 
 ! Testing the hash element counting

library/test/collections/queues.factor

@@ -7,6 +7,6 @@ USING: kernel math namespaces queues sequences test ;
 
 [ ] [ [ 1 2 3 4 5 ] [ "queue" get enque ] each ] unit-test
 
-[ { 1 2 3 4 5 } ] [ 5 [ drop "queue" get deque ] map ] unit-test
+[ @{ 1 2 3 4 5 }@ ] [ 5 [ drop "queue" get deque ] map ] unit-test
 
 [ "queue" get deque ] unit-test-fails

library/test/collections/sequences.factor

@@ -1,10 +1,9 @@
 IN: temporary
-USING: kernel lists math sequences sorting-internals strings
+USING: kernel lists math sequences sequences-internals strings
 test vectors ;
 
 [ { 1 2 3 4 } ] [ 1 5 <range> >vector ] unit-test
 [ 3 ] [ 1 4 <range> length ] unit-test
-[ { 4 3 2 1 } ] [ 4 0 <range> >vector ] unit-test
 [ 2 ] [ 1 3 { 1 2 3 4 } <slice> length ] unit-test
 [ { 2 3 } ] [ 1 3 { 1 2 3 4 } <slice> >vector ] unit-test
 [ { 4 5 } ] [ 2 { 1 2 3 4 5 } tail-slice* >vector ] unit-test
@@ -12,8 +11,6 @@ test vectors ;
 [ { 3 4 } ] [ 0 2 2 4 1 10 <range> <slice> subseq >vector ] unit-test
 [ "cba" ] [ 3 "abcdef" head-slice reverse ] unit-test
 
-[ 1 2 3 ] [ 1 2 3 3vector first3 ] unit-test
-
 [ 5040 ] [ [ 1 2 3 4 5 6 7 ] 1 [ * ] reduce ] unit-test
 
 [ [ 1 1 2 6 24 120 720 ] ]
@@ -60,15 +57,12 @@ unit-test
 
 [ "" ] [ { } "" join ] unit-test
 
-[ { 1 2 }   ] [ 1 2   2vector ] unit-test
-[ { 1 2 3 } ] [ 1 2 3 3vector ] unit-test
-
 [ { } ] [ { } flip ] unit-test
 
-[ { "b" "e" } ] [ 1 { { "a" "b" "c" } { "d" "e" "f" } } flip nth ] unit-test
+[ @{ "b" "e" }@ ] [ 1 @{ @{ "a" "b" "c" }@ @{ "d" "e" "f" }@ }@ flip nth ] unit-test
 
-[ { { 1 4 } { 2 5 } { 3 6 } } ]
+[ @{ @{ 1 4 }@ @{ 2 5 }@ @{ 3 6 }@ }@ ]
-[ { { 1 2 3 } { 4 5 6 } } flip ] unit-test
+[ @{ @{ 1 2 3 }@ @{ 4 5 6 }@ }@ flip ] unit-test
 
 [ [ "a" 43 [ ] ] ] [ [ "a" 43 43 43 [ ] 43 "a" [ ] ] prune ] unit-test
 
@@ -155,3 +149,7 @@ unit-test
         1000 [ drop 0 1000 random-int ] map number-sort [ <= ] monotonic?
     ] all?
 ] unit-test
+
+[ @{ "" "a" "aa" "aaa" }@ ]
+[ 4 [ CHAR: a fill ] map ]
+unit-test

library/test/collections/vectors.factor

@@ -1,6 +1,6 @@
 IN: temporary
 USING: errors kernel kernel-internals lists math namespaces
-random sequences strings test vectors ;
+random sequences sequences-internals strings test vectors ;
 
 [ ] [ 10 [ [ -1000000 <vector> ] [ drop ] catch ] times ] unit-test
 
@@ -51,10 +51,6 @@ random sequences strings test vectors ;
 [ f ] [ f concat ] unit-test
 [ { 1 2 3 4 } ] [ [ { 1 } [ 2 ] { 3 4 } ] concat ] unit-test
 
-[ { "" "a" "aa" "aaa" } ]
-[ 4 [ CHAR: a fill ] map ]
-unit-test
-
 [ { } ] [ 0 { } tail ] unit-test
 [ { } ] [ 2 { 1 2 } tail ] unit-test
 [ { 3 4 } ] [ 2 { 1 2 3 4 } tail ] unit-test

library/test/compiler/intrinsics.factor

@@ -1,5 +1,5 @@
 IN: temporary
-USING: compiler kernel kernel-internals lists math
+USING: arrays compiler kernel kernel-internals lists math
 math-internals sequences test words ;
 
 ! Make sure that intrinsic ops compile to correct code.

library/test/compiler/optimizer.factor

@@ -1,7 +1,7 @@
 IN: temporary
-USING: assembler compiler compiler-backend generic inference
+USING: arrays assembler compiler compiler-backend generic
-kernel kernel-internals lists math optimizer prettyprint
+inference kernel kernel-internals lists math optimizer
-sequences strings test vectors words ;
+prettyprint sequences strings test vectors words ;
 
 : kill-1
     [ 1 2 3 ] [ + ] over drop drop ; compiled
@@ -91,8 +91,8 @@ sequences strings test vectors words ;
 ! Test method inlining
 [ string ] [
     \ string
-    [ repeated integer string mirror array reversed sbuf
+    [ repeated integer string array reversed sbuf
-    slice vector diagonal general-list ]
+    slice vector general-list ]
     min-class
 ] unit-test
 

library/test/gadgets/frames.factor

@@ -9,57 +9,57 @@ test ;
     "frame" get 1 2 frame-child label-text
 ] unit-test
 
-[ { { 2 2 2 } { 3 3 3 } { 4 4 4 } } ] [
+[ @{ @{ 2 2 2 }@ @{ 3 3 3 }@ @{ 4 4 4 }@ }@ ] [
-    {
+    @{
-        { { 0 0 0 } { 1 1 1 } { 2 2 2 } }
+        @{ @{ 0 0 0 }@ @{ 1 1 1 }@ @{ 2 2 2 }@ }@
-        { { 0 0 0 } { 3 3 3 } { 0 0 0 } }
+        @{ @{ 0 0 0 }@ @{ 3 3 3 }@ @{ 0 0 0 }@ }@
-        { { 0 0 0 } { 0 0 0 } { 4 4 4 } }
+        @{ @{ 0 0 0 }@ @{ 0 0 0 }@ @{ 4 4 4 }@ }@
-    } reduce-grid
+    }@ reduce-grid
 ] unit-test
 
-[ { 9 9 9 } ] [
+[ @{ 9 9 9 }@ ] [
-    {
+    @{
-        { { 0 0 0 } { 1 1 1 } { 2 2 2 } }
+        @{ @{ 0 0 0 }@ @{ 1 1 1 }@ @{ 2 2 2 }@ }@
-        { { 0 0 0 } { 3 3 3 } { 0 0 0 } }
+        @{ @{ 0 0 0 }@ @{ 3 3 3 }@ @{ 0 0 0 }@ }@
-        { { 0 0 0 } { 0 0 0 } { 4 4 4 } }
+        @{ @{ 0 0 0 }@ @{ 0 0 0 }@ @{ 4 4 4 }@ }@
-    } frame-pref-dim
+    }@ frame-pref-dim
 ] unit-test
 
 [
-    {
+    @{
-        { { 1 2 0 } { 2 2 0 } { 3 2 0 } }
+        @{ @{ 1 2 0 }@ @{ 2 2 0 }@ @{ 3 2 0 }@ }@
-        { { 1 4 0 } { 2 4 0 } { 3 4 0 } }
+        @{ @{ 1 4 0 }@ @{ 2 4 0 }@ @{ 3 4 0 }@ }@
-    }
+    }@
 ] [
-    { 1 2 3 } { 2 4 } frame-layout
+    @{ 1 2 3 }@ @{ 2 4 }@ frame-layout
 ] unit-test
 
 : sized-gadget ( dim -- gadget )
     <gadget> [ set-rect-dim ] keep ;
 
-[ { 90 120 0 } ]
+[ @{ 90 120 0 }@ ]
 [
     <frame> "frame" set
-    { 10 20 0 } sized-gadget "frame" get 1 2 set-frame-child
+    @{ 10 20 0 }@ sized-gadget "frame" get 1 2 set-frame-child
-    { 30 40 0 } sized-gadget "frame" get 2 0 set-frame-child
+    @{ 30 40 0 }@ sized-gadget "frame" get 2 0 set-frame-child
-    { 50 60 0 } sized-gadget "frame" get 0 1 set-frame-child
+    @{ 50 60 0 }@ sized-gadget "frame" get 0 1 set-frame-child
     "frame" get pref-dim
 ] unit-test
 
-[ { 180 210 0 } ]
+[ @{ 180 210 0 }@ ]
 [
     <frame> "frame" set
-    { 10 20 0 } sized-gadget "frame" get add-bottom
+    @{ 10 20 0 }@ sized-gadget "frame" get add-bottom
-    { 30 40 0 } sized-gadget "frame" get 2 0 set-frame-child
+    @{ 30 40 0 }@ sized-gadget "frame" get 2 0 set-frame-child
-    { 50 60 0 } sized-gadget "frame" get add-left
+    @{ 50 60 0 }@ sized-gadget "frame" get add-left
-    { 100 150 0 } sized-gadget "frame" get add-center
+    @{ 100 150 0 }@ sized-gadget "frame" get add-center
     "frame" get pref-dim
 ] unit-test
 
-[ { 30 60 0 } ]
+[ @{ 30 60 0 }@ ]
 [
     <frame> "frame" set
-    { 10 20 0 } sized-gadget "frame" get add-top
+    @{ 10 20 0 }@ sized-gadget "frame" get add-top
-    { 30 40 0 } sized-gadget "frame" get add-center
+    @{ 30 40 0 }@ sized-gadget "frame" get add-center
     "frame" get pref-dim
 ] unit-test

library/test/gadgets/gradients.factor

@@ -1,17 +1,17 @@
 IN: temporary
 USING: gadgets namespaces styles test ;
 
-[ { 255 0 0 } ] [ { 1 0 0 } red green <gradient> 0 gradient-color ] unit-test
+[ @{ 255 0 0 }@ ] [ @{ 1 0 0 }@ red green <gradient> 0 gradient-color ] unit-test
-[ { 0 255 0 } ] [ { 1 0 0 } red green <gradient> 1 gradient-color ] unit-test
+[ @{ 0 255 0 }@ ] [ @{ 1 0 0 }@ red green <gradient> 1 gradient-color ] unit-test
 
-[ 0 100 0 { 255 0 0 } ]
+[ 0 100 0 @{ 255 0 0 }@ ]
-[ { 0 1 0 } red green <gradient> { 100 200 0 } 0 (gradient-x) ] unit-test
+[ @{ 0 1 0 }@ red green <gradient> @{ 100 200 0 }@ 0 (gradient-x) ] unit-test
 
-[ 0 100 100 { 255/2 255/2 0 } ]
+[ 0 100 100 @{ 255/2 255/2 0 }@ ]
-[ { 0 1 0 } red green <gradient> { 100 200 0 } 100 (gradient-x) ] unit-test
+[ @{ 0 1 0 }@ red green <gradient> @{ 100 200 0 }@ 100 (gradient-x) ] unit-test
 
-[ 0 0 200 { 255 0 0 } ]
+[ 0 0 200 @{ 255 0 0 }@ ]
-[ { 1 0 0 } red green <gradient> { 100 200 0 } 0 (gradient-y) ] unit-test
+[ @{ 1 0 0 }@ red green <gradient> @{ 100 200 0 }@ 0 (gradient-y) ] unit-test
 
-[ 50 0 200 { 255/2 255/2 0 } ]
+[ 50 0 200 @{ 255/2 255/2 0 }@ ]
-[ { 1 0 0 } red green <gradient> { 100 200 0 } 50 (gradient-y) ] unit-test
+[ @{ 1 0 0 }@ red green <gradient> @{ 100 200 0 }@ 50 (gradient-y) ] unit-test

library/test/gadgets/rectangles.factor

@@ -1,32 +1,32 @@
 USING: gadgets kernel namespaces test ;
-[ << rect f { 10 10 0 } { 20 20 0 } >> ]
+[ << rect f @{ 10 10 0 }@ @{ 20 20 0 }@ >> ]
 [
-    << rect f { 10 10 0 } { 50 50 0 } >>
+    << rect f @{ 10 10 0 }@ @{ 50 50 0 }@ >>
-    << rect f { -10 -10 0 } { 40 40 0 } >>
+    << rect f @{ -10 -10 0 }@ @{ 40 40 0 }@ >>
     intersect
 ] unit-test
 
-[ << rect f { 200 200 0 } { 0 0 0 } >> ]
+[ << rect f @{ 200 200 0 }@ @{ 0 0 0 }@ >> ]
 [
-    << rect f { 100 100 0 } { 50 50 0 } >>
+    << rect f @{ 100 100 0 }@ @{ 50 50 0 }@ >>
-    << rect f { 200 200 0 } { 40 40 0 } >>
+    << rect f @{ 200 200 0 }@ @{ 40 40 0 }@ >>
     intersect
 ] unit-test
 
 [ f ] [
-    << rect f { 100 100 0 } { 50 50 0 } >>
+    << rect f @{ 100 100 0 }@ @{ 50 50 0 }@ >>
-    << rect f { 200 200 0 } { 40 40 0 } >>
+    << rect f @{ 200 200 0 }@ @{ 40 40 0 }@ >>
     intersects?
 ] unit-test
 
 [ t ] [
-    << rect f { 100 100 0 } { 50 50 0 } >>
+    << rect f @{ 100 100 0 }@ @{ 50 50 0 }@ >>
-    << rect f { 120 120 0 } { 40 40 0 } >>
+    << rect f @{ 120 120 0 }@ @{ 40 40 0 }@ >>
     intersects?
 ] unit-test
 
 [ f ] [
-    << rect f { 1000 100 0 } { 50 50 0 } >>
+    << rect f @{ 1000 100 0 }@ @{ 50 50 0 }@ >>
-    << rect f { 120 120 0 } { 40 40 0 } >>
+    << rect f @{ 120 120 0 }@ @{ 40 40 0 }@ >>
     intersects?
 ] unit-test

library/test/generic.factor

@@ -111,8 +111,8 @@ M: very-funny gooey sq ;
 [ f ] [ \ cons \ list class< ] unit-test
 [ f ] [ \ list \ cons class< ] unit-test
 
-[ f ] [ \ mirror \ slice class< ] unit-test
+[ f ] [ \ reversed \ slice class< ] unit-test
-[ f ] [ \ slice \ mirror class< ] unit-test
+[ f ] [ \ slice \ reversed class< ] unit-test
 
 DEFER: bah
 FORGET: bah

library/test/inference.factor

@@ -1,5 +1,5 @@
 IN: temporary
-USING: generic inference kernel lists math math-internals
+USING: arrays generic inference kernel lists math math-internals
 namespaces parser sequences test vectors ;
 
 [
@@ -18,23 +18,23 @@ namespaces parser sequences test vectors ;
     compose-shuffle
 ] unit-test
 
-: simple-effect first2 >r length r> length 2vector ;
+: simple-effect first2 >r length r> length 2array ;
 
-[ { 0 2 } ] [ [ 2 "Hello" ] infer simple-effect ] unit-test
+[ @{ 0 2 }@ ] [ [ 2 "Hello" ] infer simple-effect ] unit-test
-[ { 1 2 } ] [ [ dup ] infer simple-effect ] unit-test
+[ @{ 1 2 }@ ] [ [ dup ] infer simple-effect ] unit-test
 
-[ { 1 2 } ] [ [ [ dup ] call ] infer simple-effect ] unit-test
+[ @{ 1 2 }@ ] [ [ [ dup ] call ] infer simple-effect ] unit-test
 [ [ call ] infer simple-effect ] unit-test-fails
 
-[ { 2 4 } ] [ [ 2dup ] infer simple-effect ] unit-test
+[ @{ 2 4 }@ ] [ [ 2dup ] infer simple-effect ] unit-test
 
-[ { 1 0 } ] [ [ [ ] [ ] ifte ] infer simple-effect ] unit-test
+[ @{ 1 0 }@ ] [ [ [ ] [ ] ifte ] infer simple-effect ] unit-test
 [ [ ifte ] infer simple-effect ] unit-test-fails
 [ [ [ ] ifte ] infer simple-effect ] unit-test-fails
 [ [ [ 2 ] [ ] ifte ] infer simple-effect ] unit-test-fails
-[ { 4 3 } ] [ [ [ rot ] [ -rot ] ifte ] infer simple-effect ] unit-test
+[ @{ 4 3 }@ ] [ [ [ rot ] [ -rot ] ifte ] infer simple-effect ] unit-test
 
-[ { 4 3 } ] [
+[ @{ 4 3 }@ ] [
     [
         [
             [ swap 3 ] [ nip 5 5 ] ifte
@@ -44,14 +44,14 @@ namespaces parser sequences test vectors ;
     ] infer simple-effect
 ] unit-test
 
-[ { 1 1 } ] [ [ dup [ ] when ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ dup [ ] when ] infer simple-effect ] unit-test
-[ { 1 1 } ] [ [ dup [ dup fixnum* ] when ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ dup [ dup fixnum* ] when ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ [ dup fixnum* ] when ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ [ dup fixnum* ] when ] infer simple-effect ] unit-test
 
-[ { 1 0 } ] [ [ [ drop ] when* ] infer simple-effect ] unit-test
+[ @{ 1 0 }@ ] [ [ [ drop ] when* ] infer simple-effect ] unit-test
-[ { 1 1 } ] [ [ [ { { [ ] } } ] unless* ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ [ { { [ ] } } ] unless* ] infer simple-effect ] unit-test
 
-[ { 0 1 } ] [
+[ @{ 0 1 }@ ] [
     [ [ 2 2 fixnum+ ] dup [ ] when call ] infer simple-effect
 ] unit-test
 
@@ -64,12 +64,12 @@ namespaces parser sequences test vectors ;
 : simple-recursion-1
     dup [ simple-recursion-1 ] [ ] ifte ;
 
-[ { 1 1 } ] [ [ simple-recursion-1 ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ simple-recursion-1 ] infer simple-effect ] unit-test
 
 : simple-recursion-2
     dup [ ] [ simple-recursion-2 ] ifte ;
 
-[ { 1 1 } ] [ [ simple-recursion-2 ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ simple-recursion-2 ] infer simple-effect ] unit-test
 
 : bad-recursion-2
     dup [ uncons bad-recursion-2 ] [ ] ifte ;
@@ -81,10 +81,10 @@ namespaces parser sequences test vectors ;
 : funny-recursion
     dup [ funny-recursion 1 ] [ 2 ] ifte drop ;
 
-[ { 1 1 } ] [ [ funny-recursion ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ funny-recursion ] infer simple-effect ] unit-test
 
 ! Simple combinators
-[ { 1 2 } ] [ [ [ car ] keep cdr ] infer simple-effect ] unit-test
+[ @{ 1 2 }@ ] [ [ [ car ] keep cdr ] infer simple-effect ] unit-test
 
 ! Mutual recursion
 DEFER: foe
@@ -107,8 +107,8 @@ DEFER: foe
         2drop f
     ] ifte ;
 
-[ { 2 1 } ] [ [ fie ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ fie ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ foe ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ foe ] infer simple-effect ] unit-test
 
 : nested-when ( -- )
     t [
@@ -117,7 +117,7 @@ DEFER: foe
         ] when
     ] when ;
 
-[ { 0 0 } ] [ [ nested-when ] infer simple-effect ] unit-test
+[ @{ 0 0 }@ ] [ [ nested-when ] infer simple-effect ] unit-test
 
 : nested-when* ( -- )
     [
@@ -126,11 +126,11 @@ DEFER: foe
         ] when*
     ] when* ;
 
-[ { 1 0 } ] [ [ nested-when* ] infer simple-effect ] unit-test
+[ @{ 1 0 }@ ] [ [ nested-when* ] infer simple-effect ] unit-test
 
 SYMBOL: sym-test
 
-[ { 0 1 } ] [ [ sym-test ] infer simple-effect ] unit-test
+[ @{ 0 1 }@ ] [ [ sym-test ] infer simple-effect ] unit-test
 
 : terminator-branch
     dup [
@@ -139,7 +139,7 @@ SYMBOL: sym-test
         not-a-number
     ] ifte ;
 
-[ { 1 1 } ] [ [ terminator-branch ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ terminator-branch ] infer simple-effect ] unit-test
 
 : recursive-terminator
     dup [
@@ -148,7 +148,7 @@ SYMBOL: sym-test
         not-a-number
     ] ifte ;
 
-[ { 1 1 } ] [ [ recursive-terminator ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ recursive-terminator ] infer simple-effect ] unit-test
 
 GENERIC: potential-hang
 M: fixnum potential-hang dup [ potential-hang ] when ;
@@ -161,7 +161,7 @@ M: funny-cons iterate funny-cons-cdr iterate ;
 M: f iterate drop ;
 M: real iterate drop ;
 
-[ { 1 0 } ] [ [ iterate ] infer simple-effect ] unit-test
+[ @{ 1 0 }@ ] [ [ iterate ] infer simple-effect ] unit-test
 
 [ [ callstack ] infer simple-effect ] unit-test-fails
 
@@ -177,53 +177,51 @@ DEFER: agent
 : no-base-case-2 no-base-case-2 ;
 [ [ no-base-case-2 ] infer ] unit-test-fails
 
-[ { 2 1 } ] [ [ 2vector ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ swons ] infer simple-effect ] unit-test
-[ { 3 1 } ] [ [ 3vector ] infer simple-effect ] unit-test
+[ @{ 1 2 }@ ] [ [ uncons ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ swons ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ unit ] infer simple-effect ] unit-test
-[ { 1 2 } ] [ [ uncons ] infer simple-effect ] unit-test
+[ @{ 1 2 }@ ] [ [ unswons ] infer simple-effect ] unit-test
-[ { 1 1 } ] [ [ unit ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ last ] infer simple-effect ] unit-test
-[ { 1 2 } ] [ [ unswons ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ list? ] infer simple-effect ] unit-test
-[ { 1 1 } ] [ [ last ] infer simple-effect ] unit-test
-[ { 1 1 } ] [ [ list? ] infer simple-effect ] unit-test
 
-[ { 1 0 } ] [ [ >n ] infer simple-effect ] unit-test
+[ @{ 1 0 }@ ] [ [ >n ] infer simple-effect ] unit-test
-[ { 0 1 } ] [ [ n> ] infer simple-effect ] unit-test
+[ @{ 0 1 }@ ] [ [ n> ] infer simple-effect ] unit-test
 
-[ { 2 1 } ] [ [ bitor ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ bitor ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ bitand ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ bitand ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ bitxor ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ bitxor ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ mod ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ mod ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ /i ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ /i ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ /f ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ /f ] infer simple-effect ] unit-test
-[ { 2 2 } ] [ [ /mod ] infer simple-effect ] unit-test
+[ @{ 2 2 }@ ] [ [ /mod ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ + ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ + ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ - ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ - ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ * ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ * ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ / ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ / ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ < ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ < ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ <= ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ <= ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ > ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ > ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ >= ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ >= ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ number= ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ number= ] infer simple-effect ] unit-test
 
-[ { 1 1 } ] [ [ string>number ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ string>number ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ = ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ = ] infer simple-effect ] unit-test
-[ { 1 1 } ] [ [ get ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ get ] infer simple-effect ] unit-test
 
-[ { 2 0 } ] [ [ push ] infer simple-effect ] unit-test
+[ @{ 2 0 }@ ] [ [ push ] infer simple-effect ] unit-test
-[ { 2 0 } ] [ [ set-length ] infer simple-effect ] unit-test
+[ @{ 2 0 }@ ] [ [ set-length ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ append ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ append ] infer simple-effect ] unit-test
-[ { 1 1 } ] [ [ peek ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ peek ] infer simple-effect ] unit-test
 
-[ { 1 1 } ] [ [ length ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ length ] infer simple-effect ] unit-test
-[ { 1 1 } ] [ [ reverse ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ reverse ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ member? ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ member? ] infer simple-effect ] unit-test
-[ { 2 1 } ] [ [ remove ] infer simple-effect ] unit-test
+[ @{ 2 1 }@ ] [ [ remove ] infer simple-effect ] unit-test
-[ { 1 1 } ] [ [ prune ] infer simple-effect ] unit-test
+[ @{ 1 1 }@ ] [ [ prune ] infer simple-effect ] unit-test
 
 : bad-code "1234" car ;
 
-[ { 0 1 } ] [ [ bad-code ] infer simple-effect ] unit-test
+[ @{ 0 1 }@ ] [ [ bad-code ] infer simple-effect ] unit-test
 
 ! This form should not have a stack effect
 ! : bad-bin 5 [ 5 bad-bin bad-bin 5 ] [ 2drop ] ifte ;

library/test/math/matrices.factor

@@ -3,123 +3,123 @@ USING: kernel lists math matrices namespaces sequences test
 vectors ;
 
 [
-    { { 0 } { 0 } { 0 } }
+    @{ @{ 0 }@ @{ 0 }@ @{ 0 }@ }@
 ] [
     3 1 zero-matrix
 ] unit-test
 
 [
-    { { 1 0 0 }
+    @{ @{ 1 0 0 }@
-       { 0 1 0 }
+       @{ 0 1 0 }@
-       { 0 0 1 } }
+       @{ 0 0 1 }@ }@
 ] [
     3 identity-matrix
 ] unit-test
 
 [
-    { { 1 0 4 }
+    @{ @{ 1 0 4 }@
-       { 0 7 0 }
+       @{ 0 7 0 }@
-       { 6 0 3 } }
+       @{ 6 0 3 }@ }@
 ] [
-    { { 1 0 0 }
+    @{ @{ 1 0 0 }@
-       { 0 2 0 }
+       @{ 0 2 0 }@
-       { 0 0 3 } }
+       @{ 0 0 3 }@ }@
        
-    { { 0 0 4 }
+    @{ @{ 0 0 4 }@
-       { 0 5 0 }
+       @{ 0 5 0 }@
-       { 6 0 0 } }
+       @{ 6 0 0 }@ }@
 
     m+
 ] unit-test
 
 [
-    { { 1 0 4 }
+    @{ @{ 1 0 4 }@
-       { 0 7 0 }
+       @{ 0 7 0 }@
-       { 6 0 3 } }
+       @{ 6 0 3 }@ }@
 ] [
-    { { 1 0 0 }
+    @{ @{ 1 0 0 }@
-       { 0 2 0 }
+       @{ 0 2 0 }@
-       { 0 0 3 } }
+       @{ 0 0 3 }@ }@
        
-    { { 0 0 -4 }
+    @{ @{ 0 0 -4 }@
-       { 0 -5 0 }
+       @{ 0 -5 0 }@
-       { -6 0 0 } }
+       @{ -6 0 0 }@ }@
 
     m-
 ] unit-test
 
 [
-    { 10 20 30 }
+    @{ 10 20 30 }@
 ] [
-    10 { 1 2 3 } n*v
+    10 @{ 1 2 3 }@ n*v
 ] unit-test
 
 [
-    { 3 4 }
+    @{ 3 4 }@
 ] [
-    { { 1 0 }
+    @{ @{ 1 0 }@
-       { 0 1 } }
+       @{ 0 1 }@ }@
 
-    { 3 4 }
+    @{ 3 4 }@
 
     m.v
 ] unit-test
 
 [
-    { 4 3 }
+    @{ 4 3 }@
 ] [
-    { { 0 1 }
+    @{ @{ 0 1 }@
-       { 1 0 } }
+       @{ 1 0 }@ }@
 
-    { 3 4 }
+    @{ 3 4 }@
 
     m.v
 ] unit-test
 
-[ { 0 0 1 } ] [ { 1 0 0 } { 0 1 0 } cross ] unit-test
+[ @{ 0 0 1 }@ ] [ @{ 1 0 0 }@ @{ 0 1 0 }@ cross ] unit-test
-[ { 1 0 0 } ] [ { 0 1 0 } { 0 0 1 } cross ] unit-test
+[ @{ 1 0 0 }@ ] [ @{ 0 1 0 }@ @{ 0 0 1 }@ cross ] unit-test
-[ { 0 1 0 } ] [ { 0 0 1 } { 1 0 0 } cross ] unit-test
+[ @{ 0 1 0 }@ ] [ @{ 0 0 1 }@ @{ 1 0 0 }@ cross ] unit-test
 
-[ { { 1 2 } { 3 4 } { 5 6 } } ]
+[ @{ @{ 1 2 }@ @{ 3 4 }@ @{ 5 6 }@ }@ ]
-[ { { 1 2 } { 3 4 } { 5 6 } } flip flip ]
+[ @{ @{ 1 2 }@ @{ 3 4 }@ @{ 5 6 }@ }@ flip flip ]
 unit-test
 
-[ { { 1 3 5 } { 2 4 6 } } ]
+[ @{ @{ 1 3 5 }@ @{ 2 4 6 }@ }@ ]
-[ { { 1 3 5 } { 2 4 6 } } flip flip ]
+[ @{ @{ 1 3 5 }@ @{ 2 4 6 }@ }@ flip flip ]
 unit-test
 
-[ { { 1 3 5 } { 2 4 6 } } ]
+[ @{ @{ 1 3 5 }@ @{ 2 4 6 }@ }@ ]
-[ { { 1 2 } { 3 4 } { 5 6 } } flip ]
+[ @{ @{ 1 2 }@ @{ 3 4 }@ @{ 5 6 }@ }@ flip ]
 unit-test
 
-[ { t t t } ]
+[ @{ t t t }@ ]
-[ { 1 2 3 } { -1 -2 -3 } { 4 5 6 } vbetween? ]
+[ @{ 1 2 3 }@ @{ -1 -2 -3 }@ @{ 4 5 6 }@ vbetween? ]
 unit-test
 
-[ { t f t } ]
+[ @{ t f t }@ ]
-[ { 1 10 3 } { -1 -2 -3 } { 4 5 6 } vbetween? ]
+[ @{ 1 10 3 }@ @{ -1 -2 -3 }@ @{ 4 5 6 }@ vbetween? ]
 unit-test
 
 [
-    { { 6 } }
+    @{ @{ 6 }@ }@
 ] [
-    { { 3 } } { { 2 } } m.
+    @{ @{ 3 }@ }@ @{ @{ 2 }@ }@ m.
 ] unit-test
 
 [
-    { { 11 } }
+    @{ @{ 11 }@ }@
 ] [
-    { { 1 3 } } { { 5 } { 2 } } m.
+    @{ @{ 1 3 }@ }@ @{ @{ 5 }@ @{ 2 }@ }@ m.
 ] unit-test
 
 [
-    { { 28 } }
+    @{ @{ 28 }@ }@
 ] [
-    { { 2 4 6 } }
+    @{ @{ 2 4 6 }@ }@
 
-    { { 1 }
+    @{ @{ 1 }@
-       { 2 }
+       @{ 2 }@
-       { 3 } }
+       @{ 3 }@ }@
     
     m.
 ] unit-test

library/test/test.factor

@@ -1,8 +1,8 @@
 ! Factor test suite.
 
 IN: test
-USING: errors kernel lists math memory namespaces parser
+USING: arrays errors kernel lists math memory namespaces parser
-prettyprint sequences io strings vectors words ;
+prettyprint sequences io strings words ;
 
 TUPLE: assert got expect ;
 
@@ -15,7 +15,7 @@ M: assert error.
     2dup = [ 2drop ] [ <assert> throw ] ifte ;
 
 : print-test ( input output -- )
-    "--> " write 2vector . flush ;
+    "--> " write 2array . flush ;
 
 : time ( code -- )
     #! Evaluates the given code and prints the time taken to
@@ -74,22 +74,26 @@ SYMBOL: failures
 : tests
     {
         "lists/cons" "lists/lists" "lists/assoc"
-        "lists/namespaces" "lists/queues"
+        "lists/namespaces"
         "combinators"
-        "continuations" "errors" "hashtables" "strings"
+        "continuations" "errors"
-        "namespaces" "generic" "tuple" "files" "parser"
+        "collections/hashtables" "collections/sbuf"
+        "collections/strings" "collections/namespaces"
+        "collections/vectors" "collections/sequences"
+        "collections/queues"
+        "generic" "tuple" "files" "parser"
         "parse-number" "init" "io/io"
-        "vectors" "words" "prettyprint" "random"
+        "words" "prettyprint" "random"
         "stream" "math/bitops"
         "math/math-combinators" "math/rational" "math/float"
         "math/complex" "math/irrational" "math/integer"
         "math/matrices"
         "httpd/url-encoding" "httpd/html" "httpd/httpd"
-        "httpd/http-client" "sbuf" "threads" "parsing-word"
+        "httpd/http-client" "threads" "parsing-word"
         "inference" "interpreter" "alien"
         "gadgets/line-editor" "gadgets/rectangles"
         "gadgets/gradients" "gadgets/frames" "memory"
-        "redefine" "annotate" "sequences" "binary" "inspector"
+        "redefine" "annotate" "binary" "inspector"
         "kernel"
     } run-tests ;
 

library/tools/inspector.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: inspector
-USING: generic hashtables io kernel listener
+USING: arrays generic hashtables io kernel listener
 lists math memory namespaces prettyprint sequences
-sequences-internals strings styles test vectors words ;
+strings styles test vectors words ;
 
 GENERIC: sheet ( obj -- sheet )
 
@@ -11,15 +11,15 @@ M: object sheet ( obj -- sheet )
     dup class "slots" word-prop
     [ second ] map
     tuck [ execute ] map-with
-    2vector ;
+    2array ;
 
-M: list sheet 1vector ;
+M: list sheet 1array ;
 
-M: vector sheet 1vector ;
+M: vector sheet 1array ;
 
-M: array sheet 1vector ;
+M: array sheet 1array ;
 
-M: hashtable sheet dup hash-keys swap hash-values 2vector ;
+M: hashtable sheet dup hash-keys swap hash-values 2array ;
 
 : format-column ( list -- list )
     [ unparse-short ] map
@@ -27,7 +27,7 @@ M: hashtable sheet dup hash-keys swap hash-values 2vector ;
     [ swap CHAR: \s pad-right ] map-with ;
 
 : sheet-numbers ( sheet -- sheet )
-    dup first length >vector 1vector swap append ;
+    dup first length >vector 1array swap append ;
 
 SYMBOL: inspector-slots
 

library/tools/jedit.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: jedit
-USING: errors io kernel lists math namespaces parser prettyprint
+USING: arrays errors io kernel lists math namespaces parser
-sequences strings unparser vectors words ;
+prettyprint sequences strings unparser words ;
 
 ! Some words to send requests to a running jEdit instance to
 ! edit files and position the cursor on a specific line number.
@@ -34,11 +34,11 @@ sequences strings unparser vectors words ;
     ] with-stream ;
 
 : jedit-line/file ( file line -- )
-    number>string "+line:" swap append 2vector
+    number>string "+line:" swap append 2array
     make-jedit-request send-jedit-request ;
 
 : jedit-file ( file -- )
-    1vector make-jedit-request send-jedit-request ;
+    1array make-jedit-request send-jedit-request ;
 
 : jedit ( word -- )
     #! Note that line numbers here start from 1

library/tools/memory.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: memory
-USING: errors generic hashtables io kernel kernel-internals
+USING: arrays errors generic hashtables io kernel
-lists math namespaces parser prettyprint sequences
+kernel-internals lists math namespaces parser prettyprint
-sequences-internals strings unparser vectors words ;
+sequences strings unparser vectors words ;
 
 : generations 15 getenv ;
 
@@ -83,7 +83,7 @@ M: object each-slot ( obj quot -- )
 
 : heap-stats ( -- counts sizes )
     #! Return a list of instance count/total size pairs.
-    num-types zero-vector num-types zero-vector
+    num-types zero-array num-types zero-array
     [ >r 2dup r> heap-stat-step ] each-object ;
 
 : heap-stat. ( type instances bytes -- )

library/ui/books.factor

@@ -12,12 +12,12 @@ C: book ( pages -- book )
     [ add-gadgets ] keep ;
 
 M: book pref-dim ( book -- dim )
-    gadget-children [ pref-dim ] map { 0 0 0 } [ vmax ] reduce ;
+    gadget-children [ pref-dim ] map @{ 0 0 0 }@ [ vmax ] reduce ;
 
 M: book layout* ( book -- )
     dup rect-dim over gadget-children [
         f over set-gadget-visible?
-        { 0 0 0 } over set-rect-loc
+        @{ 0 0 0 }@ over set-rect-loc
         set-gadget-dim
     ] each-with
     dup book-page swap gadget-children nth

library/ui/borders.factor

@@ -12,13 +12,13 @@ C: border ( child delegate size -- border )
     [ add-gadget ] keep ;
 
 : empty-border ( child -- border )
-    <gadget> { 5 5 0 } <border> ;
+    <gadget> @{ 5 5 0 }@ <border> ;
 
 : line-border ( child -- border )
-    <etched-gadget> { 5 5 0 } <border> ;
+    <etched-gadget> @{ 5 5 0 }@ <border> ;
 
 : bevel-border ( child -- border )
-    <bevel-gadget> { 5 5 0 } <border> ;
+    <bevel-gadget> @{ 5 5 0 }@ <border> ;
 
 : layout-border-loc ( border -- )
     dup border-size swap gadget-child set-rect-loc ;

library/ui/buttons.factor

@@ -30,7 +30,7 @@ lists math namespaces sdl sequences sequences styles threads ;
     [ [ action ] swap handle-gesture ] when drop ;
 
 : button-theme ( button -- )
-    dup { 216 216 216 } background set-paint-prop
+    dup @{ 216 216 216 }@ background set-paint-prop
     dup f reverse-video set-paint-prop
     << solid >> interior set-paint-prop ;
 

library/ui/editors.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-editors
-USING: gadgets gadgets-labels gadgets-layouts gadgets-scrolling
+USING: arrays gadgets gadgets-labels gadgets-layouts
-generic kernel math namespaces sdl sequences strings styles
+gadgets-scrolling generic kernel math namespaces sdl sequences
-threads vectors ;
+strings styles threads ;
 
 ! A blinking caret
 TUPLE: caret ;
@@ -57,7 +57,7 @@ TUPLE: editor line caret ;
 
 : run-char-widths ( font str -- wlist )
     #! List of x co-ordinates of each character.
-    >vector [ ch>string size-string drop ] map-with
+    >array [ ch>string size-string drop ] map-with
     dup 0 [ + ] accumulate swap 2 v/n v+ ;
 
 : x>offset ( x font str -- offset )
@@ -98,16 +98,16 @@ C: editor ( text -- )
 
 : caret-loc ( editor -- x y )
     dup editor-line [ caret get line-text get ] bind offset>x
-    0 0 3vector ;
+    0 0 3array ;
 
 : caret-dim ( editor -- w h )
-    rect-dim { 0 1 1 } v* { 1 0 0 } v+ ;
+    rect-dim @{ 0 1 1 }@ v* @{ 1 0 0 }@ v+ ;
 
 M: editor user-input* ( ch editor -- ? )
     [ insert-char ] with-editor  t ;
 
 M: editor pref-dim ( editor -- dim )
-    dup editor-text label-size { 1 0 0 } v+ ;
+    dup editor-text label-size @{ 1 0 0 }@ v+ ;
 
 M: editor layout* ( editor -- )
     dup editor-caret over caret-dim swap set-gadget-dim

library/ui/events.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: alien gadgets-layouts generic kernel lists math
+USING: arrays alien gadgets-layouts generic kernel lists math
-namespaces sdl sequences vectors ;
+namespaces sdl sequences ;
 
 GENERIC: handle-event ( event -- )
 
@@ -14,7 +14,7 @@ M: quit-event handle-event ( event -- )
 
 M: resize-event handle-event ( event -- )
     dup resize-event-w swap resize-event-h
-    [ 0 3vector world get set-gadget-dim ] 2keep
+    [ 0 3array world get set-gadget-dim ] 2keep
     0 SDL_HWSURFACE SDL_RESIZABLE bitor init-screen
     world get relayout ;
 
@@ -30,7 +30,7 @@ M: button-up-event handle-event ( event -- )
     [ button-up ] button-gesture ;
 
 : motion-event-loc ( event -- loc )
-    dup motion-event-x swap motion-event-y 0 3vector ;
+    dup motion-event-x swap motion-event-y 0 3array ;
 
 M: motion-event handle-event ( event -- )
     motion-event-loc hand move-hand ;

library/ui/fonts.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: alien hashtables io kernel lists namespaces sdl sequences
+USING: alien arrays hashtables io kernel lists namespaces sdl
-styles vectors ;
+sequences styles ;
 
 : ttf-name ( font style -- name )
     cons {{
@@ -29,7 +29,7 @@ styles vectors ;
 SYMBOL: open-fonts
 
 : lookup-font ( font style ptsize -- font )
-    3vector open-fonts get [ open-font ] cache ;
+    3array open-fonts get [ open-font ] cache ;
 
 global [ open-fonts nest drop ] bind
 

library/ui/frames.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-layouts
-USING: gadgets generic kernel lists math namespaces sequences
+USING: arrays gadgets generic kernel lists math namespaces
-vectors ;
+sequences ;
 
 ! A frame arranges gadgets in a 3x3 grid, where the center
 ! gadgets gets left-over space.
@@ -33,22 +33,22 @@ C: frame ( -- frame )
 : get-bottom ( frame -- gadget ) 1 2 frame-child ;
 
 : reduce-grid ( grid -- seq )
-    [ { 0 0 0 } [ vmax ] reduce ] map ;
+    [ @{ 0 0 0 }@ [ vmax ] reduce ] map ;
 
 : frame-pref-dim ( grid -- dim )
-    reduce-grid { 0 0 0 } [ v+ ] reduce ;
+    reduce-grid @{ 0 0 0 }@ [ v+ ] reduce ;
 
 : pref-dim-grid ( grid -- grid )
-    [ [ [ pref-dim ] [ { 0 0 0 } ] ifte* ] map ] map ;
+    [ [ [ pref-dim ] [ @{ 0 0 0 }@ ] ifte* ] map ] map ;
 
 M: frame pref-dim ( frame -- dim )
     frame-grid pref-dim-grid
     dup flip frame-pref-dim first
     swap frame-pref-dim second
-    0 3vector ;
+    0 3array ;
 
 : frame-layout ( horiz vert -- grid )
-    [ swap [ swap 0 3vector ] map-with ] map-with ;
+    [ swap [ swap 0 3array ] map-with ] map-with ;
 
 : do-grid ( dim-grid gadget-grid quot -- )
     -rot [

library/ui/gadgets.factor

@@ -6,13 +6,13 @@ sequences styles vectors ;
 
 SYMBOL: origin
 
-global [ { 0 0 0 } origin set ] bind
+@{ 0 0 0 }@ origin global set-hash
 
 TUPLE: rect loc dim ;
 
 M: vector rect-loc ;
 
-M: vector rect-dim drop { 0 0 0 } ;
+M: vector rect-dim drop @{ 0 0 0 }@ ;
 
 : rect-bounds ( rect -- loc dim ) dup rect-loc swap rect-dim ;
 
@@ -23,7 +23,7 @@ M: vector rect-dim drop { 0 0 0 } ;
 
 : intersect ( rect rect -- rect )
     >r rect-extent r> rect-extent swapd vmin >r vmax dup r>
-    swap v- { 0 0 0 } vmax <rect> ;
+    swap v- @{ 0 0 0 }@ vmax <rect> ;
 
 : intersects? ( rect/point rect -- ? )
     >r rect-extent r> rect-extent swapd vmin >r vmax r> v-
@@ -40,7 +40,7 @@ M: gadget = eq? ;
 : gadget-child gadget-children first ;
 
 C: gadget ( -- gadget )
-    { 0 0 0 } dup <rect> over set-delegate
+    @{ 0 0 0 }@ dup <rect> over set-delegate
     t over set-gadget-visible? ;
 
 GENERIC: user-input* ( ch gadget -- ? )

library/ui/hierarchy.factor

@@ -22,7 +22,7 @@ namespaces sequences vectors ;
     dup (clear-gadget) relayout ;
 
 : ?push ( elt seq/f -- seq )
-    [ [ push ] keep ] [ 1vector ] ifte* ;
+    [ 1 <vector> ] unless* [ push ] keep ;
 
 : (add-gadget) ( gadget box -- )
     over unparent
@@ -58,12 +58,12 @@ namespaces sequences vectors ;
 
 : screen-loc ( gadget -- point )
     #! The position of the gadget on the screen.
-    parents-up { 0 0 0 } [ rect-loc v+ ] reduce ;
+    parents-up @{ 0 0 0 }@ [ rect-loc v+ ] reduce ;
 
 : gadget-point ( gadget vector -- point )
-    #! { 0 0 0 } - top left corner
+    #! @{ 0 0 0 }@ - top left corner
-    #! { 1/2 1/2 0 } - middle
+    #! @{ 1/2 1/2 0 }@ - middle
-    #! { 1 1 0 } - bottom right corner
+    #! @{ 1 1 0 }@ - bottom right corner
     >r dup screen-loc swap rect-dim r> v* v+ ;
 
 : relative ( g1 g2 -- g2-g1 ) screen-loc swap screen-loc v- ;

library/ui/incremental.factor

@@ -16,7 +16,7 @@ TUPLE: incremental cursor ;
 
 C: incremental ( pack -- incremental )
     [ set-delegate ] keep
-    { 0 0 0 } over set-incremental-cursor ;
+    @{ 0 0 0 }@ over set-incremental-cursor ;
 
 M: incremental pref-dim incremental-cursor ;
 
@@ -47,5 +47,5 @@ M: incremental layout* drop ;
 
 : clear-incremental ( incremental -- )
     dup (clear-gadget)
-    { 0 0 0 } over set-incremental-cursor
+    @{ 0 0 0 }@ over set-incremental-cursor
     gadget-parent [ relayout ] when* ;

library/ui/labels.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-labels
-USING: gadgets gadgets-layouts generic hashtables io kernel math
+USING: arrays gadgets gadgets-layouts generic hashtables io
-namespaces sdl sequences styles vectors ;
+kernel math namespaces sdl sequences styles ;
 
 ! A label gadget draws a string.
 TUPLE: label text ;
@@ -11,7 +11,7 @@ C: label ( text -- label )
     <gadget> over set-delegate [ set-label-text ] keep ;
 
 : label-size ( gadget text -- dim )
-    >r gadget-font r> size-string 0 3vector ;
+    >r gadget-font r> size-string 0 3array ;
 
 M: label pref-dim ( label -- dim )
     dup label-text label-size ;

library/ui/layouts.factor

@@ -61,7 +61,7 @@ TUPLE: pack align fill gap vector ;
     2dup packed-dim-2 swap orient ;
 
 : packed-loc-1 ( gadget sizes -- seq )
-    { 0 0 0 } [ v+ over pack-gap v+ ] accumulate nip ;
+    @{ 0 0 0 }@ [ v+ over pack-gap v+ ] accumulate nip ;
 
 : packed-loc-2 ( gadget sizes -- seq )
     [ >r dup pack-align swap rect-dim r> v- n*v ] map-with ;
@@ -82,18 +82,18 @@ C: pack ( vector -- pack )
     <gadget> over set-delegate
     0 over set-pack-align
     0 over set-pack-fill
-    { 0 0 0 } over set-pack-gap ;
+    @{ 0 0 0 }@ over set-pack-gap ;
 
-: <pile> ( -- pack ) { 0 1 0 } <pack> ;
+: <pile> ( -- pack ) @{ 0 1 0 }@ <pack> ;
 
-: <shelf> ( -- pack ) { 1 0 0 } <pack> ;
+: <shelf> ( -- pack ) @{ 1 0 0 }@ <pack> ;
 
 M: pack pref-dim ( pack -- dim )
     [
         [
             pref-dims
-            [ { 0 0 0 } [ vmax ] reduce ] keep
+            [ @{ 0 0 0 }@ [ vmax ] reduce ] keep
-            [ { 0 0 0 } [ v+ ] reduce ] keep length 1 - 0 max
+            [ @{ 0 0 0 }@ [ v+ ] reduce ] keep length 1 - 0 max
         ] keep pack-gap n*v v+
     ] keep pack-vector set-axis ;
 
@@ -115,7 +115,7 @@ TUPLE: stack ;
 
 C: stack ( -- gadget )
     #! A stack lays out all its children on top of each other.
-    { 0 0 1 } <pack> over set-delegate
+    @{ 0 0 1 }@ <pack> over set-delegate
     1 over set-pack-fill ;
 
 M: stack children-on ( point stack -- gadget )

library/ui/listener.factor

@@ -15,7 +15,7 @@ SYMBOL: callstack-display
 TUPLE: display title pane ;
 
 : display-title-theme
-    dup { 216 232 255 } background set-paint-prop
+    dup @{ 216 232 255 }@ background set-paint-prop
     << solid f >> interior set-paint-prop ;
 
 : <display-title> ( text -- label )

library/ui/menus.factor

@@ -16,7 +16,7 @@ gadgets-labels generic kernel lists math namespaces sequences ;
 
 : fit-bounds ( loc dim max -- loc )
     #! Adjust loc to fit inside max.
-    swap v- { 0 0 0 } vmax vmin ;
+    swap v- @{ 0 0 0 }@ vmax vmin ;
 
 : menu-loc ( menu -- loc )
     hand rect-loc swap rect-dim world get rect-dim fit-bounds ;

library/ui/mindmap.factor

@@ -29,7 +29,7 @@ TUPLE: mindmap left node gadget right expanded? left? right? ;
 
 : mindmap-children ( seq left? right? -- gadget )
     rot [ >r 2dup r> mindmap-child ] map 2nip
-    <pile> { 0 5 0 } over set-pack-gap [ add-gadgets ] keep ;
+    <pile> @{ 0 5 0 }@ over set-pack-gap [ add-gadgets ] keep ;
 
 : (expand-left) ( node -- gadget )
     mindmap-node node-left t f mindmap-children
@@ -74,14 +74,14 @@ TUPLE: mindmap left node gadget right expanded? left? right? ;
 C: mindmap ( left? right? node -- gadget )
     <shelf> over set-delegate
     1/2 over set-pack-align
-    { 50 0 0 } over set-pack-gap
+    @{ 50 0 0 }@ over set-pack-gap
     [ set-mindmap-node ] keep
     [ set-mindmap-right? ] keep
     [ set-mindmap-left? ] keep
     dup collapse-mindmap ;
 
 : draw-arrows ( mindmap child point -- )
-    tuck >r >r >r mindmap-gadget r> { 1 1 1 } swap v-
+    tuck >r >r >r mindmap-gadget r> @{ 1 1 1 }@ swap v-
     gadget-point r> gadget-children r> swap
     [ swap gadget-point ] map-with gray draw-fanout ;
 

library/ui/paint.factor

@@ -122,8 +122,8 @@ TUPLE: gradient vector from to ;
     dup first [ 3dup gradient-y ] repeat 2drop ;
 
 M: gradient draw-interior ( gadget gradient -- )
-    swap rect-dim { 1 1 1 } vmax
+    swap rect-dim @{ 1 1 1 }@ vmax
-    over gradient-vector { 1 0 0 } =
+    over gradient-vector @{ 1 0 0 }@ =
     [ horiz-gradient ] [ vert-gradient ] ifte ;
 
 ! Bevel pen
@@ -154,7 +154,7 @@ M: bevel draw-boundary ( gadget boundary -- )
     #! Ugly code.
     bevel-width [
         >r origin get over rect-dim over v+ r>
-        { 1 1 0 } n*v tuck v- { 1 1 0 } v- >r v+ r>
+        @{ 1 1 0 }@ n*v tuck v- @{ 1 1 0 }@ v- >r v+ r>
         rot draw-bevel
     ] each-with ;
 

library/ui/panes.factor

@@ -4,10 +4,10 @@ IN: gadgets-presentations
 DEFER: <presentation>
 
 IN: gadgets-panes
-USING: gadgets gadgets-editors gadgets-labels gadgets-layouts
+USING: arrays gadgets gadgets-editors gadgets-labels
-gadgets-scrolling generic hashtables io kernel line-editor lists
+gadgets-layouts gadgets-scrolling generic hashtables io kernel
-math namespaces prettyprint sequences strings styles threads
+line-editor lists math namespaces prettyprint sequences strings
-vectors ;
+styles threads ;
 
 ! A pane is an area that can display text.
 
@@ -21,7 +21,7 @@ TUPLE: pane output active current input continuation ;
 : add-input 2dup set-pane-input add-gadget ;
 
 : <active-line> ( input current -- line )
-    2vector <shelf> [ add-gadgets ] keep ;
+    2array <shelf> [ add-gadgets ] keep ;
 
 : init-active-line ( pane -- )
     dup pane-active unparent

library/ui/presentations.factor

@@ -1,17 +1,17 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-presentations
-USING: compiler gadgets gadgets-buttons gadgets-labels
+USING: arrays compiler gadgets gadgets-buttons gadgets-labels
 gadgets-menus gadgets-panes generic hashtables inference
 inspector io jedit kernel lists memory namespaces parser
-prettyprint sequences styles vectors words ;
+prettyprint sequences styles words ;
 
 SYMBOL: commands
 
 { } clone commands global set-hash
 
 : define-command ( class name quot -- )
-    3vector commands get push ;
+    3array commands get push ;
 
 : applicable ( object -- seq )
     commands get [ first call ] subset-with ;

library/ui/scrolling.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-scrolling
-USING: gadgets gadgets-books gadgets-layouts generic kernel
+USING: arrays gadgets gadgets-books gadgets-layouts generic kernel
-lists math namespaces sequences styles threads vectors ;
+lists math namespaces sequences styles threads ;
 
 ! A viewport can be scrolled.
 TUPLE: viewport bottom? ;
@@ -13,7 +13,7 @@ TUPLE: scroller viewport x y ;
 : scroller-origin ( scroller -- { x y 0 } )
     dup scroller-x slider-value
     swap scroller-y slider-value
-    0 3vector ;
+    0 3array ;
 
 : find-scroller [ scroller? ] find-parent ;
 

library/ui/sliders.factor

@@ -14,7 +14,7 @@ TUPLE: slider vector elevator thumb value max page ;
 
 : find-slider [ slider? ] find-parent ;
 
-: thumb-min { 12 12 0 } ;
+: thumb-min @{ 12 12 0 }@ ;
 
 : slider-scale ( slider -- n )
     #! A scaling factor such that if x is a slider co-ordinate,
@@ -61,7 +61,7 @@ SYMBOL: slider-changed
 
 : elevator-theme ( elevator -- )
     dup << solid f >> interior set-paint-prop
-    { 128 128 128 } background set-paint-prop ;
+    @{ 128 128 128 }@ background set-paint-prop ;
 
 : slide-by ( amount gadget -- )
     #! The gadget can be any child of a slider.
@@ -105,12 +105,12 @@ M: elevator pref-dim drop thumb-min ;
 : <up-button>
     <gadget> [ -1 swap slide-by-line ] <repeat-button> ;
 
-: add-up { 1 1 1 } over slider-vector v- first2 set-frame-child ;
+: add-up @{ 1 1 1 }@ over slider-vector v- first2 set-frame-child ;
 
 : <down-button>
     <gadget> [ 1 swap slide-by-line ] <repeat-button> ;
 
-: add-down { 1 1 1 } over slider-vector v+ first2 set-frame-child ;
+: add-down @{ 1 1 1 }@ over slider-vector v+ first2 set-frame-child ;
 
 : add-elevator 2dup set-slider-elevator add-center ;
 
@@ -127,6 +127,6 @@ C: slider ( vector -- slider )
     <down-button> over add-down
     <thumb> over add-thumb ;
 
-: <x-slider> ( -- slider ) { 1 0 0 } <slider> ;
+: <x-slider> ( -- slider ) @{ 1 0 0 }@ <slider> ;
 
-: <y-slider> ( -- slider ) { 0 1 0 } <slider> ;
+: <y-slider> ( -- slider ) @{ 0 1 0 }@ <slider> ;

library/ui/splitters.factor

@@ -1,12 +1,12 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-splitters
-USING: gadgets gadgets-layouts generic kernel lists math
+USING: arrays gadgets gadgets-layouts generic kernel lists math
-namespaces sequences styles vectors ;
+namespaces sequences styles ;
 
 TUPLE: divider splitter ;
 
-: divider-size { 8 8 0 } ;
+: divider-size @{ 8 8 0 }@ ;
 
 M: divider pref-dim drop divider-size ;
 
@@ -17,7 +17,7 @@ TUPLE: splitter split ;
 
 : divider-motion ( splitter -- )
     dup hand>split
-    over rect-dim { 1 1 1 } vmax v/ over pack-vector v.
+    over rect-dim @{ 1 1 1 }@ vmax v/ over pack-vector v.
     0 max 1 min over set-splitter-split relayout ;
 
 : divider-actions ( thumb -- )
@@ -33,14 +33,14 @@ C: divider ( -- divider )
 C: splitter ( first second split vector -- splitter )
     [ >r <pack> r> set-delegate ] keep
     [ set-splitter-split ] keep
-    [ >r >r <divider> r> 3vector r> add-gadgets ] keep
+    [ >r >r <divider> r> 3array r> add-gadgets ] keep
     1 over set-pack-fill ;
 
 : <x-splitter> ( first second split -- splitter )
-    { 0 1 0 } <splitter> ;
+    @{ 0 1 0 }@ <splitter> ;
 
 : <y-splitter> ( first second split -- splitter )
-    { 1 0 0 } <splitter> ;
+    @{ 1 0 0 }@ <splitter> ;
 
 : splitter-part ( splitter -- vec )
     dup splitter-split swap rect-dim

library/ui/ui.factor

@@ -7,11 +7,11 @@ styles threads words ;
 
 : world-theme
     {{
-        [[ background { 255 255 255 } ]]
+        [[ background @{ 255 255 255 }@ ]]
-        [[ rollover-bg { 236 230 232 } ]]
+        [[ rollover-bg @{ 236 230 232 }@ ]]
-        [[ bevel-1 { 160 160 160 } ]]
+        [[ bevel-1 { 160 160 160 }@ ]]
-        [[ bevel-2 { 232 232 232 } ]]
+        [[ bevel-2 @{ 232 232 232 }@ ]]
-        [[ foreground { 0 0 0 } ]]
+        [[ foreground @{ 0 0 0 }@ ]]
         [[ reverse-video f ]]
         [[ font "Monospaced" ]]
         [[ font-size 12 ]]
@@ -22,7 +22,7 @@ styles threads words ;
     ttf-init
     global [
         <world> world set
-        { 600 700 0 } world get set-gadget-dim
+        @{ 600 700 0 }@ world get set-gadget-dim
         
         world-theme world get set-gadget-paint
 

library/ui/world.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: alien errors gadgets-layouts generic io kernel lists math
+USING: alien arrays errors gadgets-layouts generic io kernel
-memory namespaces prettyprint sdl sequences sequences strings
+lists math memory namespaces prettyprint sdl sequences sequences
-threads vectors ;
+strings threads ;
 
 ! The world gadget is the top level gadget that all (visible)
 ! gadgets are contained in. The current world is stored in the
@@ -43,7 +43,7 @@ C: world ( -- world )
 
 : draw-world ( world -- )
     [
-        { 0 0 0 } width get height get 0 3vector <rect> clip set
+        @{ 0 0 0 }@ width get height get 0 3array <rect> clip set
         draw-gadget
     ] with-surface ;
 

library/vocabularies.factor

@@ -75,13 +75,13 @@ SYMBOL: vocabularies
     #! Test if the word is a member of its vocabulary.
     dup word-name over word-vocabulary lookup eq? ;
 
-: init-search-path ( -- )
+"scratchpad" "in" set
-    "scratchpad" "in" set
+[
-    [
+    "syntax" "arrays" "compiler" "errors" "generic" "hashtables"
-        "compiler" "errors" "generic" "hashtables"
+    "help" "inference" "inspector" "interpreter" "io"
-        "help" "inference" "inspector" "interpreter" "io"
+    "jedit" "kernel" "listener" "lists" "math"
-        "jedit" "kernel" "listener" "lists" "math" "matrices"
+    "memory" "namespaces" "parser" "prettyprint" "queues"
-        "memory" "namespaces" "parser" "prettyprint" "queues"
+    "sequences" "shells" "strings" "styles"
-        "scratchpad" "sequences" "shells" "strings" "styles"
+    "test" "threads" "vectors" "words"
-        "syntax" "test" "threads" "vectors" "words"
+    "scratchpad"
-    ] "use" set ;
+] "use" set

native/array.c

@@ -74,10 +74,28 @@ void primitive_resize_array(void)
 	F_ARRAY* array;
 	CELL capacity = to_fixnum(dpeek2());
 	maybe_gc(array_size(capacity));
-	array = untag_array_fast(dpop());
+	array = untag_array(dpop());
 	drepl(tag_object(resize_array(array,capacity,F)));
 }
 
+void primitive_array_to_tuple(void)
+{
+	CELL array = dpeek();
+	type_check(ARRAY_TYPE,array);
+	array = clone(array);
+	put(SLOT(UNTAG(array),0),tag_header(TUPLE_TYPE));
+	drepl(array);
+}
+
+void primitive_tuple_to_array(void)
+{
+	CELL tuple = dpeek();
+	type_check(TUPLE_TYPE,tuple);
+	tuple = clone(tuple);
+	put(SLOT(UNTAG(tuple),0),tag_header(ARRAY_TYPE));
+	drepl(tuple);
+}
+
 void fixup_array(F_ARRAY* array)
 {
 	int i = 0; CELL capacity = array_capacity(array);

native/array.h

@@ -9,6 +9,12 @@ INLINE F_ARRAY* untag_array_fast(CELL tagged)
 	return (F_ARRAY*)UNTAG(tagged);
 }
 
+INLINE F_ARRAY* untag_array(CELL tagged)
+{
+	type_check(ARRAY_TYPE,tagged);
+	return untag_array_fast(tagged);
+}
+
 INLINE F_ARRAY* untag_byte_array_fast(CELL tagged)
 {
 	return (F_ARRAY*)UNTAG(tagged);
@@ -28,6 +34,8 @@ void primitive_byte_array(void);
 
 F_ARRAY* resize_array(F_ARRAY* array, CELL capacity, CELL fill);
 void primitive_resize_array(void);
+void primitive_array_to_tuple(void);
+void primitive_tuple_to_array(void);
 
 #define AREF(array,index) ((CELL)(array) + sizeof(F_ARRAY) + (index) * CELLS)
 

native/debug.c

@@ -64,7 +64,7 @@ void print_obj(CELL obj)
 		fprintf(stderr,"f");
 		break;
 	case TUPLE_TYPE:
-		array = untag_array_fast(obj);
+		array = (F_ARRAY*)UNTAG(obj);
 		fprintf(stderr,"<< ");
 		print_word(untag_word(get(AREF(array,0))));
 		fprintf(stderr," %lx >>",obj);

native/memory.c

@@ -100,8 +100,6 @@ void primitive_tag(void)
 	drepl(tag_fixnum(TAG(dpeek())));
 }
 
-#define SLOT(obj,slot) ((obj) + (slot) * CELLS)
-
 void primitive_slot(void)
 {
 	F_FIXNUM slot = untag_fixnum_fast(dpop());
@@ -143,14 +141,17 @@ void primitive_size(void)
 	drepl(tag_fixnum(object_size(dpeek())));
 }
 
-void primitive_clone(void)
+CELL clone(CELL obj)
 {
-	CELL obj = dpeek();
 	CELL size = object_size(obj);
 	CELL tag = TAG(obj);
 	void *new_obj = allot(size);
-	new_obj = RETAG(memcpy(new_obj,(void*)UNTAG(obj),size),tag);
+	return RETAG(memcpy(new_obj,(void*)UNTAG(obj),size),tag);
-	drepl(new_obj);
+}
+
+void primitive_clone(void)
+{
+	drepl(clone(dpeek()));
 }
 
 void primitive_room(void)

native/memory.h

@@ -78,6 +78,8 @@ INLINE CELL align8(CELL a)
 /* Canonical T object. It's just a word */
 CELL T;
 
+#define SLOT(obj,slot) ((obj) + (slot) * CELLS)
+
 INLINE bool headerp(CELL cell)
 {
 	return (cell != F
@@ -144,6 +146,7 @@ void primitive_integer_slot(void);
 void primitive_set_integer_slot(void);
 void primitive_address(void);
 void primitive_size(void);
+CELL clone(CELL obj);
 void primitive_clone(void);
 void primitive_begin_scan(void);
 void primitive_next_object(void);

native/primitives.c

@@ -185,7 +185,10 @@ void* primitives[] = {
 	primitive_fclose,
 	primitive_expired,
 	primitive_wrapper,
-	primitive_clone
+	primitive_clone,
+	primitive_array_to_tuple,
+	primitive_tuple_to_array,
+	primitive_array_to_vector
 };
 
 CELL primitive_to_xt(CELL primitive)

native/run.c

@@ -104,9 +104,9 @@ void primitive_ifte(void)
 
 void primitive_dispatch(void)
 {
-	F_VECTOR *v = (F_VECTOR*)UNTAG(dpop());
+	F_ARRAY *a = untag_array_fast(dpop());
 	F_FIXNUM n = untag_fixnum_fast(dpop());
-	call(get(AREF(untag_array_fast(v->array),n)));
+	call(get(AREF(a,n)));
 }
 
 void primitive_getenv(void)

native/vector.c

@@ -18,6 +18,18 @@ void primitive_vector(void)
 	drepl(tag_object(vector(size)));
 }
 
+void primitive_array_to_vector(void)
+{
+	F_ARRAY *array;
+	F_VECTOR *vector;
+	maybe_gc(sizeof(F_VECTOR));
+	array = untag_array(dpeek());
+	vector = allot_object(VECTOR_TYPE,sizeof(F_VECTOR));
+	vector->top = array->capacity;
+	vector->array = tag_object(array);
+	drepl(tag_object(vector));
+}
+
 void fixup_vector(F_VECTOR* vector)
 {
 	data_fixup(&vector->array);

native/vector.h

@@ -16,5 +16,6 @@ INLINE F_VECTOR* untag_vector(CELL tagged)
 F_VECTOR* vector(F_FIXNUM capacity);
 
 void primitive_vector(void);
+void primitive_array_to_vector(void);
 void fixup_vector(F_VECTOR* vector);
 void collect_vector(F_VECTOR* vector);