steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of http://dharmatech.onigirihouse.com/factor

db4
Slava Pestov 2008-02-03 14:46:18 -06:00
parent a06eec802b 1de4896c24
commit 4af437cc78
12 changed files with 247 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/io/buffers/buffers.factor
View File

@ -14,7 +14,7 @@ TUPLE: buffer size ptr fill pos ;
dup buffer-ptr free f swap set-buffer-ptr ;
: buffer-reset ( n buffer -- )
[ set-buffer-fill ] keep 0 swap set-buffer-pos ;
0 swap { set-buffer-fill set-buffer-pos } set-slots ;
: buffer-consume ( n buffer -- )
[ buffer-pos + ] keep

32
extra/io/monitor/monitor.factor
View File

@ -1,11 +1,39 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.backend kernel continuations ;
USING: io.backend kernel continuations namespaces sequences
assocs hashtables sorting arrays ;
IN: io.monitor
<PRIVATE
TUPLE: monitor queue closed? ;
: check-monitor ( monitor -- )
monitor-closed? [ "Monitor closed" throw ] when ;
: (monitor) ( delegate -- monitor )
H{ } clone {
set-delegate
set-monitor-queue
} monitor construct ;
HOOK: fill-queue io-backend ( monitor -- assoc )
: changed-file ( changed path -- )
namespace [ append ] change-at ;
: dequeue-change ( assoc -- path changes )
delete-any prune natural-sort >array ;
PRIVATE>
HOOK: <monitor> io-backend ( path recursive? -- monitor )
HOOK: next-change io-backend ( monitor -- path changes )
: next-change ( monitor -- path changed )
dup check-monitor
dup monitor-queue dup assoc-empty? [
drop dup fill-queue over set-monitor-queue next-change
] [ nip dequeue-change ] if ;
SYMBOL: +add-file+
SYMBOL: +remove-file+

8
extra/io/unix/backend/backend.factor
View File

@ -14,9 +14,9 @@ TUPLE: io-task port callbacks ;
: io-task-fd io-task-port port-handle ;
: <io-task> ( port continuation class -- task )
>r 1vector io-task construct-boa r> construct-delegate ;
inline
: <io-task> ( port continuation/f class -- task )
>r [ 1vector ] [ V{ } clone ] if* io-task construct-boa
r> construct-delegate ; inline
TUPLE: input-task ;
@ -194,7 +194,7 @@ TUPLE: mx-port mx ;
TUPLE: mx-task ;
: <mx-task> ( port -- task )
f io-task construct-boa mx-task construct-delegate ;
f mx-task <io-task> ;
M: mx-task do-io-task
io-task-port mx-port-mx 0 swap wait-for-events f ;

127
extra/io/unix/linux/linux.factor
View File

@ -1,15 +1,136 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel io.backend io.monitor io.monitor.private io.files
io.buffers io.nonblocking io.unix.backend io.unix.select
io.unix.launcher unix.linux.inotify assocs namespaces threads
continuations init math alien.c-types alien ;
IN: io.unix.linux
USING: io.backend io.unix.backend io.unix.launcher io.unix.select
namespaces kernel assocs unix.process init ;
TUPLE: linux-io ;
INSTANCE: linux-io unix-io
TUPLE: linux-monitor path wd callback ;
: <linux-monitor> ( path wd -- monitor )
f (monitor) {
set-linux-monitor-path
set-linux-monitor-wd
set-delegate
} linux-monitor construct ;
TUPLE: inotify watches ;
: wd>path ( wd -- path )
inotify get-global inotify-watches at linux-monitor-path ;
: <inotify> ( -- port )
H{ } clone
inotify_init dup io-error inotify <buffered-port>
{ set-inotify-watches set-delegate } inotify construct ;
: inotify-fd inotify get-global port-handle ;
: watches inotify get-global inotify-watches ;
: (add-watch) ( path mask -- wd )
inotify-fd -rot inotify_add_watch dup io-error ;
: check-existing ( wd -- )
watches key? [
"Cannot open multiple monitors for the same file" throw
] when ;
: add-watch ( path mask -- monitor )
dupd (add-watch)
dup check-existing
[ <linux-monitor> dup ] keep watches set-at ;
: remove-watch ( monitor -- )
dup linux-monitor-wd watches delete-at
linux-monitor-wd inotify-fd swap inotify_rm_watch io-error ;
M: linux-io <monitor> ( path recursive? -- monitor )
drop IN_CHANGE_EVENTS add-watch ;
: notify-callback ( assoc monitor -- )
linux-monitor-callback dup
[ schedule-thread-with ] [ 2drop ] if ;
M: linux-io fill-queue ( monitor -- assoc )
dup linux-monitor-callback [
"Cannot wait for changes on the same file from multiple threads" throw
] when
[ swap set-linux-monitor-callback stop ] callcc1
swap check-monitor ;
M: linux-monitor dispose ( monitor -- )
dup check-monitor
t over set-monitor-closed?
H{ } over notify-callback
remove-watch ;
: ?flag ( n mask symbol -- n )
pick rot bitand 0 > [ , ] [ drop ] if ;
: parse-action ( mask -- changed )
[
IN_CREATE +add-file+ ?flag
IN_DELETE +remove-file+ ?flag
IN_DELETE_SELF +remove-file+ ?flag
IN_MODIFY +modify-file+ ?flag
IN_ATTRIB +modify-file+ ?flag
IN_MOVED_FROM +rename-file+ ?flag
IN_MOVED_TO +rename-file+ ?flag
IN_MOVE_SELF +rename-file+ ?flag
drop
] { } make ;
: parse-file-notify ( buffer -- changed path )
{
inotify-event-wd
inotify-event-name
inotify-event-mask
} get-slots
parse-action -rot alien>char-string >r wd>path r> path+ ;
: events-exhausted? ( i buffer -- ? )
buffer-fill >= ;
: inotify-event@ ( i buffer -- alien )
buffer-ptr <displaced-alien> ;
: next-event ( i buffer -- i buffer )
2dup inotify-event@
inotify-event-len "inotify-event" heap-size +
swap >r + r> ;
: parse-file-notifications ( i buffer -- )
2dup events-exhausted? [ 2drop ] [
2dup inotify-event@ parse-file-notify changed-file
next-event parse-file-notifications
] if ;
: read-notifications ( port -- )
dup refill drop
0 over parse-file-notifications
0 swap buffer-reset ;
TUPLE: inotify-task ;
: <inotify-task> ( port -- task )
f inotify-task <input-task> ;
: init-inotify ( mx -- )
<inotify>
dup inotify set-global
<inotify-task> swap register-io-task ;
M: inotify-task do-io-task ( task -- )
io-task-port read-notifications f ;
M: linux-io init-io ( -- )
<select-mx> mx set-global ;
<select-mx> mx set-global ; ! init-inotify ;
T{ linux-io } set-io-backend

51
extra/io/windows/nt/monitor/monitor.factor
View File

@ -3,12 +3,10 @@
USING: alien.c-types destructors io.windows
io.windows.nt.backend kernel math windows windows.kernel32
windows.types libc assocs alien namespaces continuations
io.monitor io.nonblocking io.buffers io.files io sequences
hashtables sorting arrays combinators ;
io.monitor io.monitor.private io.nonblocking io.buffers io.files
io sequences hashtables sorting arrays combinators ;
IN: io.windows.nt.monitor
TUPLE: monitor path recursive? queue closed? ;
: open-directory ( path -- handle )
FILE_LIST_DIRECTORY
share-mode
@ -22,23 +20,26 @@ TUPLE: monitor path recursive? queue closed? ;
dup add-completion
f <win32-file> ;
TUPLE: win32-monitor path recursive? ;
: <win32-monitor> ( path recursive? port -- monitor )
(monitor) {
set-win32-monitor-path
set-win32-monitor-recursive?
set-delegate
} win32-monitor construct ;
M: windows-nt-io <monitor> ( path recursive? -- monitor )
[
>r dup open-directory monitor <buffered-port> r> {
set-monitor-path
set-delegate
set-monitor-recursive?
} monitor construct
over open-directory win32-monitor <buffered-port>
<win32-monitor>
] with-destructors ;
: check-closed ( monitor -- )
port-type closed eq? [ "Monitor closed" throw ] when ;
: begin-reading-changes ( monitor -- overlapped )
dup port-handle win32-file-handle
over buffer-ptr
pick buffer-size
roll monitor-recursive? 1 0 ?
roll win32-monitor-recursive? 1 0 ?
FILE_NOTIFY_CHANGE_ALL
0 <uint>
(make-overlapped)
@ -49,6 +50,7 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
[
dup begin-reading-changes
swap [ save-callback ] 2keep
dup check-monitor ! we may have closed it...
get-overlapped-result
] with-port-timeout
] with-destructors ;
@ -63,30 +65,19 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
{ [ t ] [ +modify-file+ ] }
} cond nip ;
: changed-file ( directory buffer -- changed path )
: parse-file-notify ( directory buffer -- changed path )
{
FILE_NOTIFY_INFORMATION-FileName
FILE_NOTIFY_INFORMATION-FileNameLength
FILE_NOTIFY_INFORMATION-Action
} get-slots >r memory>u16-string path+ r> parse-action swap ;
} get-slots parse-action 1array -rot
memory>u16-string path+ ;
: (changed-files) ( directory buffer -- )
2dup changed-file namespace [ swap add ] change-at
2dup parse-file-notify changed-file
dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
[ 3drop ] [ swap <displaced-alien> (changed-files) ] if ;
: changed-files ( directory buffer len -- assoc )
M: windows-nt-io fill-queue ( monitor -- assoc )
dup win32-monitor-path over buffer-ptr rot read-changes
[ zero? [ 2drop ] [ (changed-files) ] if ] H{ } make-assoc ;
: fill-queue ( monitor -- )
dup monitor-path over buffer-ptr pick read-changes
changed-files
swap set-monitor-queue ;
M: windows-nt-io next-change ( monitor -- path changes )
dup check-closed
dup monitor-queue dup assoc-empty? [
drop dup fill-queue next-change
] [
nip delete-any prune natural-sort >array
] if ;

26
extra/partial-apply/partial-apply.factor Normal file
View File

@ -0,0 +1,26 @@
USING: kernel sequences quotations math parser
shuffle combinators.cleave combinators.lib sequences.lib ;
IN: partial-apply
! Basic conceptual implementation. Todo: get it to compile.
: apply-n ( obj quot i -- quot ) 1+ [ -nrot ] curry swap compose curry ;
SYMBOL: _
SYMBOL: ~
: blank-positions ( quot -- seq )
[ length 2 - ] [ _ indices ] bi [ - ] map-with ;
: partial-apply ( pattern -- quot )
[ blank-positions length nrev ]
[ peek 1quotation ]
[ blank-positions ]
tri
[ apply-n ] each ;
: $[ \ ] [ >quotation ] parse-literal \ partial-apply parsed ; parsing

10
extra/sequences/lib/lib.factor
View File

@ -140,3 +140,13 @@ PRIVATE>
: ?second ( seq -- second/f ) 1 swap ?nth ; inline
: ?third ( seq -- third/f ) 2 swap ?nth ; inline
: ?fourth ( seq -- fourth/f ) 3 swap ?nth ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! List the positions of obj in seq
: indices ( seq obj -- seq )
>r dup length swap r>
[ = [ ] [ drop f ] if ] curry
2map
[ ] subset ;

5
extra/shuffle/shuffle.factor
View File

@ -30,3 +30,8 @@ MACRO: ntuck ( n -- ) 2 + [ dup , -nrot ] bake ;
: 4drop ( a b c d -- ) 3drop drop ; inline
: tuckd ( x y z -- z x y z ) 2 ntuck ; inline
MACRO: nrev ( n -- quot )
[ 1+ ] map
reverse
[ [ -nrot ] curry ] map concat ;

17
extra/unix/linux/inotify/inotify.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax ;
USING: alien.syntax math math.bitfields ;
IN: unix.linux.inotify
C-STRUCT: inotify-event
@ -8,7 +8,7 @@ C-STRUCT: inotify-event
{ "uint" "mask" } ! watch mask
{ "uint" "cookie" } ! cookie to synchronize two events
{ "uint" "len" } ! length (including nulls) of name
{ "char[1]" "name" } ! stub for possible name
{ "char[0]" "name" } ! stub for possible name
;
: IN_ACCESS HEX: 1 ; inline ! File was accessed
@ -37,6 +37,13 @@ C-STRUCT: inotify-event
: IN_ISDIR HEX: 40000000 ; inline ! event occurred against dir
: IN_ONESHOT HEX: 80000000 ; inline ! only send event once
: IN_CHANGE_EVENTS
{
IN_MODIFY IN_ATTRIB IN_MOVED_FROM
IN_MOVED_TO IN_DELETE IN_CREATE IN_DELETE_SELF
IN_MOVE_SELF
} flags ; foldable
: IN_ALL_EVENTS
{
IN_ACCESS IN_MODIFY IN_ATTRIB IN_CLOSE_WRITE
@ -45,6 +52,6 @@ C-STRUCT: inotify-event
IN_MOVE_SELF
} flags ; foldable
FUNCTION: int inotify_init ( void ) ;
FUNCTION: int inotify_add_watch ( int fd, char* name, u32 mask ) ;
FUNCTION: int inotify_rm_watch ( int fd, u32 wd ) ;
FUNCTION: int inotify_init ( ) ;
FUNCTION: int inotify_add_watch ( int fd, char* name, uint mask ) ;
FUNCTION: int inotify_rm_watch ( int fd, uint wd ) ;

16
extra/x11/windows/windows.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types hashtables kernel math math.vectors
USING: alien alien.c-types hashtables kernel math math.vectors math.bitfields
namespaces sequences x11.xlib x11.constants x11.glx ;
IN: x11.windows
@ -12,7 +12,6 @@ IN: x11.windows
XCreateColormap ;
: event-mask ( -- n )
<<<<<<< HEAD:extra/x11/windows/windows.factor
{
ExposureMask
StructureNotifyMask
@ -26,19 +25,6 @@ IN: x11.windows
LeaveWindowMask
PropertyChangeMask
} flags ;
=======
ExposureMask
StructureNotifyMask bitor
KeyPressMask bitor
KeyReleaseMask bitor
ButtonPressMask bitor
ButtonReleaseMask bitor
PointerMotionMask bitor
FocusChangeMask bitor
EnterWindowMask bitor
LeaveWindowMask bitor
PropertyChangeMask bitor ;
>>>>>>> a05c18152b59073c49aa313ba685516310ec74a8:extra/x11/windows/windows.factor
: window-attributes ( visinfo -- attributes )
"XSetWindowAttributes" <c-object>

22
extra/x11/xlib/xlib.factor
View File

@ -12,7 +12,7 @@
! and note the section.
USING: kernel arrays alien alien.c-types alien.syntax
math words sequences namespaces continuations ;
math math.bitfields words sequences namespaces continuations ;
IN: x11.xlib
LIBRARY: xlib
@ -1078,16 +1078,16 @@ FUNCTION: Status XWithdrawWindow (
! 17.1.7 - Setting and Reading the WM_NORMAL_HINTS Property
: USPosition 1 0 shift ; inline
: USSize 1 1 shift ; inline
: PPosition 1 2 shift ; inline
: PSize 1 3 shift ; inline
: PMinSize 1 4 shift ; inline
: PMaxSize 1 5 shift ; inline
: PResizeInc 1 6 shift ; inline
: PAspect 1 7 shift ; inline
: PBaseSize 1 8 shift ; inline
: PWinGravity 1 9 shift ; inline
: USPosition 1 0 shift ; inline
: USSize 1 1 shift ; inline
: PPosition 1 2 shift ; inline
: PSize 1 3 shift ; inline
: PMinSize 1 4 shift ; inline
: PMaxSize 1 5 shift ; inline
: PResizeInc 1 6 shift ; inline
: PAspect 1 7 shift ; inline
: PBaseSize 1 8 shift ; inline
: PWinGravity 1 9 shift ; inline
: PAllHints
{ PPosition PSize PMinSize PMaxSize PResizeInc PAspect } flags ; foldable

2
vm/os-linux.h
View File

@ -1,3 +1,5 @@
#include <sys/syscall.h>
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)