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 /fp2/week2 | |
| parent | rare shit (diff) | |
 ______________
< Lekker bezig >
 --------------
        \   ^__^
         \  (oo)\_______
            (__)\       )\/\
                ||----w |
                ||     ||
Diffstat (limited to 'fp2/week2')
| -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 | 
