matrix library simplification; other code cleanups

CHANGES.html

@@ -23,6 +23,7 @@
 
 <ul>Everything else:
 <li>Object slots are now clickable in the inspector</li>
+<li>The matrices library has been greatly simplified. Matrices are now represented as vectors of vectors, and matrix words have been moved to the <code>math</code> vocabulary.</li>
 </ul>
 
 <h1>Factor 0.76:</h1>

library/bootstrap/boot-stage1.factor

@@ -6,13 +6,13 @@ parser prettyprint sequences io vectors words ;
 
 "Bootstrap stage 1..." print
 
-"/library/bootstrap/primitives.factor" run-resource
-
 : pull-in ( list -- ) [ dup print parse-resource % ] each ;
 
+"/library/bootstrap/primitives.factor" run-resource
+
 ! The make-list form creates a boot quotation
 [
-    [
+    {
         "/version.factor"
 
         "/library/stack.factor"
@@ -114,7 +114,7 @@ parser prettyprint sequences io vectors words ;
         "/library/cli.factor"
         
         "/library/tools/memory.factor"
-    ] pull-in
+    } pull-in
 ] make-list
 
 "object" [ "generic" ] search
@@ -141,7 +141,7 @@ reveal
         recrossref
     ] %
 
-    [
+    {
         "/library/generic/generic.factor"
         "/library/generic/slots.factor"
         "/library/generic/object.factor"
@@ -153,7 +153,7 @@ reveal
         "/library/generic/tuple.factor"
     
         "/library/bootstrap/init.factor"
-    ] pull-in
+    } pull-in
 
     [
         "Building generics..." print

library/bootstrap/primitives.factor

@@ -17,7 +17,7 @@ vocabularies
 
 <namespace> vocabularies set
 <namespace> typemap set
-num-types <vector> builtins set
+num-types empty-vector builtins set
 <namespace> crossref set
 
 vocabularies get [
@@ -33,11 +33,10 @@ vocabularies get [
         "infer-effect" set-word-prop
     ] ifte ;
 
-: make-primitive ( n { vocab word effect } -- n )
+: make-primitive ( { vocab word effect } n -- )
-    [ 2unseq create >r 1 + r> over f define ] keep
+    >r dup 2unseq create r> f define set-stack-effect ;
-    set-stack-effect ;
 
-2 {
+{
     { "execute" "words"                       [ [ word ] [ ] ] }
     { "call" "kernel"                         [ [ general-list ] [ ] ] }
     { "ifte" "kernel"                         [ [ object general-list general-list ] [ ] ] }
@@ -207,9 +206,9 @@ vocabularies get [
     { "fflush" "io-internals"                 [ [ alien ] [ ] ] }
     { "fclose" "io-internals"                 [ [ alien ] [ ] ] }
     { "expired?" "alien"                      [ [ object ] [ boolean ] ] }
-} [
+} dup length 3 swap [ + ] map-with [
     make-primitive
-] each drop
+] 2each
 
 ! These need a more descriptive comment.
 {

library/collections/growable.factor

@@ -5,21 +5,6 @@
 IN: kernel-internals
 USING: errors kernel math math-internals sequences ;
 
-: assert-positive ( fx -- )
-    0 fixnum<
-    [ "Sequence index must be positive" throw ] when ; inline
-
-: assert-bounds ( fx seq -- )
-    over assert-positive
-    length fixnum>=
-    [ "Sequence index out of bounds" throw ] when ; inline
-
-: bounds-check ( n seq -- fixnum seq )
-    >r >fixnum r> 2dup assert-bounds ; inline
-
-: growable-check ( n seq -- fixnum seq )
-    >r >fixnum dup assert-positive r> ; inline
-
 GENERIC: underlying
 GENERIC: set-underlying
 GENERIC: set-capacity

library/collections/sequences-epilogue.factor

@@ -102,6 +102,9 @@ M: object empty? ( seq -- ? ) length 0 = ;
 
 M: object >list ( seq -- list ) dup length 0 rot (>list) ;
 
+: conj ( v -- ? ) [ ] all? ;
+: disj ( v -- ? ) [ ] contains? ;
+
 : index   ( obj seq -- n )     [ = ] find-with drop ;
 : index*  ( obj i seq -- n )   [ = ] find-with* drop ;
 : member? ( obj seq -- ? )     [ = ] contains-with? ;

library/collections/sequences.factor

@@ -66,3 +66,14 @@ G: find* ( i seq quot -- i elt | quot: elt -- ? )
 
 : 3unseq ( { x y z } -- x y z )
     dup first over second rot third ;
+
+TUPLE: bounds-error index seq ;
+: bounds-error <bounds-error> throw ;
+
+: growable-check ( n seq -- fx seq )
+    >r >fixnum dup 0 fixnum<
+    [ r> 2dup bounds-error ] [ r> ] ifte ; inline
+
+: bounds-check ( n seq -- fx seq )
+    growable-check 2dup length fixnum>=
+    [ 2dup bounds-error ] when ; inline

library/collections/vectors-epilogue.factor

@@ -14,8 +14,6 @@ M: object thaw >vector ;
 
 M: vector clone ( vector -- vector ) >vector ;
 
-: zero-vector ( n -- vector ) 0 <repeated> >vector ;
-
 M: general-list like drop >list ;
 
 M: range like drop >vector ;

library/math/matrices.factor

@@ -1,10 +1,11 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: matrices
+IN: math
-USING: errors generic kernel lists math namespaces sequences
+USING: kernel sequences vectors ;
-vectors ;
 
 ! Vectors
+: zero-vector ( n -- vector ) 0 <repeated> >vector ;
+
 : vneg ( v -- v ) [ neg ] map ;
 
 : n*v ( n v -- v ) [ * ] map-with ;
@@ -29,13 +30,12 @@ vectors ;
 
 : sum ( v -- n ) 0 [ + ] reduce ;
 : product ( v -- n ) 1 [ * ] reduce ;
-: conj ( v -- ? ) [ ] all? ;
-: disj ( v -- ? ) [ ] contains? ;
 
 : set-axis ( x y axis -- v )
     2dup v* >r >r drop dup r> v* v- r> v+ ;
 
-: v. ( v v -- x ) 0 -rot [ conjugate * + ] 2each ;
+: v. ( v v -- x ) 0 -rot [ * + ] 2each ; inline
+: c. ( v v -- x ) 0 -rot [ conjugate * + ] 2each ;
 
 : norm-sq ( v -- n ) 0 [ absq + ] reduce ;
 
@@ -84,8 +84,8 @@ vectors ;
 : m>   ( m m -- m ) [ v> ]   2map ;
 : m>=  ( m m -- m ) [ v>= ]  2map ;
 
-: v.m ( v m -- v ) <flipped> [ v. ] map-with ;
+: v.m ( v m -- v ) <flipped> [ v. ] map-with ; inline
-: m.v ( m v -- v ) swap [ v. ] map-with ;
+: m.v ( m v -- v ) swap [ v. ] map-with ; inline
-: m.  ( m m -- m ) >r <flipped> r> [ m.v ] map-with ;
+: m.  ( m m -- m ) <flipped> swap [ m.v ] map-with ;
 
 : trace ( matrix -- tr ) 0 swap <diagonal> product ;

library/syntax/math.factor

@@ -6,7 +6,7 @@ USING: kernel lists math parser sequences syntax vectors ;
 
 ! Complex numbers
 : #{ f ; parsing
-: }# dup first swap second rect> swons ; parsing
+: }# dup second swap first rect> swons ; parsing
 
 ! Reading integers in other bases
 : (BASE) ( base -- )

library/test/gadgets/gradients.factor

@@ -11,7 +11,7 @@ USING: gadgets namespaces styles test ;
     [ 0 100 0 { 255 0 0 } ]
     [ { 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 0 200 { 255 0 0 } ]

library/test/lists/combinators.factor

@@ -7,8 +7,6 @@ USE: test
 USE: strings
 USE: sequences
 
-[ { [ 3 2 1 ] [ 5 4 3 ] [ 6 ] } ]
-
 [ [ "a" 43 [ ] ] ] [ [ "a" 43 43 43 [ ] 43 "a" [ ] ] prune ] unit-test
 
 [ "fdsfs" [ > ] sort ] unit-test-fails

library/test/redefine.factor

@@ -8,4 +8,4 @@ USE: test
 : foo 1 2 3 ;
 
 [ 1 2 3 1 2 3 ] [ bar ] unit-test
-[ [ [ 0 3 ] ] ] [ [ foo ] infer ] unit-test
+[ [ 0 3 ] ] [ [ foo ] infer ] unit-test

library/tools/debugger.factor

@@ -74,6 +74,13 @@ M: no-method error. ( error -- )
 M: parse-error error. ( error -- )
     dup parse-dump  delegate error. ;
 
+M: bounds-error error. ( error -- )
+    "Sequence index out of bounds" print
+    "Sequence: " write dup bounds-error-seq .
+    "Minimum: 0" print
+    "Maximum: " write dup bounds-error-seq length .
+    "Requested: " write bounds-error-index . ;
+
 M: string error. ( error -- ) print ;
 
 M: object error. ( error -- ) . ;

library/tools/inspector.factor

@@ -25,7 +25,7 @@ M: array sheet unit ;
 
 M: hashtable sheet dup hash-keys swap hash-values 2list ;
 
-: column ( list -- list )
+: format-column ( list -- list )
     [ unparse ] map
     [ max-length ] keep
     [ swap CHAR: \s pad-right ] map-with ;
@@ -33,7 +33,7 @@ M: hashtable sheet dup hash-keys swap hash-values 2list ;
 : format-sheet ( sheet -- list )
     dup first length >vector swons
     dup peek over first [ set ] 2each
-    [ column ] map
+    [ format-column ] map
     flip
     [ " | " join ] map ;
 

library/ui/incremental.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel matrices ;
+USING: generic kernel math ;
 
 ! Incremental layout allows adding lines to panes to be O(1).
 ! Note that incremental packs are distinct from ordinary packs