summaryrefslogtreecommitdiff
path: root/1415/fp2/week2
diff options
context:
space:
mode:
authorCamil Staps2016-02-02 19:24:50 +0100
committerCamil Staps2016-02-02 19:24:50 +0100
commita7d7542dc646a5fd124ef71e71ce260889f1701b (patch)
tree04ed89503bbb3cc9933273a1326a53ca724c3492 /1415/fp2/week2
parentweek6 camil: working positioning of lines by putting empties at left and righ... (diff)
Moved to 1415 directoryHEADmaster
Diffstat (limited to '1415/fp2/week2')
-rw-r--r--1415/fp2/week2/camil/StdIOMonad.dcl40
-rw-r--r--1415/fp2/week2/camil/StdIOMonad.icl130
-rw-r--r--1415/fp2/week2/camil/StdMaybe.dcl41
-rw-r--r--1415/fp2/week2/camil/StdMaybe.icl65
-rw-r--r--1415/fp2/week2/camil/StdMonad.dcl8
-rw-r--r--1415/fp2/week2/camil/StdMonad.icl1
-rw-r--r--1415/fp2/week2/camil/Test.dcl1
-rw-r--r--1415/fp2/week2/camil/Test.icl12
-rw-r--r--1415/fp2/week2/mart/StdIOMonad.dcl40
-rw-r--r--1415/fp2/week2/mart/StdIOMonad.icl138
-rw-r--r--1415/fp2/week2/mart/StdMonad.dcl8
-rw-r--r--1415/fp2/week2/mart/StdMonad.icl1
-rw-r--r--1415/fp2/week2/mart/Test.dcl1
-rw-r--r--1415/fp2/week2/mart/Test.icl13
-rw-r--r--1415/fp2/week2/mart/camil.txt2
-rw-r--r--1415/fp2/week2/mart/s4109503_s4498062_fp2_w2.tar.gzbin0 -> 2207 bytes
16 files changed, 501 insertions, 0 deletions
diff --git a/1415/fp2/week2/camil/StdIOMonad.dcl b/1415/fp2/week2/camil/StdIOMonad.dcl
new file mode 100644
index 0000000..580efaa
--- /dev/null
+++ b/1415/fp2/week2/camil/StdIOMonad.dcl
@@ -0,0 +1,40 @@
+definition module StdIOMonad
+
+// Deze module verpakt een aantal StdFile functies in een monadische jas
+
+import StdMonad, StdMaybe
+
+:: IO a
+:: *W
+:: Void = Void
+:: Filemode = Lees | Schrijf
+:: Filenaam :== String
+:: Filehandle :== String
+
+// voer monadische I/O actie uit op de wereld:
+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:
+open :: Filenaam Filemode -> IO (Maybe Filehandle)
+
+// sluit de file met gegeven filenaam:
+close :: Filehandle -> IO Bool
+
+// bepaal of het lezen van de file klaar is:
+eof :: Filehandle -> IO Bool
+
+// 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/1415/fp2/week2/camil/StdIOMonad.icl b/1415/fp2/week2/camil/StdIOMonad.icl
new file mode 100644
index 0000000..c25cb4c
--- /dev/null
+++ b/1415/fp2/week2/camil/StdIOMonad.icl
@@ -0,0 +1,130 @@
+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
+
+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)
+
+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))
+
+// 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)
+readline fh = IO (readline` fh)
+ where
+ readline` :: Filehandle *W -> *(Maybe String, *W)
+ readline` fh (world, fs)
+ # (currentfiletuple, fs) = find fh fs
+ | isNothing currentfiletuple = (Nothing, (world, fs))
+ # (currentfh, currentfile) = fromJust currentfiletuple
+ # (s, currentfile) = freadline currentfile
+ = (Just s, (world, [(currentfh, currentfile):fs]))
+
+// schrijf een regel naar een file:
+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) = find fh fs
+ | isNothing currentfiletuple = (True, (world, fs))
+ # (currentfh, currentfile) = fromJust currentfiletuple
+ # currentfile = fwrites (s +++ "\n") currentfile
+ = (True, (world, [(currentfh, currentfile):fs]))
diff --git a/1415/fp2/week2/camil/StdMaybe.dcl b/1415/fp2/week2/camil/StdMaybe.dcl
new file mode 100644
index 0000000..2403683
--- /dev/null
+++ b/1415/fp2/week2/camil/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/1415/fp2/week2/camil/StdMaybe.icl b/1415/fp2/week2/camil/StdMaybe.icl
new file mode 100644
index 0000000..4eed325
--- /dev/null
+++ b/1415/fp2/week2/camil/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/1415/fp2/week2/camil/StdMonad.dcl b/1415/fp2/week2/camil/StdMonad.dcl
new file mode 100644
index 0000000..cd1c654
--- /dev/null
+++ b/1415/fp2/week2/camil/StdMonad.dcl
@@ -0,0 +1,8 @@
+definition module StdMonad
+
+class return c :: a -> c a
+class (>>=) infix 0 c :: (c a) (a -> c b) -> c b
+class fail c :: c a
+
+class Monad c | return, >>= c
+class MonadFail c | Monad, fail c
diff --git a/1415/fp2/week2/camil/StdMonad.icl b/1415/fp2/week2/camil/StdMonad.icl
new file mode 100644
index 0000000..db193ab
--- /dev/null
+++ b/1415/fp2/week2/camil/StdMonad.icl
@@ -0,0 +1 @@
+implementation module StdMonad
diff --git a/1415/fp2/week2/camil/Test.dcl b/1415/fp2/week2/camil/Test.dcl
new file mode 100644
index 0000000..21f08d1
--- /dev/null
+++ b/1415/fp2/week2/camil/Test.dcl
@@ -0,0 +1 @@
+definition module Test
diff --git a/1415/fp2/week2/camil/Test.icl b/1415/fp2/week2/camil/Test.icl
new file mode 100644
index 0000000..8044d3f
--- /dev/null
+++ b/1415/fp2/week2/camil/Test.icl
@@ -0,0 +1,12 @@
+implementation module Test
+
+import StdIOMonad
+
+Start world = doIO (
+ open "camil.txt" Lees >>=
+ \_ = open "mart.txt" Schrijf >>=
+ \_ = readline "camil.txt" >>=
+ \l = writeline (fromJust l) "mart.txt" >>=
+ \_ = close "camil.txt" >>=
+ \_ = close "mart.txt"
+ ) world
diff --git a/1415/fp2/week2/mart/StdIOMonad.dcl b/1415/fp2/week2/mart/StdIOMonad.dcl
new file mode 100644
index 0000000..580efaa
--- /dev/null
+++ b/1415/fp2/week2/mart/StdIOMonad.dcl
@@ -0,0 +1,40 @@
+definition module StdIOMonad
+
+// Deze module verpakt een aantal StdFile functies in een monadische jas
+
+import StdMonad, StdMaybe
+
+:: IO a
+:: *W
+:: Void = Void
+:: Filemode = Lees | Schrijf
+:: Filenaam :== String
+:: Filehandle :== String
+
+// voer monadische I/O actie uit op de wereld:
+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:
+open :: Filenaam Filemode -> IO (Maybe Filehandle)
+
+// sluit de file met gegeven filenaam:
+close :: Filehandle -> IO Bool
+
+// bepaal of het lezen van de file klaar is:
+eof :: Filehandle -> IO Bool
+
+// 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/1415/fp2/week2/mart/StdIOMonad.icl b/1415/fp2/week2/mart/StdIOMonad.icl
new file mode 100644
index 0000000..ffa2857
--- /dev/null
+++ b/1415/fp2/week2/mart/StdIOMonad.icl
@@ -0,0 +1,138 @@
+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))
diff --git a/1415/fp2/week2/mart/StdMonad.dcl b/1415/fp2/week2/mart/StdMonad.dcl
new file mode 100644
index 0000000..cd1c654
--- /dev/null
+++ b/1415/fp2/week2/mart/StdMonad.dcl
@@ -0,0 +1,8 @@
+definition module StdMonad
+
+class return c :: a -> c a
+class (>>=) infix 0 c :: (c a) (a -> c b) -> c b
+class fail c :: c a
+
+class Monad c | return, >>= c
+class MonadFail c | Monad, fail c
diff --git a/1415/fp2/week2/mart/StdMonad.icl b/1415/fp2/week2/mart/StdMonad.icl
new file mode 100644
index 0000000..db193ab
--- /dev/null
+++ b/1415/fp2/week2/mart/StdMonad.icl
@@ -0,0 +1 @@
+implementation module StdMonad
diff --git a/1415/fp2/week2/mart/Test.dcl b/1415/fp2/week2/mart/Test.dcl
new file mode 100644
index 0000000..21f08d1
--- /dev/null
+++ b/1415/fp2/week2/mart/Test.dcl
@@ -0,0 +1 @@
+definition module Test
diff --git a/1415/fp2/week2/mart/Test.icl b/1415/fp2/week2/mart/Test.icl
new file mode 100644
index 0000000..ff32dfe
--- /dev/null
+++ b/1415/fp2/week2/mart/Test.icl
@@ -0,0 +1,13 @@
+implementation module Test
+
+import StdIOMonad
+
+// This assumes a file "camil.txt" and writes a line from it to "mart.txt"
+Start world = doIO (
+ open "camil.txt" Lees >>=
+ \_ = open "mart.txt" Schrijf >>=
+ \_ = readline "camil.txt" >>=
+ \l = writeline (fromJust l) "mart.txt" >>=
+ \_ = close "camil.txt" >>=
+ \_ = close "mart.txt"
+ ) world
diff --git a/1415/fp2/week2/mart/camil.txt b/1415/fp2/week2/mart/camil.txt
new file mode 100644
index 0000000..b8b933b
--- /dev/null
+++ b/1415/fp2/week2/mart/camil.txt
@@ -0,0 +1,2 @@
+Line one
+Line two
diff --git a/1415/fp2/week2/mart/s4109503_s4498062_fp2_w2.tar.gz b/1415/fp2/week2/mart/s4109503_s4498062_fp2_w2.tar.gz
new file mode 100644
index 0000000..587d742
--- /dev/null
+++ b/1415/fp2/week2/mart/s4109503_s4498062_fp2_w2.tar.gz
Binary files differ
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-28 21:15:38 +0000