cuda: more API cleanups:

- remove useless with-cuda and with-cuda-program combinators
	- eliminate redundant cuda-device, cuda-context variables
	- rearrange arguments of with-*cuda-context to ( device flags quot -- )
	- don't pass context to with-cuda-context quot
	- add context-device word to ask for current device

extra/cuda/cuda.factor

@@ -10,40 +10,20 @@ sequences words cuda.libraries ;
 QUALIFIED-WITH: alien.c-types c
 IN: cuda
 
-TUPLE: launcher
-{ device integer initial: 0 }
-{ device-flags initial: 0 } ;
-
-: <launcher> ( device-id -- launcher )
-    launcher new
-        swap >>device ; inline
-
 TUPLE: function-launcher
 dim-grid dim-block shared-size stream ;
 
-: (set-up-cuda-context) ( flags device create-quot -- )
+: (set-up-cuda-context) ( device flags create-quot -- )
     H{ } clone cuda-modules set-global
     H{ } clone cuda-functions set
     call ; inline
 
 : (with-cuda-context) ( context quot -- )
-    [ '[ _ @ ] ]
+    swap '[ [ sync-context ] ignore-errors _ destroy-context ] [ ] cleanup ; inline
-    [ drop '[ [ sync-context ] ignore-errors _ destroy-context ] ] 2bi
-    [ ] cleanup ; inline
 
-: with-cuda-context ( flags device quot -- )
+: with-cuda-context ( device flags quot -- )
     [ [ create-context ] (set-up-cuda-context) ] dip (with-cuda-context) ; inline
 
-: with-cuda-program ( flags device quot -- )
-    [ dup cuda-device set ] 2dip
-    '[ cuda-context set _ call ] with-cuda-context ; inline
-
-: with-cuda ( launcher quot -- )
-    init-cuda [
-        [ cuda-launcher set ]
-        [ [ device>> ] [ device-flags>> ] bi ] bi
-    ] [ with-cuda-program ] bi* ; inline
-
 : c-type>cuda-setter ( c-type -- n cuda-type )
     {
         { [ dup c:int = ] [ drop 4 [ cuda-int* ] ] }

extra/cuda/demos/hello-world/hello-world.factor

@@ -11,9 +11,10 @@ CUDA-LIBRARY: hello vocab:cuda/demos/hello-world/hello.ptx
 CUDA-FUNCTION: helloWorld ( char* string-ptr ) ;
 
 : cuda-hello-world ( -- )
+    init-cuda
     [
         [
-            cuda-launcher get device>> number>string
+            context-device number>string
             "CUDA device " ": " surround write
             "Hello World!" >byte-array [ - ] map-index host>device &cuda-free
 

extra/cuda/demos/prefix-sum/prefix-sum.factor

@@ -8,9 +8,8 @@ CUDA-LIBRARY: prefix-sum vocab:cuda/demos/prefix-sum/prefix-sum.ptx
 CUDA-FUNCTION: prefix_sum_block ( uint* in, uint* out, uint n ) ;
 
 :: cuda-prefix-sum ( -- )
-    T{ launcher { device 0 } }
+    0 0 [
-    [
         ! { 1 1 1 } { 2 1 } 0 3<<< prefix_sum_block
-    ] with-cuda ;
+    ] with-cuda-context ;
 
 MAIN: cuda-prefix-sum

extra/cuda/devices/devices.factor

@@ -16,7 +16,7 @@ IN: cuda.devices
     #cuda-devices iota [ n>cuda-device ] map ;
 
 : with-each-cuda-device ( quot -- )
-    [ enumerate-cuda-devices ] dip '[ <launcher> _ with-cuda ] each ; inline
+    [ enumerate-cuda-devices ] dip '[ 0 _ with-cuda-context ] each ; inline
 
 : cuda-device-properties ( n -- properties )
     [ CUdevprop <struct> ] dip
@@ -81,6 +81,6 @@ IN: cuda.devices
     grid-size block-size per-block-shared ; inline
 
 : distribute-jobs ( job-count per-job-shared -- launcher )
-    cuda-device get cuda-device-properties 
+    context-device cuda-device-properties 
     [ sharedMemPerBlock>> ] [ maxThreadsDim>> first ] bi
     (distribute-jobs) 3<<< ; inline

extra/cuda/gl/gl.factor

@@ -4,11 +4,12 @@ continuations cuda cuda.ffi cuda.gl.ffi cuda.utils destructors
 fry gpu.buffers kernel ;
 IN: cuda.gl
 
-: create-gl-cuda-context ( flags device -- context )
+: create-gl-cuda-context ( device flags -- context )
+    swap
     [ CUcontext <c-object> ] 2dip
     [ cuGLCtxCreate cuda-error ] 3keep 2drop *void* ; inline
 
-: with-gl-cuda-context ( flags device quot -- )
+: with-gl-cuda-context ( device flags quot -- )
     [ [ create-gl-cuda-context ] (set-up-cuda-context) ] dip (with-cuda-context) ; inline 
 
 : gl-buffer>resource ( gl-buffer flags -- resource )

extra/cuda/utils/utils.factor

@@ -6,11 +6,8 @@ io io.backend io.encodings.utf8 kernel math.parser namespaces
 prettyprint sequences ;
 IN: cuda.utils
 
-SYMBOL: cuda-device
-SYMBOL: cuda-context
 SYMBOL: cuda-module
 SYMBOL: cuda-function
-SYMBOL: cuda-launcher
 
 SYMBOL: cuda-modules
 SYMBOL: cuda-functions
@@ -38,13 +35,17 @@ ERROR: throw-cuda-error n ;
         get-function-ptr* cuda-function set
     ] dip call ; inline
 
-: create-context ( flags device -- context )
+: create-context ( device flags -- context )
+    swap
     [ CUcontext <c-object> ] 2dip
     [ cuCtxCreate cuda-error ] 3keep 2drop *void* ; inline
 
 : sync-context ( -- )
     cuCtxSynchronize cuda-error ; inline
 
+: context-device ( -- n )
+    CUdevice <c-object> [ cuCtxGetDevice cuda-error ] keep *int ; inline
+
 : destroy-context ( context -- ) cuCtxDestroy cuda-error ; inline
 
 : launch-function* ( function -- ) cuLaunch cuda-error ; inline
@@ -95,3 +96,4 @@ ERROR: throw-cuda-error n ;
 : function-shared-size ( n -- )
     [ cuda-function get ] dip
     cuFuncSetSharedSize cuda-error ; inline
+