eliminate spin from basis

diff --git a/basis/images/jpeg/jpeg.factor b/basis/images/jpeg/jpeg.factor
index 4f10808b040887e5f103abafa8d83a5fdbdf7ca6..e8af7144ad2cb24ee2cb10a96eecea515ae08d8b 100644 (file)
--- 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 452dc4a409d91908aa301b2052d658c42624d2ba..1301d699134b23147b09814d2eea4648f9d05b7b 100755 (executable)
--- 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 <int> [ ! bytes
-        f <void*> ! key
-        f <void*> [ ! overlapped
-            us [ 1000 /i ] [ INFINITE ] if* ! timeout
-            GetQueuedCompletionStatus zero?
-        ] keep
-        *void* dup [ OVERLAPPED memory>struct ] when
-    ] keep *int spin ;
+    0 <int> :> bytes
+    f <void*> :> key
+    f <void*> :> 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 8d057de720d8673852c7104ef50f4fe77a4e066f..8fa41c502613e33e03557de03fa421517da6a88b 100755 (executable)
--- 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 8411447aac3a183e1ba7b99558b3770c32146a03..5c154a6820a2f68dce5049b3ed3d9ce2b69dd74d 100755 (executable)
--- 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 eea31dd34e700c5475d231658dea0468da04ae29..d66fdd0c089eaacd055ef5926006c17123d4267a 100644 (file)
--- 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 0179216e62a7acc1f0a474e613695316dac56150..256baabd5ed825c457cf8b72a73cfad945286092 100644 (file)
--- 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 876d898cb4e48ca36ad058bf5758b704bdbc7f4e..fcde135cf887c0fb1af245ef8332f1d634624f91 100644 (file)
--- 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 f0ee13dd382c205cd55806fc3097a290463cc5ee..f2c5691452458497180028612a5185d87aeaf571 100644 (file)
--- 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 ae8ef62c1631d7272efe80fa532ab3b76a33e789..25e30829c091f13bf77cad24a4a2bbf0092e0d79 100644 (file)
--- a/basis/windows/com/com-tests.factor
+++ b/basis/windows/com/com-tests.factor
@@ -44,8 +44,8 @@ C: <test-implementation> test-implementation
         [ >>x drop ] ! IInherited::setX
     } }
     { IUnrelated {
-        [ swap x>> + ] ! IUnrelated::xPlus
-        [ spin x>> * + ] ! IUnrelated::xMulAdd
+        [ [ x>> ] [ + ] bi* ] ! IUnrelated::xPlus
+        [ [ x>> ] [ * ] [ + ] tri* ] ! IUnrelated::xMulAdd
     } }
 } <com-wrapper>
 dup +test-wrapper+ set [

diff --git a/basis/windows/com/wrapper/wrapper-docs.factor b/basis/windows/com/wrapper/wrapper-docs.factor
index 6a6f6f2bb44ec8dd73699a55e786fc36d37a3fbd..0298e80445fb27436bbc003c72329404e3db2dc9 100644 (file)
--- 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\r
     } }\r
     { "IUnrelated" {\r
-        [ swap x>> + ]   ! IUnrelated::xPlus\r
-        [ spin x>> * + ] ! IUnrealted::xMulAdd\r
+        [ [ x>> ] [ + ] bi* ]   ! IUnrelated::xPlus\r
+        [ [ x>> ] [ * ] [ + ] tri* ] ! IUnrealted::xMulAdd\r
     } }\r
 } <com-wrapper>""" } ;\r
 \r