Merge branch 'master' of git://factorcode.org/git/factor

basis/generalizations/generalizations-docs.factor

@@ -172,7 +172,7 @@ HELP: ndip
 } ;
 
 HELP: nkeep
-{ $values { "quot" quotation } { "n" integer } }
+{ $values { "n" integer } }
 { $description "A generalization of " { $link keep } " that can work " 
 "for any stack depth. The first " { $snippet "n" } " items after the quotation will be "
 "saved, the quotation called, and the items restored."

extra/alien/data/map/map-tests.factor

@@ -1,5 +1,5 @@
 ! (c)Joe Groff bsd license
-USING: alien.data.map fry generalizations kernel math.vectors
+USING: alien.data.map fry generalizations kernel locals math.vectors
 math.vectors.conversion math math.vectors.simd
 specialized-arrays tools.test ;
 FROM: alien.c-types => uchar short int float ;
@@ -19,6 +19,13 @@ IN: alien.data.map.tests
     [ dup ] data-map!( int -- float[2] )
 ] unit-test
 
+:: float-pixels>byte-pixels-locals ( floats scale bias -- bytes )
+    floats [
+        [ scale 255.0 * v*n bias 255.0 * v+n float-4 int-4 vconvert ] 4 napply
+        [ int-4 short-8 vconvert ] 2bi@
+        short-8 uchar-16 vconvert
+    ] data-map( float-4[4] -- uchar-16 ) ; inline
+
 : float-pixels>byte-pixels* ( floats scale bias -- bytes )
     '[
         [ _ 255.0 * v*n _ 255.0 * v+n float-4 int-4 vconvert ] 4 napply 
@@ -29,6 +36,22 @@ IN: alien.data.map.tests
 : float-pixels>byte-pixels ( floats -- bytes )
     1.0 0.0 float-pixels>byte-pixels* ;
 
+[
+    B{
+        127 191 255 63
+        255 25 51 76
+        76 51 229 127
+        25 255 255 255
+    } 
+] [
+    float-array{
+        0.5 0.75 1.0 0.25
+        1.0 0.1 0.2 0.3
+        0.3 0.2 0.9 0.5
+        0.1 1.0 1.5 2.0
+    } 1.0 0.0 float-pixels>byte-pixels-locals
+] unit-test
+
 [
     B{
         127 191 255 63

extra/alien/data/map/map.factor

@@ -1,7 +1,7 @@
 ! (c)Joe Groff bsd license
 USING: accessors alien alien.c-types alien.data alien.parser arrays
 byte-arrays combinators effects.parser fry generalizations kernel
-lexer locals macros math math.ranges parser sequences sequences.private ;
+lexer locals macros make math math.ranges parser sequences sequences.private ;
 IN: alien.data.map
 
 ERROR: bad-data-map-input-length byte-length iter-size remainder ;
@@ -39,27 +39,23 @@ INSTANCE: data-map-param immutable-sequence
     dup array? [ unclip swap product >fixnum ] [ 1 ] if
     2dup swap heap-size * >fixnum ; inline
 
-MACRO:: >param ( in -- quot: ( array -- param ) )
+MACRO: >param ( in -- quot: ( array -- param ) )
-    in c-type-count :> iter-length :> count :> c-type
+    c-type-count '[
-
+        [ _ _ ] dip
-    [
-        [ c-type count ] dip
         [ ]
         [ >c-ptr ]
         [ byte-length ] tri
-        iter-length
+        _
         2dup /i
         data-map-param boa
     ] ;
 
-MACRO:: alloc-param ( out -- quot: ( len -- param ) )
+MACRO: alloc-param ( out -- quot: ( len -- param ) )
-    out c-type-count :> iter-length :> count :> c-type
+    c-type-count dup '[
-
+        [ _ _ ] dip
-    [
-        [ c-type count ] dip
         [
-            iter-length * >fixnum [ (byte-array) dup ] keep
+            _ * >fixnum [ (byte-array) dup ] keep
-            iter-length
+            _
         ] keep
         data-map-param boa
     ] ;
@@ -76,14 +72,17 @@ MACRO: pack-params ( outs -- )
     outs length :> #outs
     #ins #outs + :> #params
 
-    [| quot |
+    [
-        param-quot call
+        param-quot %
         [
-            [ [ ins unpack-params quot call ] #outs ndip outs pack-params ]
+            [
-            #params neach
+                [ ins , \ unpack-params , \ @ , ] [ ] make ,
-        ] #outs nkeep
+                #outs , \ ndip , outs , \ pack-params ,
-        [ orig>> ] #outs napply
+            ] [ ] make ,
-    ] ;
+            #params , \ neach ,
+        ] [ ] make , #outs , \ nkeep ,
+        [ orig>> ] , #outs , \ napply ,
+    ] [ ] make fry \ call suffix ;
 
 MACRO: data-map ( ins outs -- )
     2dup