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