diff options
author | Mart Lubbers | 2015-04-24 17:22:27 +0200 |
---|---|---|
committer | Mart Lubbers | 2015-04-24 17:22:27 +0200 |
commit | 5235f58efa84ebe137a932b7ca547efd7d73a205 (patch) | |
tree | 0f5a7773c542e1452b4bb7c84d8bb7469c9e8dbb | |
parent | rare shit (diff) |
______________
< Lekker bezig >
--------------
\ ^__^
\ (oo)\_______
(__)\ )\/\
||----w |
|| ||
-rw-r--r-- | fp2/week2/mart/StdIOMonad.dcl | 27 | ||||
-rw-r--r-- | fp2/week2/mart/StdIOMonad.icl | 120 | ||||
-rw-r--r-- | fp2/week2/mart/StdMaybe.dcl | 41 | ||||
-rw-r--r-- | fp2/week2/mart/StdMaybe.icl | 65 | ||||
-rw-r--r-- | fp2/week2/mart/camil.txt | 0 | ||||
-rw-r--r-- | fp2/week2/mart/camil2.txt | 0 |
6 files changed, 234 insertions, 19 deletions
diff --git a/fp2/week2/mart/StdIOMonad.dcl b/fp2/week2/mart/StdIOMonad.dcl index 0d451d2..0801928 100644 --- a/fp2/week2/mart/StdIOMonad.dcl +++ b/fp2/week2/mart/StdIOMonad.dcl @@ -5,28 +5,29 @@ definition module StdIOMonad import StdMonad, StdMaybeMonad
:: IO a
+:: *W
:: Void = Void
:: Filemode = Lees | Schrijf
:: Filenaam :== String
:: Filehandle
// voer monadische I/O actie uit op de wereld:
-//doIO :: (IO a) *World -> (a,*World)
+doIO:: (IO a) *World -> *(a, *W)
// IO is een monad:
-//instance return IO
-//instance >>= IO
-//
-//// lees regel van de console:
-//read :: IO String
-//
-//// schrijf regel naar de console:
-//write :: String -> IO Void
-//
-//// open de file met gegeven filenaam en mode:
+instance return IO
+instance >>= IO
+
+// lees regel van de console:
+read :: IO String
+
+// schrijf regel naar de console:
+write :: String -> IO Void
+
+// open de file met gegeven filenaam en mode:
//open :: Filenaam Filemode -> IO (Maybe Filehandle)
-//
-//// sluit de file met gegeven filenaam:
+
+// sluit de file met gegeven filenaam:
//close :: Filehandle -> IO Bool
//
//// bepaal of het lezen van de file klaar is:
diff --git a/fp2/week2/mart/StdIOMonad.icl b/fp2/week2/mart/StdIOMonad.icl index 1d4b24e..b0f2b4f 100644 --- a/fp2/week2/mart/StdIOMonad.icl +++ b/fp2/week2/mart/StdIOMonad.icl @@ -2,15 +2,123 @@ implementation module StdIOMonad // Deze module verpakt StdFile in een monadische jas
+import StdBool
+import StdEnum
import StdFile
+import StdList
+import StdMaybe
+import StdMisc
import StdMonad
-//import StdOverloaded
+import StdOverloaded
+import StdString
+import StdTuple
-:: IO a = IO [a] // kies een geschikte representatie voor IO
+:: IO a = IO (*W -> *(a, *W))
+:: *W :== *(*World, *[*(Filehandle, *File)])
:: Filemode = Lees | Schrijf
:: Filenaam :== String
-:: Filehandle :== [] // kies een geschikte representatie voor Filehandle
+:: Filehandle :== String
-//instance toInt Filemode where
-// toInt Lees = FReadText
-// toInt Schrijf = FWriteText
+instance toInt Filemode where
+ toInt Lees = FReadText
+ toInt Schrijf = FWriteText
+
+//voer monadische I/O actie uit op de wereld:
+doIO:: (IO a) *World -> *(a, *W)
+doIO (IO f) w = f (w, [])
+
+unIO:: (IO a) -> *W -> *(a, *W)
+unIO (IO f) = f
+
+// IO is een monad:
+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)
+
+//Start world = doIO (read >>= (\w = return w)) (world, "")
+//Start world = doIO (open "camilt.txt" Lees) (world, "")
+//Start world = doIO (read >>= (\w = read)) (world, "")
+
+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))
+
+// schrijf regel naar de 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))
+
+
+Start world = doIO (
+ open "camil.txt" Lees >>=
+ \y = eof "camil.txt") world
+
+// open de file met gegeven filenaam en mode:
+find:: Filehandle *[*(Filehandle, *File)] -> (Maybe *(Filehandle, *File), *[*(Filehandle, *File)])
+find 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))
+
+
+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]))
+
+// sluit de file met gegeven filenaam:
+close:: Filehandle -> IO Bool
+close fh = IO (close` fh)
+ where
+ close`:: Filehandle *W -> *(Bool, *W)
+ close` fp (world, fs)
+ # (currentfiletuple, fs) = find 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))
+
+
+// bepaal of het lezen van de file klaar is:
+eof :: Filehandle -> IO Bool
+eof fh = IO (eof` fh)
+ where
+ eof`:: Filehandle *W -> *(Bool, *W)
+ eof` fp (world, fs)
+ # (currentfiletuple, fs) = find 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]))
+
+// lees een regel van een file:
+//readline :: Filehandle -> IO (Maybe String)
+
+
+// schrijf een regel naar een file:
+writeline :: String Filehandle -> IO Bool
diff --git a/fp2/week2/mart/StdMaybe.dcl b/fp2/week2/mart/StdMaybe.dcl new file mode 100644 index 0000000..2403683 --- /dev/null +++ b/fp2/week2/mart/StdMaybe.dcl @@ -0,0 +1,41 @@ +definition module StdMaybe + +// ******************************************************************************** +// Clean StdLib library module, version 1.0 +// ******************************************************************************** + +from StdFunc import :: St; +from StdOverloaded import class ==(..); + +:: Maybe x + = Just x + | Nothing + +isJust :: !(Maybe .x) -> Bool // case @1 of (Just _) -> True; _ -> False +isNothing :: !(Maybe .x) -> Bool // not o isJust +fromJust :: !(Maybe .x) -> .x // \(Just x) -> x + +// for possibly unique elements: +u_isJust :: !u:(Maybe .x) -> (!Bool, !u:Maybe .x) +u_isNothing :: !u:(Maybe .x) -> (!Bool, !u:Maybe .x) + +accMaybe :: .(St .x .a) !u:(Maybe .x) -> (!Maybe .a,!u:Maybe .x) +// accMaybe f (Just x) = (Just (fst (f x)),Just (snd (f x))) +// accMaybe f Nothing = (Nothing,Nothing) + +mapMaybe :: .(.x -> .y) !(Maybe .x) -> Maybe .y +// mapMaybe f (Just x) = Just (f x) +// mapMaybe f Nothing = Nothing + +instance == (Maybe x) | == x +// Nothing==Nothing +// Just a ==Just b <= a==b + +maybeToList :: !(Maybe .a) -> [.a]; +// returns list with no or one element + +listToMaybe :: ![.a] -> .Maybe .a; +// returns Just head of list if possible + +catMaybes :: ![Maybe .a] -> .[.a]; +// catMaybes ms = [ m \\ Just m <- ms ] diff --git a/fp2/week2/mart/StdMaybe.icl b/fp2/week2/mart/StdMaybe.icl new file mode 100644 index 0000000..4eed325 --- /dev/null +++ b/fp2/week2/mart/StdMaybe.icl @@ -0,0 +1,65 @@ +implementation module StdMaybe + +// ******************************************************************************** +// Clean StdLib library module, version 1.0 +// ******************************************************************************** + +from StdFunc import :: St; +from StdOverloaded import class ==(..); + +:: Maybe x + = Just x + | Nothing + +isJust :: !(Maybe .x) -> Bool +isJust Nothing = False +isJust _ = True + +isNothing :: !(Maybe .x) -> Bool +isNothing Nothing = True +isNothing _ = False + +u_isJust :: !u:(Maybe .x) -> (!Bool, !u:Maybe .x) +u_isJust nothing=:Nothing + = (False, nothing) +u_isJust just + = (True, just) + +u_isNothing :: !u:(Maybe .x) -> (!Bool, !u:Maybe .x) +u_isNothing nothing=:Nothing + = (True, nothing) +u_isNothing just + = (False,just) + +fromJust :: !(Maybe .x) -> .x +fromJust (Just x) = x + +accMaybe :: .(St .x .a) !u:(Maybe .x) -> (!Maybe .a,!u:Maybe .x) +accMaybe f (Just x) + # (a,x) = f x + = (Just a,Just x) +accMaybe _ nothing + = (Nothing,nothing) + +mapMaybe :: .(.x -> .y) !(Maybe .x) -> Maybe .y +mapMaybe f (Just x) = Just (f x) +mapMaybe _ nothing = Nothing + +instance == (Maybe x) | == x where + (==) Nothing maybe = case maybe of + Nothing -> True + just -> False + (==) (Just a) maybe = case maybe of + Just b -> a==b + nothing -> False + +maybeToList :: !(Maybe .a) -> [.a]; +maybeToList Nothing = [] +maybeToList (Just a) = [a] + +listToMaybe :: ![.a] -> .Maybe .a; +listToMaybe [] = Nothing +listToMaybe [a:_] = Just a + +catMaybes :: ![Maybe .a] -> .[.a]; +catMaybes ms = [ m \\ Just m <- ms ] diff --git a/fp2/week2/mart/camil.txt b/fp2/week2/mart/camil.txt new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/fp2/week2/mart/camil.txt diff --git a/fp2/week2/mart/camil2.txt b/fp2/week2/mart/camil2.txt new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/fp2/week2/mart/camil2.txt |