Removing call-with call-with2; use cleave instead
parent
618962aa71
commit
fd9bf040ba
|
@ -17,6 +17,9 @@ IN: combinators.cleave
|
||||||
|
|
||||||
: 2bi ( obj obj quot quot -- val val ) >r 2keep r> call ; inline
|
: 2bi ( obj obj quot quot -- val val ) >r 2keep r> call ; inline
|
||||||
|
|
||||||
|
: 2tri ( obj obj quot quot quot -- val val val )
|
||||||
|
>r >r 2keep r> 2keep r> call ; inline
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
! General cleave
|
! General cleave
|
||||||
|
|
|
@ -133,9 +133,6 @@ MACRO: parallel-call ( quots -- )
|
||||||
: (make-call-with) ( quots -- quot )
|
: (make-call-with) ( quots -- quot )
|
||||||
[ [ keep ] curry ] map concat [ drop ] append ;
|
[ [ keep ] curry ] map concat [ drop ] append ;
|
||||||
|
|
||||||
MACRO: call-with ( quots -- )
|
|
||||||
(make-call-with) ;
|
|
||||||
|
|
||||||
MACRO: map-call-with ( quots -- )
|
MACRO: map-call-with ( quots -- )
|
||||||
[ (make-call-with) ] keep length [ narray ] curry compose ;
|
[ (make-call-with) ] keep length [ narray ] curry compose ;
|
||||||
|
|
||||||
|
@ -143,9 +140,6 @@ MACRO: map-call-with ( quots -- )
|
||||||
[ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat
|
[ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat
|
||||||
[ 2drop ] append ;
|
[ 2drop ] append ;
|
||||||
|
|
||||||
MACRO: call-with2 ( quots -- )
|
|
||||||
(make-call-with2) ;
|
|
||||||
|
|
||||||
MACRO: map-call-with2 ( quots -- )
|
MACRO: map-call-with2 ( quots -- )
|
||||||
[ (make-call-with2) ] keep length [ narray ] curry append ;
|
[ (make-call-with2) ] keep length [ narray ] curry append ;
|
||||||
|
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
USING: alien.c-types io.files io.windows kernel
|
USING: alien.c-types io.files io.windows kernel
|
||||||
math windows windows.kernel32 combinators.cleave
|
math windows windows.kernel32 combinators.cleave
|
||||||
windows.time calendar combinators math.functions
|
windows.time calendar combinators math.functions
|
||||||
sequences combinators.lib namespaces words symbols ;
|
sequences namespaces words symbols ;
|
||||||
IN: io.windows.files
|
IN: io.windows.files
|
||||||
|
|
||||||
SYMBOLS: +read-only+ +hidden+ +system+
|
SYMBOLS: +read-only+ +hidden+ +system+
|
||||||
|
@ -11,34 +11,27 @@ SYMBOLS: +read-only+ +hidden+ +system+
|
||||||
+sparse-file+ +reparse-point+ +compressed+ +offline+
|
+sparse-file+ +reparse-point+ +compressed+ +offline+
|
||||||
+not-content-indexed+ +encrypted+ ;
|
+not-content-indexed+ +encrypted+ ;
|
||||||
|
|
||||||
: expand-constants ( word/obj -- obj'/obj )
|
: win32-file-attribute ( n attr symbol -- n )
|
||||||
dup word? [ execute ] when ;
|
>r dupd mask? [ r> , ] [ r> drop ] if ;
|
||||||
|
|
||||||
: get-flags ( n seq -- seq' )
|
|
||||||
[
|
|
||||||
[
|
|
||||||
first2 expand-constants
|
|
||||||
[ swapd mask? [ , ] [ drop ] if ] 2curry
|
|
||||||
] map call-with
|
|
||||||
] { } make ;
|
|
||||||
|
|
||||||
: win32-file-attributes ( n -- seq )
|
: win32-file-attributes ( n -- seq )
|
||||||
{
|
[
|
||||||
{ +read-only+ FILE_ATTRIBUTE_READONLY }
|
FILE_ATTRIBUTE_READONLY +read-only+ win32-file-attribute
|
||||||
{ +hidden+ FILE_ATTRIBUTE_HIDDEN }
|
FILE_ATTRIBUTE_HIDDEN +hidden+ win32-file-attribute
|
||||||
{ +system+ FILE_ATTRIBUTE_SYSTEM }
|
FILE_ATTRIBUTE_SYSTEM +system+ win32-file-attribute
|
||||||
{ +directory+ FILE_ATTRIBUTE_DIRECTORY }
|
FILE_ATTRIBUTE_DIRECTORY +directory+ win32-file-attribute
|
||||||
{ +archive+ FILE_ATTRIBUTE_ARCHIVE }
|
FILE_ATTRIBUTE_ARCHIVE +archive+ win32-file-attribute
|
||||||
{ +device+ FILE_ATTRIBUTE_DEVICE }
|
FILE_ATTRIBUTE_DEVICE +device+ win32-file-attribute
|
||||||
{ +normal+ FILE_ATTRIBUTE_NORMAL }
|
FILE_ATTRIBUTE_NORMAL +normal+ win32-file-attribute
|
||||||
{ +temporary+ FILE_ATTRIBUTE_TEMPORARY }
|
FILE_ATTRIBUTE_TEMPORARY +temporary+ win32-file-attribute
|
||||||
{ +sparse-file+ FILE_ATTRIBUTE_SPARSE_FILE }
|
FILE_ATTRIBUTE_SPARSE_FILE +sparse-file+ win32-file-attribute
|
||||||
{ +reparse-point+ FILE_ATTRIBUTE_REPARSE_POINT }
|
FILE_ATTRIBUTE_REPARSE_POINT +reparse-point+ win32-file-attribute
|
||||||
{ +compressed+ FILE_ATTRIBUTE_COMPRESSED }
|
FILE_ATTRIBUTE_COMPRESSED +compressed+ win32-file-attribute
|
||||||
{ +offline+ FILE_ATTRIBUTE_OFFLINE }
|
FILE_ATTRIBUTE_OFFLINE +offline+ win32-file-attribute
|
||||||
{ +not-content-indexed+ FILE_ATTRIBUTE_NOT_CONTENT_INDEXED }
|
FILE_ATTRIBUTE_NOT_CONTENT_INDEXED +not-content-indexed+ win32-file-attribute
|
||||||
{ +encrypted+ FILE_ATTRIBUTE_ENCRYPTED }
|
FILE_ATTRIBUTE_ENCRYPTED +encrypted+ win32-file-attribute
|
||||||
} get-flags ;
|
drop
|
||||||
|
] { } make ;
|
||||||
|
|
||||||
: win32-file-type ( n -- symbol )
|
: win32-file-type ( n -- symbol )
|
||||||
FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ;
|
FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ;
|
||||||
|
|
|
@ -5,7 +5,7 @@ io.windows io.windows.nt.pipes libc io.nonblocking
|
||||||
io.streams.duplex windows.types math windows.kernel32 windows
|
io.streams.duplex windows.types math windows.kernel32 windows
|
||||||
namespaces io.launcher kernel sequences windows.errors assocs
|
namespaces io.launcher kernel sequences windows.errors assocs
|
||||||
splitting system threads init strings combinators
|
splitting system threads init strings combinators
|
||||||
io.backend new-slots accessors ;
|
io.backend new-slots accessors concurrency.flags ;
|
||||||
IN: io.windows.launcher
|
IN: io.windows.launcher
|
||||||
|
|
||||||
TUPLE: CreateProcess-args
|
TUPLE: CreateProcess-args
|
||||||
|
@ -137,18 +137,18 @@ M: windows-io kill-process* ( handle -- )
|
||||||
dup HEX: ffffffff = [ win32-error ] when
|
dup HEX: ffffffff = [ win32-error ] when
|
||||||
dup WAIT_TIMEOUT = [ 2drop t ] [ swap nth process-exited f ] if ;
|
dup WAIT_TIMEOUT = [ 2drop t ] [ swap nth process-exited f ] if ;
|
||||||
|
|
||||||
|
SYMBOL: wait-flag
|
||||||
|
|
||||||
: wait-loop ( -- )
|
: wait-loop ( -- )
|
||||||
processes get dup assoc-empty?
|
processes get dup assoc-empty?
|
||||||
[ drop f sleep-until ]
|
[ drop wait-flag get-global lower-flag ]
|
||||||
[ wait-for-processes [ 100 sleep ] when ] if ;
|
[ wait-for-processes [ 100 sleep ] when ] if ;
|
||||||
|
|
||||||
SYMBOL: wait-thread
|
|
||||||
|
|
||||||
: start-wait-thread ( -- )
|
: start-wait-thread ( -- )
|
||||||
[ wait-loop t ] "Process wait" spawn-server
|
<flag> wait-flag set-global
|
||||||
wait-thread set-global ;
|
[ wait-loop t ] "Process wait" spawn-server drop ;
|
||||||
|
|
||||||
M: windows-io register-process
|
M: windows-io register-process
|
||||||
drop wait-thread get-global interrupt ;
|
drop wait-flag get-global raise-flag ;
|
||||||
|
|
||||||
[ start-wait-thread ] "io.windows.launcher" add-init-hook
|
[ start-wait-thread ] "io.windows.launcher" add-init-hook
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel opengl.gl alien.c-types continuations namespaces
|
USING: kernel opengl.gl alien.c-types continuations namespaces
|
||||||
assocs alien libc opengl math sequences combinators.lib
|
assocs alien libc opengl math sequences combinators.lib
|
||||||
macros arrays ;
|
macros arrays combinators.cleave ;
|
||||||
IN: opengl.shaders
|
IN: opengl.shaders
|
||||||
|
|
||||||
: with-gl-shader-source-ptr ( string quot -- )
|
: with-gl-shader-source-ptr ( string quot -- )
|
||||||
|
@ -117,7 +117,7 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ;
|
||||||
: (make-with-gl-program) ( uniforms quot -- q )
|
: (make-with-gl-program) ( uniforms quot -- q )
|
||||||
[
|
[
|
||||||
\ dup ,
|
\ dup ,
|
||||||
[ swap (with-gl-program-uniforms) , \ call-with , % ]
|
[ swap (with-gl-program-uniforms) , \ cleave , % ]
|
||||||
[ ] make ,
|
[ ] make ,
|
||||||
\ (with-gl-program) ,
|
\ (with-gl-program) ,
|
||||||
] [ ] make ;
|
] [ ] make ;
|
||||||
|
|
Loading…
Reference in New Issue