Skip to content

Commit 31f6e1f

Browse files
mark-stopkamark-stopka
committed
Fix build with GHC 8.10.2
1 parent 3a722a3 commit 31f6e1f

1 file changed

Lines changed: 46 additions & 45 deletions

File tree

‎obluda.hs‎

Lines changed: 46 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,12 @@
1-
-- obluda
1+
-- obluda
22
-- written in January 2007 by Anicka Bernathova <anicka@anicka.net>
33

4-
module Main where
4+
module Main where
55

6-
import IO
7-
import Random
6+
import Control.Exception
87
import System.Environment
8+
import System.IO
9+
import System.Random
910

1011
-- type for representation of AVL tree
1112
-- Nil or (left subtree, key, value, balance, right subtree)
@@ -27,54 +28,54 @@ plus n | n>0 = n
2728
| True = 0
2829

2930
--left rotation of AVL tree
30-
rl :: BTree a b -> BTree a b
31-
rl (Tree l v val d p) = Tree (Tree l v val r pl) pv pval s pp
31+
rl :: BTree a b -> BTree a b
32+
rl (Tree l v val d p) = Tree (Tree l v val r pl) pv pval s pp
3233
where (Tree pl pv pval pd pp) = p
33-
r = d - 1 - plus pd
34+
r = d - 1 - plus pd
3435
s = - 1 + pd + r - plus r
3536
--right rotation
36-
rr :: BTree a b -> BTree a b
37-
rr (Tree l v val d p) = Tree ll lv lval s (Tree lp v val r p)
37+
rr :: BTree a b -> BTree a b
38+
rr (Tree l v val d p) = Tree ll lv lval s (Tree lp v val r p)
3839
where (Tree ll lv lval ld lp) = l
39-
r = d - ld + 1 + plus ld
40-
s = 1 + ld + plus r
41-
--double rotations
42-
rlrr :: BTree a b -> BTree a b
40+
r = d - ld + 1 + plus ld
41+
s = 1 + ld + plus r
42+
--double rotations
43+
rlrr :: BTree a b -> BTree a b
4344
rlrr (Tree l v val d p) = rr (Tree (rl l) v val d p)
4445

45-
rrrl :: BTree a b -> BTree a b
46+
rrrl :: BTree a b -> BTree a b
4647
rrrl (Tree l v val d p) = rl (Tree l v val d (rr p))
4748

4849
insert :: Ord a => a -> BTree a Integer -> (BTree a Integer, Integer)
4950
insert n Nil = ((Tree Nil n 1 0 Nil),1)
50-
insert n (Tree l v val d p) | n==v = ((Tree l v (val+1) d p),0)
51+
insert n (Tree l v val d p) | n==v = ((Tree l v (val+1) d p),0)
5152
| n<v = if s==0 then ((Tree t v val d p),0)
52-
else case d of
53-
1 -> ((Tree t v val 0 p),0)
54-
0 -> ((Tree t v val (-1) p),1)
55-
-1 -> (t2,0)
56-
| n>v = if j==0 then ((Tree l v val d i),0)
57-
else case d of
58-
1 -> (i2,0)
59-
0 -> ((Tree l v val 1 i),1)
60-
-1 -> ((Tree l v val 0 i),0)
61-
where (t, s) = insert n l
62-
td = getD t
63-
t2 = if td == -1 then rr (Tree t v val (d-1) p)
53+
else case d of
54+
1 -> ((Tree t v val 0 p),0)
55+
0 -> ((Tree t v val (-1) p),1)
56+
-1 -> (t2,0)
57+
| n>v = if j==0 then ((Tree l v val d i),0)
58+
else case d of
59+
1 -> (i2,0)
60+
0 -> ((Tree l v val 1 i),1)
61+
-1 -> ((Tree l v val 0 i),0)
62+
where (t, s) = insert n l
63+
td = getD t
64+
t2 = if td == -1 then rr (Tree t v val (d-1) p)
6465
else rlrr(Tree t v val (d-1) p)
6566
(i, j) = insert n p
66-
id = getD i
67-
i2 = if id == 1 then rl (Tree l v val (d+1) i)
68-
else rrrl (Tree l v val (d+1) i)
67+
id = getD i
68+
i2 = if id == 1 then rl (Tree l v val (d+1) i)
69+
else rrrl (Tree l v val (d+1) i)
6970

70-
ins :: Ord a => a -> BTree a Integer -> BTree a Integer
71+
ins :: Ord a => a -> BTree a Integer -> BTree a Integer
7172
ins n t = tt
7273
where (tt,_)= insert n t
7374

7475
--parses the input string and feeds our tree
7576
savestring :: String -> (Char,Char) -> BTree String Integer -> BTree String Integer
7677
savestring (z:xs) (x,y) t | (z /= ' ') = savestring xs (y,z) $! (ins [x,y,z] t)
77-
| True = savestring xs (' ',' ') $! (ins [x,y,z] t)
78+
| True = savestring xs (' ',' ') $! (ins [x,y,z] t)
7879
savestring [] (x,y) t = ins [x,y,' '] t
7980

8081
straight :: BTree a b -> [(a, b)]
@@ -107,9 +108,9 @@ getnext Nil _ _ temp = temp
107108
getnext t s prob temp | s<str = getnext l s prob temp
108109
| s>str = getnext p s prob temp
109110
| s==str = (if prob<fl then getnext l s prob char else getnext p s prob temp)
110-
where Tree l (str,fl) char _ p = t
111+
where Tree l (str,fl) char _ p = t
111112

112-
--returns a random word (length can be very long)
113+
--returns a random word (length can be very long)
113114
getword :: BTree (String,Float) Char -> String -> String -> IO (String)
114115
getword t prefix ctxt = do
115116
prob <- randomRIO (0::Float,1)
@@ -121,13 +122,13 @@ getword t prefix ctxt = do
121122
genwords :: Integer -> BTree (String,Float) Char -> IO ()
122123
genwords number tree = do
123124
c <- getword tree [] " "
124-
let d = length c
125-
in if (d < 100) && (d>5) then do
125+
let d = length c
126+
in if (d < 100) && (d>5) then do
126127
putStrLn c
127128
if number>1 then genwords (number-1) tree
128129
else putStr ""
129-
else genwords number tree
130-
dump :: String -> IO ()
130+
else genwords number tree
131+
dump :: String -> IO ()
131132
dump path = bracket
132133
(openFile path ReadMode)
133134
hClose
@@ -137,31 +138,31 @@ dump path = bracket
137138
)
138139

139140
rfdump :: String -> IO (BTree (String,Float) Char)
140-
rfdump string = do
141+
rfdump string = do
141142
let c=(read string)
142143
in return $! (mktree c)
143144

144145
rf :: String -> IO (BTree (String,Float) Char)
145-
rf cont = return $! (mktree (probm (straight (savestring cont (' ',' ') Nil))))
146+
rf cont = return $! (mktree (probm (straight (savestring cont (' ',' ') Nil))))
146147

147148
action :: String -> Integer ->Integer -> IO ()
148149
action path mode number = do
149150
h <- (openFile path ReadMode)
150151
cont <- (hGetContents h)
151-
tree <- (if mode==0 then rf else rfdump) cont
152+
tree <- (if mode==0 then rf else rfdump) cont
152153
hClose h
153154
genwords number tree
154155

155156
usage :: String
156-
usage = "Usage: obluda -c corpus_file number_of_lines\n"
157-
++" -r dump_file number_of_lines\n"
157+
usage = "Usage: obluda -c corpus_file number_of_lines\n"
158+
++" -r dump_file number_of_lines\n"
158159
++" -d corpus_file"
159160

160161
main :: IO ()
161162
main = getArgs >>= \argv ->
162-
case argv of
163+
case argv of
163164
["-c",filename,number] -> action filename 0 (read number)
164165
["-r",filename,number] -> action filename 1 (read number)
165166
["-d",filename] -> dump filename
166-
_ -> putStrLn usage
167+
_ -> putStrLn usage
167168

0 commit comments

Comments
 (0)