Merge git://factorcode.org/git/factor

core/assocs/assocs.factor

@@ -77,6 +77,9 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
 : rename-at ( newkey key assoc -- )
     tuck delete-at* [ -rot set-at ] [ 3drop ] if ;
 
+: delete-any ( assoc -- element )
+    [ [ 2drop t ] assoc-find 2drop dup ] keep delete-at ;
+
 : assoc-empty? ( assoc -- ? )
     assoc-size zero? ;
 

core/compiler/compiler.factor

@@ -42,9 +42,6 @@ IN: compiler
     [ dupd compile-failed f save-effect ]
     recover ;
 
-: delete-any ( assoc -- element )
-    [ [ 2drop t ] assoc-find 2drop dup ] keep delete-at ;
-
 : compile-loop ( assoc -- )
     dup assoc-empty? [ drop ] [
         dup delete-any (compile)

extra/io/monitor/monitor.factor

@@ -0,0 +1,11 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.backend ;
+IN: io.monitor
+
+HOOK: <monitor> io-backend ( path -- monitor )
+
+HOOK: next-change io-backend ( monitor -- path )
+
+: with-monitor ( directory quot -- )
+    >r <monitor> r> over [ close-monitor ] curry [ ] cleanup ;

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

@@ -0,0 +1,74 @@
+! Copyright (C) 2008 Doug Coleman, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types destructors io.windows kernel math windows
+windows.kernel32 windows.types libc assocs alien namespaces
+continuations io.monitor ;
+IN: io.windows.nt.monitor
+
+TUPLE: monitor handle buffer queue closed? ;
+
+: open-directory ( path -- handle )
+    [
+        FILE_LIST_DIRECTORY
+        share-mode
+        f
+        OPEN_EXISTING
+        FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED bitor
+        f
+        CreateFile dup invalid-handle? dup close-later
+    ] with-destructors ;
+
+: buffer-size 65536 ; inline
+
+M: windows-nt-io <monitor> ( path -- monitor )
+    [
+        open-directory
+        buffer-size malloc dup free-later f
+    ] with-destructors
+    f monitor construct-boa ;
+
+: check-closed ( monitor -- )
+    monitor-closed? [ "Monitor closed" throw ] when ;
+
+: close-monitor ( monitor -- )
+    dup check-closed
+    dup monitor-buffer free
+    dup monitor-handle CloseHandle drop
+    t swap set-monitor-closed? ;
+
+: fill-buffer ( monitor -- bytes )
+    [
+        dup monitor-handle
+        swap monitor-buffer
+        buffer-size
+        TRUE
+        FILE_NOTIFY_CHANGE_ALL
+        0 <uint> [
+            f
+            f
+            ReadDirectoryChangesW win32-error=0/f
+        ] keep *uint
+    ] with-destructors ;
+
+: (changed-files) ( buffer -- )
+    dup {
+        FILE_NOTIFY_INFORMATION-NextEntryOffset
+        FILE_NOTIFY_INFORMATION-FileName
+        FILE_NOTIFY_INFORMATION-FileNameLength
+    } get-slots memory>string dup set
+    dup zero? [ 2drop ] [
+        swap <displaced-alien> (changed-files)
+    ] if ;
+
+: changed-files ( buffer len -- assoc )
+    [ zero? [ drop ] [ (changed-files) ] if ] H{ } make-assoc ;
+
+: fill-queue ( monitor -- )
+    dup monitor-buffer
+    over fill-buffer changed-files
+    swap set-monitor-queue ;
+
+M: windows-nt-io next-change ( monitor -- path )
+    dup check-closed
+    dup monitor-queue dup assoc-empty?
+    [ drop dup fill-queue next-change ] [ nip delete-any ] if ;

extra/windows/kernel32/kernel32.factor

@@ -87,7 +87,7 @@ C-STRUCT: FILE_NOTIFY_INFORMATION
     { "DWORD" "NextEntryOffset" }
     { "DWORD" "Action" }
     { "DWORD" "FileNameLength" }
-    { "WCHAR*" "FileName" } ;
+    { "WCHAR[1]" "FileName" } ;
 TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION
 
 : STD_INPUT_HANDLE  -10 ; inline