From fa6d7b70690d103fdec5f1b4f8420578ddb68313 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 5 Nov 2009 14:05:06 -0600 Subject: [PATCH] eliminate spin from basis --- basis/images/jpeg/jpeg.factor | 4 ++-- basis/io/backend/windows/nt/nt.factor | 19 ++++++++++--------- basis/math/blas/vectors/vectors.factor | 8 ++++---- .../matrices/elimination/elimination.factor | 15 +++++++-------- .../hashtables/hashtables-tests.factor | 4 ++-- basis/persistent/hashtables/hashtables.factor | 6 +++--- basis/regexp/disambiguate/disambiguate.factor | 12 ++++++------ basis/validators/validators.factor | 2 +- basis/windows/com/com-tests.factor | 4 ++-- basis/windows/com/wrapper/wrapper-docs.factor | 4 ++-- 10 files changed, 39 insertions(+), 39 deletions(-) diff --git a/basis/images/jpeg/jpeg.factor b/basis/images/jpeg/jpeg.factor index 4f10808b04..e8af7144ad 100644 --- a/basis/images/jpeg/jpeg.factor +++ b/basis/images/jpeg/jpeg.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Marc Fauconneau. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays byte-arrays combinators -grouping compression.huffman images +grouping compression.huffman images fry images.processing io io.binary io.encodings.binary io.files io.streams.byte-array kernel locals math math.bitwise math.constants math.functions math.matrices math.order @@ -232,7 +232,7 @@ MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ; block dup length>> sqrt >fixnum group flip dup matrix-dim coord-matrix flip [ - [ first2 spin nth nth ] + [ '[ _ [ second ] [ first ] bi ] dip nth nth ] [ x,y v+ color-id jpeg-image draw-color ] bi ] with each^2 ; diff --git a/basis/io/backend/windows/nt/nt.factor b/basis/io/backend/windows/nt/nt.factor index 452dc4a409..1301d69913 100755 --- a/basis/io/backend/windows/nt/nt.factor +++ b/basis/io/backend/windows/nt/nt.factor @@ -50,16 +50,17 @@ M: winnt add-completion ( win32-handle -- ) } cond ] with-timeout ; -:: wait-for-overlapped ( us -- bytes-transferred overlapped error? ) +:: wait-for-overlapped ( usec -- bytes-transferred overlapped error? ) master-completion-port get-global - 0 [ ! bytes - f ! key - f [ ! overlapped - us [ 1000 /i ] [ INFINITE ] if* ! timeout - GetQueuedCompletionStatus zero? - ] keep - *void* dup [ OVERLAPPED memory>struct ] when - ] keep *int spin ; + 0 :> bytes + f :> key + f :> overlapped + usec [ 1000 /i ] [ INFINITE ] if* :> timeout + bytes key overlapped timeout GetQueuedCompletionStatus zero? :> error? + + bytes *int + overlapped *void* dup [ OVERLAPPED memory>struct ] when + error? ; : resume-callback ( result overlapped -- ) >c-ptr pending-overlapped get-global delete-at* drop resume-with ; diff --git a/basis/math/blas/vectors/vectors.factor b/basis/math/blas/vectors/vectors.factor index 8d057de720..8fa41c5026 100755 --- a/basis/math/blas/vectors/vectors.factor +++ b/basis/math/blas/vectors/vectors.factor @@ -78,10 +78,10 @@ PRIVATE> : n*V+V ( alpha x y -- alpha*x+y ) clone n*V+V! ; inline : n*V ( alpha x -- alpha*x ) clone n*V! ; inline -: V+ ( x y -- x+y ) - 1.0 -rot n*V+V ; inline -: V- ( x y -- x-y ) - -1.0 spin n*V+V ; inline +:: V+ ( x y -- x+y ) + 1.0 x y n*V+V ; inline +:: V- ( x y -- x-y ) + -1.0 y x n*V+V ; inline : Vneg ( x -- -x ) -1.0 swap n*V ; inline diff --git a/basis/math/matrices/elimination/elimination.factor b/basis/math/matrices/elimination/elimination.factor index 8411447aac..5c154a6820 100755 --- a/basis/math/matrices/elimination/elimination.factor +++ b/basis/math/matrices/elimination/elimination.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.vectors math.matrices namespaces -sequences ; +USING: kernel locals math math.vectors math.matrices +namespaces sequences ; IN: math.matrices.elimination SYMBOL: matrix @@ -85,12 +85,11 @@ SYMBOL: matrix ] each ] with-matrix ; -: basis-vector ( row col# -- ) - [ clone ] dip - [ swap nth neg recip ] 2keep - [ 0 spin set-nth ] 2keep - [ n*v ] dip - matrix get set-nth ; +:: basis-vector ( row col# -- ) + row clone :> row' + col# row' nth neg recip :> a + 0 col# row' set-nth + a row n*v col# matrix get set-nth ; : nullspace ( matrix -- seq ) echelon reduced dup empty? [ diff --git a/basis/persistent/hashtables/hashtables-tests.factor b/basis/persistent/hashtables/hashtables-tests.factor index eea31dd34e..d66fdd0c08 100644 --- a/basis/persistent/hashtables/hashtables-tests.factor +++ b/basis/persistent/hashtables/hashtables-tests.factor @@ -1,6 +1,6 @@ IN: persistent.hashtables.tests USING: persistent.hashtables persistent.assocs hashtables assocs -tools.test kernel namespaces random math.ranges sequences fry ; +tools.test kernel locals namespaces random math.ranges sequences fry ; [ t ] [ PH{ } assoc-empty? ] unit-test @@ -86,7 +86,7 @@ M: hash-0-b hashcode* 2drop 0 ; : random-assocs ( n -- hash phash ) [ random-string ] replicate [ H{ } clone [ '[ swap _ set-at ] each-index ] keep ] - [ PH{ } clone swap [ spin new-at ] each-index ] + [ PH{ } clone swap [| ph elt i | i elt ph new-at ] each-index ] bi ; : ok? ( assoc1 assoc2 -- ? ) diff --git a/basis/persistent/hashtables/hashtables.factor b/basis/persistent/hashtables/hashtables.factor index 0179216e62..256baabd5e 100644 --- a/basis/persistent/hashtables/hashtables.factor +++ b/basis/persistent/hashtables/hashtables.factor @@ -1,7 +1,7 @@ ! Based on Clojure's PersistentHashMap by Rich Hickey. USING: kernel math accessors assocs fry combinators parser -prettyprint.custom make +prettyprint.custom locals make persistent.assocs persistent.hashtables.nodes persistent.hashtables.nodes.empty @@ -38,8 +38,8 @@ M: persistent-hash pluck-at M: persistent-hash >alist [ root>> >alist% ] { } make ; -: >persistent-hash ( assoc -- phash ) - T{ persistent-hash } swap [ spin new-at ] assoc-each ; +:: >persistent-hash ( assoc -- phash ) + T{ persistent-hash } assoc [| ph k v | v k ph new-at ] assoc-each ; M: persistent-hash equal? over persistent-hash? [ assoc= ] [ 2drop f ] if ; diff --git a/basis/regexp/disambiguate/disambiguate.factor b/basis/regexp/disambiguate/disambiguate.factor index 876d898cb4..fcde135cf8 100644 --- a/basis/regexp/disambiguate/disambiguate.factor +++ b/basis/regexp/disambiguate/disambiguate.factor @@ -44,12 +44,12 @@ TUPLE: parts in out ; [ _ meaningful-integers ] keep add-out ] map ; -: class-partitions ( classes -- assoc ) - [ integer? ] partition [ - dup powerset-partition spin add-integers - [ [ partition>class ] keep 2array ] map - [ first ] filter - ] [ '[ _ singleton-partition ] map ] 2bi append ; +:: class-partitions ( classes -- assoc ) + classes [ integer? ] partition :> ( integers classes ) + + classes powerset-partition classes integers add-integers + [ [ partition>class ] keep 2array ] map [ first ] filter + integers [ classes singleton-partition ] map append ; : new-transitions ( transitions -- assoc ) ! assoc is class, partition values [ keys ] gather diff --git a/basis/validators/validators.factor b/basis/validators/validators.factor index f0ee13dd38..f2c5691452 100644 --- a/basis/validators/validators.factor +++ b/basis/validators/validators.factor @@ -9,7 +9,7 @@ IN: validators >lower "on" = ; : v-default ( str def -- str/def ) - over empty? spin ? ; + [ nip empty? ] 2keep ? ; : v-required ( str -- str ) dup empty? [ "required" throw ] when ; diff --git a/basis/windows/com/com-tests.factor b/basis/windows/com/com-tests.factor index ae8ef62c16..25e30829c0 100644 --- a/basis/windows/com/com-tests.factor +++ b/basis/windows/com/com-tests.factor @@ -44,8 +44,8 @@ C: test-implementation [ >>x drop ] ! IInherited::setX } } { IUnrelated { - [ swap x>> + ] ! IUnrelated::xPlus - [ spin x>> * + ] ! IUnrelated::xMulAdd + [ [ x>> ] [ + ] bi* ] ! IUnrelated::xPlus + [ [ x>> ] [ * ] [ + ] tri* ] ! IUnrelated::xMulAdd } } } dup +test-wrapper+ set [ diff --git a/basis/windows/com/wrapper/wrapper-docs.factor b/basis/windows/com/wrapper/wrapper-docs.factor index 6a6f6f2bb4..0298e80445 100644 --- a/basis/windows/com/wrapper/wrapper-docs.factor +++ b/basis/windows/com/wrapper/wrapper-docs.factor @@ -27,8 +27,8 @@ COM-INTERFACE: IUnrelated IUnknown {b06ac3f4-30e4-406b-a7cd-c29cead4552c} [ >>x drop ] ! IInherited::setX } } { "IUnrelated" { - [ swap x>> + ] ! IUnrelated::xPlus - [ spin x>> * + ] ! IUnrealted::xMulAdd + [ [ x>> ] [ + ] bi* ] ! IUnrelated::xPlus + [ [ x>> ] [ * ] [ + ] tri* ] ! IUnrealted::xMulAdd } } } """ } ;