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
131
132
133
134
135
136
137
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))
|
