From a7d7542dc646a5fd124ef71e71ce260889f1701b Mon Sep 17 00:00:00 2001 From: Camil Staps Date: Tue, 2 Feb 2016 19:24:50 +0100 Subject: Moved to 1415 directory --- fp2/week2/mart/StdIOMonad.icl | 138 ------------------------------------------ 1 file changed, 138 deletions(-) delete mode 100644 fp2/week2/mart/StdIOMonad.icl (limited to 'fp2/week2/mart/StdIOMonad.icl') diff --git a/fp2/week2/mart/StdIOMonad.icl b/fp2/week2/mart/StdIOMonad.icl deleted file mode 100644 index ffa2857..0000000 --- a/fp2/week2/mart/StdIOMonad.icl +++ /dev/null @@ -1,138 +0,0 @@ -implementation module StdIOMonad - -import StdBool -import StdEnum -import StdFile -import StdList -import StdMaybe -import StdMisc -import StdMonad -import StdOverloaded -import StdString -import StdTuple - -:: IO a = IO (*W -> *(a, *W)) -:: *W :== *(*World, *[*(Filehandle, *File)]) -:: Filemode = Lees | Schrijf -:: Filenaam :== String -:: Filehandle :== String - -// Conversion from our filemodes to StdFile filemodes -instance toInt Filemode where - toInt Lees = FReadText - toInt Schrijf = FWriteText - -// Apply the monadic program on the world -doIO:: (IO a) *World -> *(a, *W) -doIO (IO f) w = f (w, []) - -// Lift the value out of the monadic domain -unIO:: (IO a) -> *W -> *(a, *W) -unIO (IO f) = f - -instance return IO where - return x = IO (\w -> (x, w)) -instance >>= IO where - (>>=) (IO f) g = IO (\w = let (a, w1) = f w in unIO (g a) w1) - -// Read one line from the console -read:: IO String -read = IO read` - where - read`:: *W -> *(String, *W) - read` (world, s) - # (io, world) = stdio world - # (line, io) = freadline io - # (_, world) = fclose io world - = (line, (world, s)) - -// Write a line from the console -write :: String -> IO Void -write s = IO (write` s) - where - write`:: String *W -> *(Void, *W) - write` line (world, s) - # (io, world) = stdio world - # io = io <<< line - # (_, world) = fclose io world - = (Void, (world, s)) - -// Open a file -open:: Filenaam Filemode -> IO (Maybe Filehandle) -open s m = IO (open` s m) - where - open`:: String Filemode *W -> *(Maybe Filehandle, *W) - open` fp m (world, fs) - | any (\l = fp == fst l) fs = (Nothing, (world, fs)) - # (ok, file, world) = fopen fp (toInt m) world - = (Just fp, (world, [(fp, file):fs])) - -// Close a file. If the file can't be closed by the system the program will -// abort -close:: Filehandle -> IO Bool -close fh = IO (close` fh) - where - close`:: Filehandle *W -> *(Bool, *W) - close` fp (world, fs) - # (currentfiletuple, fs) = getFH fp fs - | isNothing currentfiletuple = (False, (world, fs)) - # (currentfh, currentfile) = fromJust currentfiletuple - # (ok, world) = fclose currentfile world - | not ok = abort "File can't be closed" - | otherwise = (True, (world, fs)) - - -// Determine if the file is at the end. This will abort when the file is not -// open or error if the file is not opened for reading. -eof :: Filehandle -> IO Bool -eof fh = IO (eof` fh) - where - eof`:: Filehandle *W -> *(Bool, *W) - eof` fp (world, fs) - # (currentfiletuple, fs) = getFH fp fs - | isNothing currentfiletuple = abort "Can't do eof on non-existing file" - # (currentfh, currentfile) = fromJust currentfiletuple - # (ok, file) = fend currentfile - = (ok, (world, [(currentfh, file):fs])) - -// Read one line from a file (including newline). This will abort when the file -// is not open or error if the file is not opened for reading. -readline :: Filehandle -> IO (Maybe String) -readline fh = IO (readline` fh) - where - readline` :: Filehandle *W -> *(Maybe String, *W) - readline` fh (world, fs) - # (currentfiletuple, fs) = getFH fh fs - | isNothing currentfiletuple = abort "File not open" - # (currentfh, currentfile) = fromJust currentfiletuple - # (s, currentfile) = freadline currentfile - = (Just s, (world, [(currentfh, currentfile):fs])) - -// Write one line from a file (will not append newline). This will abort when -// the file is not open or error if the file is not opened for writing. -writeline :: String Filehandle -> IO Bool -writeline s fh = IO (writeline` s fh) - where - writeline` :: String Filehandle *W -> *(Bool, *W) - writeline` s fh (world, fs) - # (currentfiletuple, fs) = getFH fh fs - | isNothing currentfiletuple = abort "File not open" - # (currentfh, currentfile) = fromJust currentfiletuple - # currentfile = fwrites s currentfile - = (True, (world, [(currentfh, currentfile):fs])) - -// Gets the file associated with the filehandle given, this is done in a very -// ugly way to retain uniqueness... -getFH:: Filehandle *[*(Filehandle, *File)] -> - (Maybe *(Filehandle, *File), *[*(Filehandle, *File)]) -getFH fh fs -# (fhs, fis) = unzip fs -# fhsC = zip2 [0..length fhs] fhs -# index = [(i, h) \\ (i, h) <- fhsC | h == fh] -| length index == 0 = (Nothing, zip2 fhs fis) -# index = fst (hd index) -# (fis1, fis2) = splitAt index fis -# (fhs1, fhs2) = splitAt index fhs -# (thefile, fis2) = splitAt 1 fis2 -# (thehandle, fhs2) = splitAt 1 fhs2 -= (Just (hd thehandle, hd thefile), zip2 (fhs1 ++ fhs2) (fis1 ++ fis2)) -- cgit v1.2.3