--- /dev/null
+implementation module StdIOMonad\r
+\r
+import StdBool\r
+import StdEnum\r
+import StdFile\r
+import StdList\r
+import StdMaybe\r
+import StdMisc\r
+import StdMonad\r
+import StdOverloaded\r
+import StdString\r
+import StdTuple\r
+\r
+:: IO a = IO (*W -> *(a, *W))\r
+:: *W :== *(*World, *[*(Filehandle, *File)])\r
+:: Filemode = Lees | Schrijf\r
+:: Filenaam :== String\r
+:: Filehandle :== String\r
+\r
+instance toInt Filemode where\r
+ toInt Lees = FReadText\r
+ toInt Schrijf = FWriteText\r
+\r
+//voer monadische I/O actie uit op de wereld:\r
+doIO:: (IO a) *World -> *(a, *W)\r
+doIO (IO f) w = f (w, [])\r
+\r
+unIO:: (IO a) -> *W -> *(a, *W)\r
+unIO (IO f) = f \r
+\r
+// IO is een monad:\r
+instance return IO where\r
+ return x = IO (\w -> (x, w))\r
+instance >>= IO where\r
+ (>>=) (IO f) g = IO (\w = let (a, w1) = f w in unIO (g a) w1)\r
+\r
+read:: IO String\r
+read = IO read`\r
+ where\r
+ read`:: *W -> *(String, *W)\r
+ read` (world, s)\r
+ # (io, world) = stdio world\r
+ # (line, io) = freadline io\r
+ # (_, world) = fclose io world\r
+ = (line, (world, s))\r
+\r
+// schrijf regel naar de console:\r
+write :: String -> IO Void\r
+write s = IO (write` s)\r
+ where\r
+ write`:: String *W -> *(Void, *W)\r
+ write` line (world, s)\r
+ # (io, world) = stdio world\r
+ # io = io <<< line\r
+ # (_, world) = fclose io world\r
+ = (Void, (world, s))\r
+\r
+// open de file met gegeven filenaam en mode:\r
+find:: Filehandle *[*(Filehandle, *File)] -> (Maybe *(Filehandle, *File), *[*(Filehandle, *File)]) \r
+find fh fs\r
+# (fhs, fis) = unzip fs\r
+# fhsC = zip2 [0..length fhs] fhs\r
+# index = [(i, h) \\ (i, h) <- fhsC | h == fh]\r
+| length index == 0 = (Nothing, zip2 fhs fis)\r
+# index = fst (hd index)\r
+# (fis1, fis2) = splitAt index fis\r
+# (fhs1, fhs2) = splitAt index fhs\r
+# (thefile, fis2) = splitAt 1 fis2\r
+# (thehandle, fhs2) = splitAt 1 fhs2\r
+= (Just (hd thehandle, hd thefile), zip2 (fhs1 ++ fhs2) (fis1 ++ fis2))\r
+\r
+\r
+open:: Filenaam Filemode -> IO (Maybe Filehandle)\r
+open s m = IO (open` s m)\r
+ where\r
+ open`:: String Filemode *W -> *(Maybe Filehandle, *W)\r
+ open` fp m (world, fs)\r
+ | any (\l = fp == fst l) fs = (Nothing, (world, fs))\r
+ # (ok, file, world) = fopen fp (toInt m) world\r
+ = (Just fp, (world, [(fp, file):fs]))\r
+\r
+// sluit de file met gegeven filenaam:\r
+close:: Filehandle -> IO Bool\r
+close fh = IO (close` fh)\r
+ where\r
+ close`:: Filehandle *W -> *(Bool, *W)\r
+ close` fp (world, fs)\r
+ # (currentfiletuple, fs) = find fp fs\r
+ | isNothing currentfiletuple = (False, (world, fs))\r
+ # (currentfh, currentfile) = fromJust currentfiletuple\r
+ # (ok, world) = fclose currentfile world\r
+ | not ok = abort "File can't be closed"\r
+ | otherwise = (True, (world, fs))\r
+ \r
+\r
+// bepaal of het lezen van de file klaar is:\r
+eof :: Filehandle -> IO Bool\r
+eof fh = IO (eof` fh)\r
+ where \r
+ eof`:: Filehandle *W -> *(Bool, *W)\r
+ eof` fp (world, fs)\r
+ # (currentfiletuple, fs) = find fp fs\r
+ | isNothing currentfiletuple = abort "Can't do eof on non-existing file"\r
+ # (currentfh, currentfile) = fromJust currentfiletuple\r
+ # (ok, file) = fend currentfile\r
+ = (ok, (world, [(currentfh, file):fs]))\r
+\r
+// lees een regel van een file:\r
+readline :: Filehandle -> IO (Maybe String)\r
+readline fh = IO (readline` fh)\r
+ where\r
+ readline` :: Filehandle *W -> *(Maybe String, *W)\r
+ readline` fh (world, fs)\r
+ # (currentfiletuple, fs) = find fh fs\r
+ | isNothing currentfiletuple = (Nothing, (world, fs))\r
+ # (currentfh, currentfile) = fromJust currentfiletuple\r
+ # (s, currentfile) = freadline currentfile\r
+ = (Just s, (world, [(currentfh, currentfile):fs]))\r
+\r
+// schrijf een regel naar een file:\r
+writeline :: String Filehandle -> IO Bool\r
+writeline s fh = IO (writeline` s fh)\r
+ where\r
+ writeline` :: String Filehandle *W -> *(Bool, *W)\r
+ writeline` s fh (world, fs)\r
+ # (currentfiletuple, fs) = find fh fs\r
+ | isNothing currentfiletuple = (True, (world, fs))\r
+ # (currentfh, currentfile) = fromJust currentfiletuple\r
+ # currentfile = fwrites (s +++ "\n") currentfile\r
+ = (True, (world, [(currentfh, currentfile):fs]))\r
--- /dev/null
+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 ]
--- /dev/null
+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 ]
repositories / fp1415.git / commitdiff