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
125
126
127
128
129
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]))
|
