1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
implementation module Inotify
import Data.Either
import Data.Maybe
import StdArray
import StdBool
import StdFunc
import StdInt
import StdList
import StdString
from StdOverloaded import class zero(zero)
import code from "inotify_c.o"
:: *Inotify st = { fd :: *Int
, watches :: [(INWatch, INCallback st)]
, state :: st
}
:: INWatch :== Int
(|-) infixl 6 :: (INMask INMask -> INMask)
(|-) = bitor
inotify_init :: st -> Maybe *(Inotify st)
inotify_init st
= let fd = c_init 0 in if (fd < 0) Nothing (Just {fd=fd, watches=[], state=st})
where
c_init :: !Int -> *Int
c_init i = code {
ccall clean_inotify_init "I:I"
}
inotify_close :: *(Inotify st) -> st
inotify_close {fd,state} = c_close fd state
where
c_close :: !*Int !st -> st
c_close fd st = code {
ccall close "I:V:A"
}
inotify_add_watch :: (INCallback st) !Int !String !*(Inotify st) -> *(Either Int INWatch, *Inotify st)
inotify_add_watch f mask fname inot=:{fd,watches}
= let (w, fd`) = c_add_watch fd fname mask in
( if (w == -1) (Left errno) (Right w)
, {inot & fd=fd`, watches=[(w,f):watches]}
)
where
c_add_watch :: !*Int !String !Int -> *(!Int, !*Int)
c_add_watch inot fname mask = code {
ccall clean_inotify_add_watch "ISI:VII"
}
inotify_rm_watch :: !INWatch !*(Inotify st) -> *(Bool, *Inotify st)
inotify_rm_watch w inot=:{fd}
= case c_inotify_rm_watch fd w of (0, fd`) = (True, {inot & fd=fd`})
(_, fd`) = (False, {inot & fd=fd`})
where
c_inotify_rm_watch :: !*Int !Int -> *(!Int, !*Int)
c_inotify_rm_watch w i = code {
ccall clean_inotify_rm_watch "II:VII"
}
inotify_poll :: *(Inotify st) -> *Inotify st
inotify_poll inot=:{fd} = let (_,fd`) = c_poll fd in { inot & fd=fd` }
where
c_poll :: !*Int -> *(!Int, !*Int)
c_poll fd = code {
ccall clean_poll "I:VII"
}
inotify_check :: *(Inotify st) *World -> *(*Inotify st, *World)
inotify_check inot=:{fd,watches,state} w
# (ok, wds, masks, fd) = c_check fd
inot = { inot & fd=fd }
| not ok = (inot, w)
| (size wds) rem 4 <> 0 || (size masks) rem 4 <> 0 = (inot,w)
# (wds,masks) = (split 4 wds, split 4 masks)
| length wds <> length masks = (inot, w)
# wdsmasks = zip2 (map bytesToInt wds) (map bytesToInt masks)
# (fd,st,w`) = seq (map (check wdsmasks) watches) (inot.fd, state, w)
= ({ inot & fd=fd, state=st }, w`)
where
check :: [(Int,Int)] (INWatch, INCallback st) *(*Int, st, *World) -> *(*Int, st, *World)
check wdsmasks (watch,f) (fd,st,w)
# (st,w) = seq [\(st,w) -> f mask st w \\ (wd,mask) <- wdsmasks | wd == watch] (st,w)
= (fd,st,w)
bytesToInt :: {#Char} -> Int
bytesToInt cs = sum [toInt c * (8 ^ p) \\ c <-: cs & p <- [0..]]
split :: Int String -> [String]
split n s
| size s > n = [s % (0,n-1) : split n (s % (n, size s - 1))]
| size s == n = [s]
| s == "" = []
c_check :: !*Int -> *(!Bool, !String, !String, !*Int)
c_check fd = code {
ccall clean_inotify_check "I:VISSI"
}
errno :: Int
errno = err 0
where
err :: !Int -> Int
err i = code {
ccall clean_errno "I:I"
}
|
