+# Executables

+*.exe

+*.out

+test

+

+# Directory used to store object files, abc files and assembly files

+Clean System Files/

+

+# iTasks environment extra data

+*-data/

+sapl/

+

+#define Clean(a)

+

+typedef struct clean_string *CleanString;

+

+/* a string in Clean is:

+ struct clean_string {

+ size_t clean_string_length;

+ char clean_string_characters[clean_string_length];

+ };

+ The string does not end with a '\0' !

+*/

+

+#ifndef _WIN64

+

+/* CleanStringLength(clean_string) returns the length of the clean_string in characters */

+#define CleanStringLength(clean_string) (*(unsigned long *)(clean_string))

+

+/* CleanStringCharacters(clean_string) returns a pointer to the characters of the clean_string */

+#define CleanStringCharacters(clean_string) ((char*)(1+(unsigned long *)(clean_string)))

+

+/* CleanStringSizeInts(string_length) return size of *CleanString in integers */

+#define CleanStringSizeInts(string_length) (1+(((unsigned long)(string_length)+(sizeof(unsigned long)-1))>>(1+(sizeof(unsigned long)>>2))))

+

+/* CleanStringVariable(clean_string,string_length) defines variable clean_string with length string_length,

+ before using the clean_string variable, cast to CleanString, except for the macros above */

+#define CleanStringVariable(clean_string,string_length) unsigned long clean_string[CleanStringSizeInts(string_length)]

+

+/* CleanStringSizeBytes(string_length) return size of *CleanString in bytes */

+#define CleanStringSizeBytes(string_length) ((sizeof(unsigned long)<<1)+(((unsigned long)(string_length)+(sizeof(unsigned long)-1)) & -(sizeof(unsigned long))))

+

+typedef long *CleanIntArray;

+

+/* CleanIntArraySize(clean_array) returns the size (number of elements) of the clean_int_array */

+#define CleanIntArraySize(clean_int_array) (((unsigned long *)(clean_int_array))[-2])

+

+/* CleanRealArraySize(clean_real_array) returns the size (number of elements) of the clean_real_array */

+#define CleanRealArraySize(clean_real_array) (((unsigned long *)(clean_real_array))[-2])

+

+/* CleanCharArraySize(clean_char_array) returns the size (number of elements) of the clean_char_array */

+#define CleanCharArraySize(clean_char_array) (((unsigned long *)(clean_char_array))[-1])

+

+#else

+

+/* CleanStringLength(clean_string) returns length of the clean_string in characters */

+#define CleanStringLength(clean_string) (*(unsigned __int64 *)(clean_string))

+

+/* CleanStringCharacters(clean_string) returns a pointer to the characters of the clean_string */

+#define CleanStringCharacters(clean_string) ((char*)(1+(unsigned __int64 *)(clean_string)))

+

+/* CleanStringSizeInts(string_length) return size of *CleanString in integers */

+#define CleanStringSizeInts(string_length) (1+(((unsigned __int64)(string_length)+7)>>3))

+

+/* CleanStringVariable(clean_string,string_length) defines variable clean_string with length string_length,

+ before using the clean_string variable, cast to CleanString, except for the macros above */

+#define CleanStringVariable(clean_string,string_length) unsigned __int64 clean_string[CleanStringSizeInts(string_length)]

+

+/* CleanStringSizeBytes(string_length) return size of *CleanString in bytes */

+#define CleanStringSizeBytes(string_length) (8+(((unsigned __int64)(string_length)+7) & -8))

+

+typedef __int64 *CleanIntArray;

+

+/* CleanIntArraySize(clean_array) returns the size (number of elements) of the clean_int_array */

+#define CleanIntArraySize(clean_int_array) (((unsigned __int64 *)(clean_int_array))[-2])

+

+/* CleanRealArraySize(clean_real_array) returns the size (number of elements) of the clean_real_array */

+#define CleanRealArraySize(clean_real_array) (((unsigned __int64 *)(clean_real_array))[-2])

+

+/* CleanCharArraySize(clean_char_array) returns the size (number of elements) of the clean_char_array */

+#define CleanCharArraySize(clean_char_array) (((unsigned __int64 *)(clean_char_array))[-1])

+

+#endif

+

+typedef double *CleanRealArray;

+

+typedef unsigned char *CleanCharArray;

+definition module Inotify

+

+from Data.Either import ::Either

+from Data.Maybe import ::Maybe

+

+:: *Inotify st

+:: INWatch

+

+:: INMask :== Int

+

+:: INEvent :== Int

+:: INCallback st :== INEvent st *World -> *(st, *World)

+

+(|-) infixl 6 :: (INMask INMask -> INMask)

+

+inotify_init :: st -> Maybe *(Inotify st)

+inotify_close :: *(Inotify st) -> st

+inotify_add_watch :: (INCallback st) !Int !String !*(Inotify st) -> *(Either Int INWatch, *Inotify st)

+inotify_rm_watch :: !INWatch !*(Inotify st) -> *(Bool, *Inotify st)

+inotify_poll :: *(Inotify st) -> *Inotify st

+inotify_check :: *(Inotify st) *World -> *(*Inotify st, *World)

+

+IN_ACCESS :== 0x00000001 // File was accessed

+IN_MODIFY :== 0x00000002 // File was modified

+IN_ATTRIB :== 0x00000004 // Metadata changed

+IN_CLOSE_WRITE :== 0x00000008 // Writtable file was closed

+IN_CLOSE_NOWRITE :== 0x00000010 // Unwrittable file closed

+IN_OPEN :== 0x00000020 // File was opened

+IN_MOVED_FROM :== 0x00000040 // File was moved from X

+IN_MOVED_TO :== 0x00000080 // File was moved to Y

+IN_CREATE :== 0x00000100 // Subfile was created

+IN_DELETE :== 0x00000200 // Subfile was deleted

+IN_DELETE_SELF :== 0x00000400 // Self was deleted

+IN_MOVE_SELF :== 0x00000800 // Self was moved

+IN_UNMOUNT :== 0x00002000 // Backing fs was unmounted

+IN_Q_OVERFLOW :== 0x00004000 // Event queued overflowed

+IN_IGNORED :== 0x00008000 // File was ignored

+IN_CLOSE :== (IN_CLOSE_WRITE |- IN_CLOSE_NOWRITE) // close

+IN_MOVE :== (IN_MOVED_FROM |- IN_MOVED_TO) // moves

+IN_ONLYDIR :== 0x01000000 // only watch the path if it is a directory

+IN_DONT_FOLLOW :== 0x02000000 // don't follow a sym link

+IN_EXCL_UNLINK :== 0x04000000 // exclude events on unlinked objects

+IN_MASK_ADD :== 0x20000000 // add to the mask of an already existing watch

+IN_ISDIR :== 0x40000000 // event occurred against dir

+IN_ONESHOT :== 0x80000000 // only send event once

+IN_ALL_EVENTS :==

+ (IN_ACCESS |- IN_MODIFY |- IN_ATTRIB |- IN_CLOSE_WRITE |- IN_CLOSE_NOWRITE

+ |- IN_OPEN |- IN_MOVED_FROM |- IN_MOVED_TO |- IN_DELETE |- IN_CREATE |-

+ IN_DELETE_SELF |- IN_MOVE_SELF)

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

+ //# (st,w) = f (length wds) 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"

+ }

+CPM=cpm

+CCFLAGS=-Wall -l -linotify

+INO_OBJ=Clean\ System\ Files/inotify_c.o

+

+all: test

+

+$(INO_OBJ): inotify_c.c

+ mkdir -p Clean\ System\ Files

+ $(CC) $(CCFLAGS) -c $< -o Clean\ System\ Files/inotify_c.o

+

+test: test.icl $(wildcard *.*cl) $(INO_OBJ)

+ $(CPM) project $@.prj build

+

+run_test: test

+ ./test

+

+clean:

+ rm -rfv Clean\ System\ Files

+

+.PHONY: all run_test clean

+#include <errno.h>

+#include <fcntl.h>

+#include <poll.h>

+#include <stdio.h>

+#include <stdlib.h>

+#include <string.h>

+#include <sys/inotify.h>

+#include <unistd.h>

+

+#include "Clean.h"

+

+char* clstocs(CleanString* cs) {

+ char* s = calloc(CleanStringLength(cs) + 1, 1);

+ uint8_t i;

+ for (i = 0; i < CleanStringLength(cs); i++)

+ s[i] = CleanStringCharacters(cs)[i];

+ s[i] = 0;

+ return s;

+}

+

+static struct {int length; char chars[1]; } empty_string = {0,""};

+

+int clean_errno(int ignored) {

+ return errno;

+}

+

+int clean_inotify_init(int ignored) {

+ int fd;

+ fd = inotify_init();

+ if (fd < 0)

+ return 0;

+ fcntl(fd, IN_NONBLOCK);

+ return fd;

+}

+

+void clean_inotify_add_watch(int fd, CleanString* fname_, int mask, int *re_watch, int *re_fd) {

+ char* fname = clstocs(fname_);

+ *re_watch = inotify_add_watch(fd, fname, mask);

+ free(fname);

+ *re_fd = fd;

+}

+

+void clean_inotify_rm_watch(int fd, int watch, int *re_code, int *re_fd) {

+ *re_fd = fd;

+ *re_code = inotify_rm_watch(fd, watch);

+}

+

+void clean_poll(int fd, int *re_nrevents, int *re_fd) {

+ struct pollfd pfd = {fd, POLLIN, 0};

+ *re_nrevents = poll(&pfd, 1, -1);

+ *re_fd = fd;

+}

+

+static CleanStringVariable(wds_string, 1024);

+static CleanStringVariable(masks_string, 1024);

+

+void clean_inotify_check(int fd,

+ int *re_ok, CleanString* re_wds, CleanString* re_masks, int *re_fd) {

+ char buf[4096] __attribute__((aligned(__alignof__(struct inotify_event))));

+ const struct inotify_event *ev;

+ ssize_t len;

+ char *ptr;

+

+ struct pollfd pfd = {fd, POLLIN, 0};

+ int poll_n;

+

+ char *wds_ptr = CleanStringCharacters(wds_string);

+ char *masks_ptr = CleanStringCharacters(masks_string);

+ CleanStringLength(wds_string) = 0;

+ CleanStringLength(masks_string) = 0;

+

+ *re_ok = 0;

+ *re_fd = fd;

+

+ *re_wds = (CleanString) &empty_string;

+ *re_masks = (CleanString) &empty_string;

+

+ for (;;) {

+ poll_n = poll(&pfd, 1, 50);

+ if (poll_n < 0) {

+ return;

+ } else if (poll_n == 0) {

+ break;

+ }

+

+ len = read(fd, buf, sizeof buf);

+ if (len == -1 && errno != EAGAIN) {

+ return;

+ }

+ if (len <= 0) {

+ break;

+ }

+

+ for (ptr = buf; ptr < buf + len;

+ ptr += sizeof(struct inotify_event) + ev->len) {

+ ev = (const struct inotify_event*) ptr;

+

+ memcpy(masks_ptr, &ev->mask, 4);

+ masks_ptr += 4;

+ CleanStringLength(masks_string) += 4;

+

+ memcpy(wds_ptr, &ev->wd, sizeof(int));

+ wds_ptr += sizeof(int);

+ CleanStringLength(wds_string) += sizeof(int);

+ }

+ }

+

+ *re_wds = (CleanString) wds_string;

+ *re_masks = (CleanString) masks_string;

+

+ *re_ok = 1;

+}

+module test

+

+import StdFile

+import Data.Either

+import Data.Maybe

+import Inotify

+

+Start w

+# (Just inot) = inotify_init 0

+# (Right watch, inot)

+ = inotify_add_watch (echo "file1") IN_ALL_EVENTS "file1" inot

+# (Right watch, inot)

+ = inotify_add_watch (echo "file2") IN_ALL_EVENTS "file2" inot

+# (io,w) = stdio w

+# io = io <<< "Do something with file1 or file2\n"

+# (ok,w) = fclose io w

+# (inot, w) = loop inot w

+= inotify_close inot

+where

+ loop :: !*(Inotify st) !*World -> *(*Inotify st, *World)

+ loop inot w

+ # inot = inotify_poll inot

+ # (inot, w) = inotify_check inot w

+ = loop inot w

+

+ echo :: String INEvent Int *World -> *(Int, *World)

+ echo fname ev i w

+ # (io,w) = stdio w

+ # io = io <<< "EVENT: [" <<< fname <<< "; " <<< ev <<< "]\n"

+ # (ok,w) = fclose io w

+ = (i, w)

+Version: 1.4

+Global

+ ProjectRoot: .

+ Target: StdEnv

+ Exec: {Project}/test

+ CodeGen

+ CheckStacks: False

+ CheckIndexes: True

+ Application

+ HeapSize: 2097152

+ StackSize: 512000

+ ExtraMemory: 8192

+ IntialHeapSize: 204800

+ HeapSizeMultiplier: 4096

+ ShowExecutionTime: False

+ ShowGC: False

+ ShowStackSize: False

+ MarkingCollector: False

+ DisableRTSFlags: False

+ StandardRuntimeEnv: True

+ Profile

+ Memory: False

+ MemoryMinimumHeapSize: 0

+ Time: False

+ Stack: False

+ Output

+ Output: ShowConstructors

+ Font: Monaco

+ FontSize: 9

+ WriteStdErr: False

+ Link

+ LinkMethod: Static

+ GenerateRelocations: False

+ GenerateSymbolTable: False

+ GenerateLinkMap: False

+ LinkResources: False

+ ResourceSource:

+ GenerateDLL: False

+ ExportedNames:

+ Paths

+ Path: {Project}

+ Path: {Application}/lib/clean-platform/OS-Independent

+ Path: {Application}/lib/Generics

+ Precompile:

+ Postlink:

+MainModule

+ Name: test

+ Dir: {Project}

+ Compiler

+ NeverMemoryProfile: False

+ NeverTimeProfile: False

+ StrictnessAnalysis: True

+ ListTypes: StrictExportTypes

+ ListAttributes: True

+ Warnings: True

+ Verbose: True

+ ReadableABC: False

+ ReuseUniqueNodes: True

+ Fusion: False