From e33fca9fe74b9b7e98d0fd20e8a7909687ffa52c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 31 Jul 2005 02:14:34 +0000 Subject: [PATCH] matrix library simplification; other code cleanups --- CHANGES.html | 1 + library/bootstrap/boot-stage1.factor | 12 ++++++------ library/bootstrap/primitives.factor | 13 ++++++------- library/collections/growable.factor | 15 --------------- library/collections/sequences-epilogue.factor | 3 +++ library/collections/sequences.factor | 11 +++++++++++ library/collections/vectors-epilogue.factor | 2 -- library/math/matrices.factor | 18 +++++++++--------- library/syntax/math.factor | 2 +- library/test/gadgets/gradients.factor | 2 +- library/test/lists/combinators.factor | 2 -- library/test/redefine.factor | 2 +- library/tools/debugger.factor | 7 +++++++ library/tools/inspector.factor | 4 ++-- library/ui/incremental.factor | 2 +- 15 files changed, 49 insertions(+), 47 deletions(-) diff --git a/CHANGES.html b/CHANGES.html index 7a1b96ca75..1790197245 100644 --- a/CHANGES.html +++ b/CHANGES.html @@ -23,6 +23,7 @@

Factor 0.76:

diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 51ab80daa3..dd92360fd2 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/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 diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor index 20063c5984..608c2f9fa4 100644 --- a/library/bootstrap/primitives.factor +++ b/library/bootstrap/primitives.factor @@ -17,7 +17,7 @@ vocabularies vocabularies set typemap set -num-types builtins set +num-types empty-vector builtins set crossref set vocabularies get [ @@ -33,11 +33,10 @@ vocabularies get [ "infer-effect" set-word-prop ] ifte ; -: make-primitive ( n { vocab word effect } -- n ) - [ 2unseq create >r 1 + r> over f define ] keep - set-stack-effect ; +: make-primitive ( { vocab word effect } n -- ) + >r dup 2unseq create r> f define 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. { diff --git a/library/collections/growable.factor b/library/collections/growable.factor index 07ebffa0d3..5ea11fc2b9 100644 --- a/library/collections/growable.factor +++ b/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 diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor index 2d146e81ac..036fb9908e 100644 --- a/library/collections/sequences-epilogue.factor +++ b/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? ; diff --git a/library/collections/sequences.factor b/library/collections/sequences.factor index ce7fc3c22c..57ef0b1191 100644 --- a/library/collections/sequences.factor +++ b/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 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 diff --git a/library/collections/vectors-epilogue.factor b/library/collections/vectors-epilogue.factor index a2eb5c4db9..09ff8d50a1 100644 --- a/library/collections/vectors-epilogue.factor +++ b/library/collections/vectors-epilogue.factor @@ -14,8 +14,6 @@ M: object thaw >vector ; M: vector clone ( vector -- vector ) >vector ; -: zero-vector ( n -- vector ) 0 >vector ; - M: general-list like drop >list ; M: range like drop >vector ; diff --git a/library/math/matrices.factor b/library/math/matrices.factor index 41b50f072a..d2ba865779 100644 --- a/library/math/matrices.factor +++ b/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 -USING: errors generic kernel lists math namespaces sequences -vectors ; +IN: math +USING: kernel sequences vectors ; ! Vectors +: zero-vector ( n -- vector ) 0 >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 ) [ v. ] map-with ; -: m.v ( m v -- v ) swap [ v. ] map-with ; -: m. ( m m -- m ) >r r> [ m.v ] map-with ; +: v.m ( v m -- v ) [ v. ] map-with ; inline +: m.v ( m v -- v ) swap [ v. ] map-with ; inline +: m. ( m m -- m ) swap [ m.v ] map-with ; : trace ( matrix -- tr ) 0 swap product ; diff --git a/library/syntax/math.factor b/library/syntax/math.factor index 92db6ee6f8..c28a176c10 100644 --- a/library/syntax/math.factor +++ b/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 -- ) diff --git a/library/test/gadgets/gradients.factor b/library/test/gadgets/gradients.factor index 320d6fa307..6a4870b9e5 100644 --- a/library/test/gadgets/gradients.factor +++ b/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 { 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 { 100 200 0 } 100 (gradient-x) ] unit-test [ 0 0 200 { 255 0 0 } ] diff --git a/library/test/lists/combinators.factor b/library/test/lists/combinators.factor index 42fda0e9e5..859bca4fd1 100644 --- a/library/test/lists/combinators.factor +++ b/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 diff --git a/library/test/redefine.factor b/library/test/redefine.factor index a17c9f963c..2c972c34bb 100644 --- a/library/test/redefine.factor +++ b/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 diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor index 70519589cf..986ff4ecbb 100644 --- a/library/tools/debugger.factor +++ b/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 -- ) . ; diff --git a/library/tools/inspector.factor b/library/tools/inspector.factor index f1079ca323..3f329babcb 100644 --- a/library/tools/inspector.factor +++ b/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 ; diff --git a/library/ui/incremental.factor b/library/ui/incremental.factor index dac20f68ca..038ded5bc8 100644 --- a/library/ui/incremental.factor +++ b/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