debugging matrices

library/compiler/optimizer.factor

@@ -197,7 +197,7 @@ M: #values can-kill* ( literal node -- ? )
 
 : branch-values ( branches -- )
     [ last-node node-in-d >list ] map
-    unify-lengths vector-transpose >list branch-returns set ;
+    unify-lengths dual branch-returns set ;
 
 : can-kill-branches? ( literal node -- ? )
     #! Check if the literal appears in either branch. This

library/generic/generic.factor

@@ -63,13 +63,20 @@ math-internals ;
 
 : dispatcher% "dispatcher" word-prop % ;
 
+: error-method ( generic -- method )
+    [ literal, \ no-method , ] make-list ;
+
 : empty-method ( generic -- method )
-    [
-        [ dup delegate ] %
-        [ dup , ] make-list ,
-        [ literal, \ no-method , ] make-list ,
-        \ ?ifte ,
-    ] make-list ;
+    dup "picker" word-prop [ dup ] = [
+        [
+            [ dup delegate ] %
+            [ dup , ] make-list ,
+            error-method ,
+            \ ?ifte ,
+        ] make-list
+    ] [
+        error-method
+    ] ifte ;
 
 : <empty-vtable> ( generic -- vtable )
     empty-method num-types swap <repeated> >vector ;

library/inference/branches.factor

@@ -28,16 +28,13 @@ sequences strings vectors words hashtables prettyprint ;
         [ value-class ] map class-or-list <computed>
     ] ifte ;
 
-: vector-transpose ( list -- vector )
-    #! Turn a list of same-length vectors into a vector of lists.
-    dup car length [
-        over [ nth ] map-with
-    ] project >vector nip ;
+: dual ( list -- list )
+    0 over nth length [ swap [ nth ] map-with ] project-with ;
 
 : unify-stacks ( list -- stack )
     #! Replace differing literals in stacks with unknown
     #! results.
-    unify-lengths vector-transpose [ unify-results ] map ; 
+    unify-lengths dual [ unify-results ] map >vector ; 
 
 : balanced? ( list -- ? )
     #! Check if a list of [[ instack outstack ]] pairs is
@@ -105,24 +102,13 @@ sequences strings vectors words hashtables prettyprint ;
     ] extend ;
 
 : (infer-branches) ( branchlist -- list )
-    [
-        [
-            inferring-base-case get [
-                [ infer-branch , ] [ [ drop ] when ] catch
-            ] [
-                infer-branch ,
-            ] ifte
-        ] each
-    ] make-list ;
+    [ infer-branch ] map dup unify-effects unify-dataflow ;
 
 : infer-branches ( branches node -- )
     #! Recursive stack effect inference is done here. If one of
     #! the branches has an undecidable stack effect, we set the
     #! base case to this stack effect and try again.
-    [
-        >r (infer-branches) dup unify-effects unify-dataflow
-        r> set-node-children
-    ] keep node, ;
+    [ >r (infer-branches) r> set-node-children ] keep node, ;
 
 \ ifte [
     2 #drop node, pop-d pop-d swap 2list

library/inference/words.factor

@@ -144,7 +144,7 @@ M: compound apply-word ( word -- )
             nip consume/produce
         ] [
             inferring-base-case get [
-                drop no-base-case
+                2drop terminate
             ] [
                 car base-case
             ] ifte

library/math/matrices.factor

@@ -4,9 +4,7 @@ IN: matrices
 USING: errors generic kernel lists math namespaces sequences
 vectors ;
 
-: n*v ( n vec -- vec )
-    #! Multiply a vector by a scalar.
-    [ * ] map-with ;
+: n*v ( n vec -- vec ) [ * ] map-with ;
 
 ! Vector operations
 : v+ ( v v -- v ) [ + ] 2map ;
@@ -15,7 +13,7 @@ vectors ;
 : v** ( v v -- v ) [ conjugate * ] 2map ;
 
 ! Later, this will fixed when 2each works properly
-! : v. ( v v -- x ) 0 swap [ * + ] 2each ;
+! : v. ( v v -- x ) 0 swap [ conjugate * + ] 2each ;
 : v. ( v v -- x ) v** 0 swap [ + ] each ;
 
 : cross-trace ( v1 v2 i1 i2 -- v1 v2 n )
@@ -44,7 +42,7 @@ M: matrix clone ( matrix -- matrix )
     clone-tuple
     dup matrix-sequence clone over set-matrix-sequence ;
 
-: matrix@ ( row col matrix -- n ) matrix-rows * + ;
+: matrix@ ( row col matrix -- n ) matrix-cols rot * + ;
 
 : matrix-get ( row col matrix -- elt )
     [ matrix@ ] keep matrix-sequence nth ;
@@ -124,7 +122,7 @@ M: col thaw >vector ;
     #! Composition of two matrices.
     2dup *check 2dup *dimensions [
         ( m1 m2 row col -- m1 m2 )
-        >r >r 2dup r> rot <row> r> rot <col> v.
+        pick <col> >r pick <row> r> v.
     ] make-matrix 2nip ;
 
 : n*m ( n m -- m )

library/test/inference.factor

@@ -64,7 +64,7 @@ namespaces parser sequences test vectors ;
 
 : infinite-loop infinite-loop ;
 
-[ [ infinite-loop ] infer old-effect ] unit-test-fails
+! [ [ infinite-loop ] infer old-effect ] unit-test-fails
 
 : simple-recursion-1
     dup [ simple-recursion-1 ] [ ] ifte ;

library/test/math/matrices.factor

@@ -1,6 +1,9 @@
 IN: temporary
 USING: kernel lists math matrices namespaces test ;
 
+[ [ [ 1 4 ] [ 2 5 ] [ 3 6 ] ] ]
+[ M[ [ 1 4 ] [ 2 5 ] [ 3 6 ] ]M row-list ] unit-test
+
 [
     M[ [ 0 ] [ 0 ] [ 0 ] ]M
 ] [
@@ -103,6 +106,26 @@ USING: kernel lists math matrices namespaces 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
 
+[ M[ [ 1 2 ] [ 3 4 ] [ 5 6 ] ]M ]
+[ M[ [ 1 2 ] [ 3 4 ] [ 5 6 ] ]M transpose transpose ]
+unit-test
+
+[ M[ [ 1 3 5 ] [ 2 4 6 ] ]M ]
+[ M[ [ 1 3 5 ] [ 2 4 6 ] ]M transpose transpose ]
+unit-test
+
 [ M[ [ 1 3 5 ] [ 2 4 6 ] ]M ]
 [ M[ [ 1 2 ] [ 3 4 ] [ 5 6 ] ]M transpose ]
 unit-test
+
+[
+    M[ [ 28 ] ]M
+] [
+    M[ [ 2 4 6 ] ]M
+
+    M[ [ 1 ]
+       [ 2 ]
+       [ 3 ] ]M
+    
+    m.
+] unit-test