eliminate spin from basis

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 ;
 

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 ;

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

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? [

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 -- ? )

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 ;

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

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 ;

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 [

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
     } }
 } <com-wrapper>""" } ;