3 # mira2hs - Convert Miranda to Haskell (or Gofer)
5 # usage: mira2hs [infile [outfile]]
7 # Input defaults to stdin, output defaults to <infile>.hs or stdout if
10 # Copyright Denis Howe 1992
12 # Permission is granted to make and distribute verbatim or modified
13 # copies of this program, provided that every such copy or derived
14 # work carries the above copyright notice and is distributed under
15 # terms identical to these.
17 # Miranda is a trademark of Research Software Limited.
18 # (E-mail: mira-request@ukc.ac.uk).
20 # Denis Howe <dbh@doc.ic.ac.uk>
22 # NOTE: This program needs a sed which understands \<word\> regular
23 # expressions, eg. Sun or GNU sed (gsed).
25 # partain: got it from wombat.doc.ic.ac.uk:pub
27 # 1.05 18 Sep 1992 zip -> zipPair
28 # 1.04 29 Jul 1992 Improve handling of ==, -- and whitespace round guards
30 # 1.03 24 Apr 1992 Incorporate Lennart's miranda.hs functions
31 # Replace most Miranda fns & operators
32 # Use \<word\> patterns, ';' -> ',' in list comprehension
33 # Provide example main functions
34 # 1.02 30 Mar 1992 Mods to header, fix handling of type,type
35 # Comment out String definition, Bool ops
36 # num -> Int, = -> == in guards
37 # 1.01 10 Dec 1991 Convert type names to initial capital
38 # 1.00 27 Sep 1991 Initial version advertised to net
41 # continued inequalities (a < x < b)
42 # boolean '=' operator -> '==' (except in guards)
44 # multi-line type definitions
45 # guards on different line from body
46 # diagonalised list comprehensions (//)
47 # repeated variables in patterns (eg. LHS of function)
48 # filemode -> statusFile, getenv -> getEnv, read -> readFile, system
50 # conflicts with prelude identifiers
52 # Miranda's num type (Integral+Floating) is changed to Int so won't
53 # work for non-intger nums. Miranda has irrefutable ("lazy") tuple
54 # patterns so you may need to add a ~, like ~(x,y) in Haskell.
55 # Haskell functions "length" and "not" may need parentheses round
58 # mira2hs copes equally well with literate and illiterate scripts. It
59 # doesn't care what characters lines begins with - it assumes
60 # everything is code. It will convert code even inside comments.
62 # For literate programs you will have to turn the standard header into
63 # literate form and rename the output .lhs. You might want to do this
64 # to (a copy of) mira2hs itself if you have lots of literate progs.
66 # ToDo: = inside brackets -> ==
70 out=`basename $in .m`.hs
71 else in="Standard input"
77 # Prepend a standard header and some function definitions.
78 echo -- $in converted to Haskell by $USER on `date` > $tmp
80 module Main (main) where
82 -------------------- mira2hs functions --------------------
84 cjustify :: Int -> String -> String
85 cjustify n s = spaces l ++ s ++ spaces r
91 e :: (Floating a) => a
94 hugenum :: (RealFloat a) => a
95 hugenum = encodeFloat (r^d-1) (n-d)
96 where r = floatRadix hugenum
97 d = floatDigits hugenum
98 (_,n) = floatRange hugenum
100 subscripts :: [a] -> [Int] -- Miranda index
101 subscripts xs = f xs 0
103 f (_:xs) n = n : f xs (n+1)
105 integer :: (RealFrac a) => a -> Bool
106 integer x = x == fromIntegral (truncate x)
108 lay :: [String] -> String
109 lay = concat . map (++"\n")
111 layn :: [String] -> String
112 layn = concat . zipWith f [1..]
114 f :: Int -> String -> String
115 f n x = rjustify 4 (show n) ++ ") " ++ x ++ "\n"
117 limit :: (Eq a) => [a] -> a
118 limit (x:y:ys) | x == y = x
119 | otherwise = limit (y:ys)
120 limit _ = error "limit: bad use"
122 ljustify :: Int -> String -> String
123 ljustify n s = s ++ spaces (n - length s)
125 member :: (Eq a) => [a] -> a -> Bool
126 member xs x = elem x xs
128 merge :: (Ord a) => [a] -> [a] -> [a]
131 merge xxs@(x:xs) yys@(y:ys) | x <= y = x : merge xs yys
132 | otherwise = y : merge xxs ys
134 numval :: (Num a) => String -> a
137 postfix :: [a] -> a -> [a]
138 postfix xs x = xs ++ [x]
140 rep :: Int -> b -> [b]
141 rep n x = take n (repeat x)
143 rjustify :: Int -> String -> String
144 rjustify n s = spaces (n - length s) ++ s
146 seq :: (Eq a) => a -> b -> b
147 seq x y = if x == x then y else y
149 shownum :: (Num a) => a -> String
152 sort :: (Ord a) => [a] -> [a]
154 | otherwise = merge (sort (take n2 x)) (sort (drop n2 x))
157 spaces :: Int -> String
159 spaces n = ' ' : spaces (n-1)
161 tinynum :: (RealFloat a) => a
162 tinynum = encodeFloat 1 (n-d)
163 where r = floatRadix tinynum
164 d = floatDigits tinynum
165 (n,_) = floatRange tinynum
168 undef = error "undefined"
170 zipPair (x,y) = zip x y
172 -- Following is UNTESTED
174 Stdout String | Stderr String | Tofile String String |
175 Closefile String | Appendfile String |
179 doSysMessages :: [Sys_message] -> Dialogue
180 doSysMessages requests responses = doMsgs requests []
183 doMsgs ((Appendfile f):rs) afs = doMsgs rs (f:afs)
184 doMsgs ((Exit n) :rs) afs = []
186 = doMsg r : doMsgs rs afs
187 where doMsg (Stdout s) = AppendChan stdout s
188 doMsg (Stderr s) = AppendChan stderr s
189 doMsg (Tofile f s) | elem f afs = AppendFile f s
190 | otherwise = WriteFile f s
192 = error "doSysMessages{mira2hs}: Closefile sys_message not supported"
193 -- doMsg (Closefile f) = CloseFile f -- optional
194 -- doMsg (System cmd)
195 -- = error "doSysMessages{mira2hs}: System sys_message not supported"
197 -- Pick a main. (If I was clever main would be an overloaded fn :-).
199 -- main = printString s -- s :: String
200 -- main = interact f -- f :: String -> String
201 -- main = doSysMessages l -- l :: [Sys_message]
202 -- main = print x -- x :: (Text a) => a
204 printString :: String -> Dialogue
205 printString s = appendChan stdout s abort done
207 -------------------- mira2hs functions end --------------------
210 # It's amazing what sed can do.
212 # Type synonyms and constructed types: insert "type" or "data". Add a
213 # dummy :: to flag this line to the type name munging below. Beware
214 # ====== in comments.
215 /[^=]==[^=]/s/\(.*=\)=/::type \1/g
216 /::=/s/\(.*\)::=/::data \1=/g
217 # Change type variable *s to "a"s
219 # List length & various other renamed functions (# reused below).
223 s/\<converse\>/flip/g
225 s/\<dropwhile\>/dropWhile/g
226 s/\<digit\>/isDigit/g
229 s/\<index\>/subscripts/g
230 s/\<letter\>/isAlpha/g
240 # Miranda uncurried zip -> zipPair (above). Do before zip2->zip.
242 # Miranda curried zip2 -> zip
244 # Haskel div and mod are functions, not operators
247 # Locate commas introducing guards by temporarily changing others.
248 # Replace comma with # when after || or unmatched ( or [ or before
249 # unmatched ) or ] or in string or char constants. Replace
250 # matched () not containing commas with _<_ _>_ and matched []
251 # with _{_ _}_ and repeat until no substitutions.
254 s/\([[(][^])]*\),/\1#/g
255 s/,\([^[(]*[])]\)/#\1/g
256 s/(\([^),]*\))/_<_\1_>_/g
257 s/\[\([^],]*\)\]/_{_\1_}_/g
258 s/"\(.*\),\(.*\)"/"\1#\2"/g
268 # The only commas left now introduce guards, remove optional "if"
271 # Temporarily change ~=, <=, >=.
275 # Replace every = in guard with == (do after type synonyms)
277 s/\(,.*[^=]\)=\([^=]\)/\1==\2/
281 # Replace <pattern> = <rhs> , <guard> with <pattern> | (<guard>) = <rhs>
282 s/=\(..*\),\(..*\)/| (\2) =\1/g
283 s/(otherwise)/otherwise/g
284 # Restore other commas
286 # List difference. Beware ------ in comments.
287 s/\([^-]\)--\([^-]\)/\1\\\\\2/g
288 # Comments (do after list diff)
291 # Boolean not, or, and (do after comments)
297 # Locate semicolon in list comprehensions by temporarily replacing ones
298 # in string or char constants with #. Replace matched [] not
299 # containing semicolon with _{_ _}_ and repeat until no substitutions.
301 s/\[\([^];]*\)\]/_{_\1_}_/g
302 s/"\([^;"]*\);\([^;"]*\)"/"\1#\2"/g
307 # Remaining [ ] must contain semicolons which we change to comas.
312 # Restore [] and other semicolons
316 # Miranda dollar turns a function into an infix operator
317 s/\$\([_A-Za-z0-9'\'']\{1,\}\)/`\1`/g
320 # Create a sed script to change the first letter of each type name to
322 # Dummy definitions for predefined types (num is special).
326 echo ::type sys_message =
329 # Find type definitions & extract type names
330 sed -n '/::data[ ].*=/{
331 h;s/::data[ ]*\([^ =]\).*/\1/p
332 y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/;p
333 g;s/::data[ ]*[^ =]\([^ =]*\).*=.*/\1/p
336 h;s/::type[ ]*\([^ =]\).*/\1/p
337 y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/;p
338 g;s/::type[ ]*[^ =]\([^ =]*\).*=.*/\1/p
340 # Read lower case initial, upper case inital and rest of type name.
341 # Type is always after "::".
344 while read h; read H; read t
345 do echo "/::/s/\<$h$t\>/$H$t/g"
350 # Loop round to catch type,type,..
352 # Remove the dummy :: flags from type definitions.
355 # Comment out string type if defined.
356 s/\(type[ ]*String[ ]*=\)/-- \1/