math.matrices: add error for negative m^n (and test).

diff --git a/basis/math/matrices/matrices-tests.factor b/basis/math/matrices/matrices-tests.factor
index 0140ade96f3d45d2f44ea34adb9dc5657521c748..e7a1124d0db725905bcdde96e4de962b15565819 100644 (file)
--- a/basis/math/matrices/matrices-tests.factor
+++ b/basis/math/matrices/matrices-tests.factor
@@ -208,6 +208,7 @@ IN: math.matrices.tests
 
 [ { { 4181 6765 } { 6765 10946 } } ]
 [ { { 0 1 } { 1 1 } } 20 m^n ] unit-test
+[ { { 0 1 } { 1 1 } } -20 m^n ] [ negative-power-matrix? ] must-fail-with
 
 {
     { { 0 5 0 10 } { 6 7 12 14 } { 0 15 0 20 } { 18 21 24 28 } }

diff --git a/basis/math/matrices/matrices.factor b/basis/math/matrices/matrices.factor
index 8ef4484353ced6bcb8f21cb15de55e6ba454fa2f..58e205fcfd5e00a52132c831921906f6d8051417 100644 (file)
--- a/basis/math/matrices/matrices.factor
+++ b/basis/math/matrices/matrices.factor
@@ -167,10 +167,15 @@ IN: math.matrices
 : norm-gram-schmidt ( seq -- orthonormal )
     gram-schmidt [ normalize ] map ;
 
-: m^n ( m n -- n )
+ERROR: negative-power-matrix m n ;
+
+: (m^n) ( m n -- n )
     make-bits over first length identity-matrix
     [ [ dupd m. ] when [ dup m. ] dip ] reduce nip ;
 
+: m^n ( m n -- n )
+    dup 0 >= [ (m^n) ] [ negative-power-matrix ] if ;
+
 : stitch ( m -- m' )
     [ ] [ [ append ] 2map ] map-reduce ;