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

extra/io/buffers/buffers.factor

@@ -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

extra/io/monitor/monitor.factor

@@ -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+

extra/io/unix/backend/backend.factor

@@ -14,9 +14,9 @@ TUPLE: io-task port callbacks ;
 
 : io-task-fd io-task-port port-handle ;
 
-: <io-task> ( port continuation class -- task )
+: <io-task> ( port continuation/f class -- task )
-    >r 1vector io-task construct-boa r> construct-delegate ;
+    >r [ 1vector ] [ V{ } clone ] if* io-task construct-boa
-    inline
+    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 ;

extra/io/unix/linux/linux.factor

@@ -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
 

extra/io/windows/nt/monitor/monitor.factor

@@ -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
+io.monitor io.monitor.private io.nonblocking io.buffers io.files
-hashtables sorting arrays combinators ;
+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> {
+        over open-directory win32-monitor <buffered-port>
-            set-monitor-path
+        <win32-monitor>
-            set-delegate
-            set-monitor-recursive?
-        } monitor construct
     ] 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 ;

extra/partial-apply/partial-apply.factor

@@ -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
+

extra/sequences/lib/lib.factor

@@ -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 ;

extra/shuffle/shuffle.factor

@@ -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 ;

extra/unix/linux/inotify/inotify.factor

@@ -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_init ( ) ;
-FUNCTION: int inotify_add_watch ( int fd, char* name, u32 mask  ) ;
+FUNCTION: int inotify_add_watch ( int fd, char* name, uint mask  ) ;
-FUNCTION: int inotify_rm_watch ( int fd, u32 wd ) ;
+FUNCTION: int inotify_rm_watch ( int fd, uint wd ) ;

extra/x11/windows/windows.factor

@@ -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>

extra/x11/xlib/xlib.factor

@@ -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
+: USPosition    1 0 shift ; inline
-: USSize	1 1 shift ; inline
+: USSize        1 1 shift ; inline
-: PPosition	1 2 shift ; inline
+: PPosition     1 2 shift ; inline
-: PSize		1 3 shift ; inline
+: PSize         1 3 shift ; inline
-: PMinSize	1 4 shift ; inline
+: PMinSize      1 4 shift ; inline
-: PMaxSize	1 5 shift ; inline
+: PMaxSize      1 5 shift ; inline
-: PResizeInc	1 6 shift ; inline
+: PResizeInc    1 6 shift ; inline
-: PAspect	1 7 shift ; inline
+: PAspect       1 7 shift ; inline
-: PBaseSize	1 8 shift ; inline
+: PBaseSize     1 8 shift ; inline
-: PWinGravity	1 9 shift ; inline
+: PWinGravity   1 9 shift ; inline
 : PAllHints 
     { PPosition PSize PMinSize PMaxSize PResizeInc PAspect } flags ; foldable
 

vm/os-linux.h

@@ -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)