1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
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 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)
//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
|
