#!/bin/sh # mira2hs - Convert Miranda to Haskell (or Gofer) # usage: mira2hs [infile [outfile]] # # Input defaults to stdin, output defaults to .hs or stdout if # input is stdin # Copyright Denis Howe 1992 # # Permission is granted to make and distribute verbatim or modified # copies of this program, provided that every such copy or derived # work carries the above copyright notice and is distributed under # terms identical to these. # # Miranda is a trademark of Research Software Limited. # (E-mail: mira-request@ukc.ac.uk). # # Denis Howe # NOTE: This program needs a sed which understands \ regular # expressions, eg. Sun or GNU sed (gsed). # partain: got it from wombat.doc.ic.ac.uk:pub # 1.05 18 Sep 1992 zip -> zipPair # 1.04 29 Jul 1992 Improve handling of ==, -- and whitespace round guards # $infix -> `infix` # 1.03 24 Apr 1992 Incorporate Lennart's miranda.hs functions # Replace most Miranda fns & operators # Use \ patterns, ';' -> ',' in list comprehension # Provide example main functions # 1.02 30 Mar 1992 Mods to header, fix handling of type,type # Comment out String definition, Bool ops # num -> Int, = -> == in guards # 1.01 10 Dec 1991 Convert type names to initial capital # 1.00 27 Sep 1991 Initial version advertised to net # Does NOT handle: # continued inequalities (a < x < b) # boolean '=' operator -> '==' (except in guards) # main function # multi-line type definitions # guards on different line from body # diagonalised list comprehensions (//) # repeated variables in patterns (eg. LHS of function) # filemode -> statusFile, getenv -> getEnv, read -> readFile, system # include directives # conflicts with prelude identifiers # Miranda's num type (Integral+Floating) is changed to Int so won't # work for non-intger nums. Miranda has irrefutable ("lazy") tuple # patterns so you may need to add a ~, like ~(x,y) in Haskell. # Haskell functions "length" and "not" may need parentheses round # their arguments. # mira2hs copes equally well with literate and illiterate scripts. It # doesn't care what characters lines begins with - it assumes # everything is code. It will convert code even inside comments. # # For literate programs you will have to turn the standard header into # literate form and rename the output .lhs. You might want to do this # to (a copy of) mira2hs itself if you have lots of literate progs. # ToDo: = inside brackets -> == if [ -n "$1" ] then in=$1 out=`basename $in .m`.hs else in="Standard input" fi [ -n "$2" ] && out=$2 tmp=/tmp/m2h$$ script=${tmp}s # Prepend a standard header and some function definitions. echo -- $in converted to Haskell by $USER on `date` > $tmp cat << "++++" >> $tmp module Main (main) where -------------------- mira2hs functions -------------------- cjustify :: Int -> String -> String cjustify n s = spaces l ++ s ++ spaces r where m = n - length s l = div m 2 r = m - l e :: (Floating a) => a e = exp 1 hugenum :: (RealFloat a) => a hugenum = encodeFloat (r^d-1) (n-d) where r = floatRadix hugenum d = floatDigits hugenum (_,n) = floatRange hugenum subscripts :: [a] -> [Int] -- Miranda index subscripts xs = f xs 0 where f [] n = [] f (_:xs) n = n : f xs (n+1) integer :: (RealFrac a) => a -> Bool integer x = x == fromIntegral (truncate x) lay :: [String] -> String lay = concat . map (++"\n") layn :: [String] -> String layn = concat . zipWith f [1..] where f :: Int -> String -> String f n x = rjustify 4 (show n) ++ ") " ++ x ++ "\n" limit :: (Eq a) => [a] -> a limit (x:y:ys) | x == y = x | otherwise = limit (y:ys) limit _ = error "limit: bad use" ljustify :: Int -> String -> String ljustify n s = s ++ spaces (n - length s) member :: (Eq a) => [a] -> a -> Bool member xs x = elem x xs merge :: (Ord a) => [a] -> [a] -> [a] merge [] ys = ys merge xs [] = xs merge xxs@(x:xs) yys@(y:ys) | x <= y = x : merge xs yys | otherwise = y : merge xxs ys numval :: (Num a) => String -> a numval cs = read cs postfix :: [a] -> a -> [a] postfix xs x = xs ++ [x] rep :: Int -> b -> [b] rep n x = take n (repeat x) rjustify :: Int -> String -> String rjustify n s = spaces (n - length s) ++ s seq :: (Eq a) => a -> b -> b seq x y = if x == x then y else y shownum :: (Num a) => a -> String shownum x = show x sort :: (Ord a) => [a] -> [a] sort x | n <= 1 = x | otherwise = merge (sort (take n2 x)) (sort (drop n2 x)) where n = length x n2 = div n 2 spaces :: Int -> String spaces 0 = "" spaces n = ' ' : spaces (n-1) tinynum :: (RealFloat a) => a tinynum = encodeFloat 1 (n-d) where r = floatRadix tinynum d = floatDigits tinynum (n,_) = floatRange tinynum undef :: a undef = error "undefined" zipPair (x,y) = zip x y -- Following is UNTESTED data Sys_message = Stdout String | Stderr String | Tofile String String | Closefile String | Appendfile String | -- System String | Exit Int doSysMessages :: [Sys_message] -> Dialogue doSysMessages requests responses = doMsgs requests [] doMsgs [] afs = [] doMsgs ((Appendfile f):rs) afs = doMsgs rs (f:afs) doMsgs ((Exit n) :rs) afs = [] doMsgs (r :rs) afs = doMsg r : doMsgs rs afs where doMsg (Stdout s) = AppendChan stdout s doMsg (Stderr s) = AppendChan stderr s doMsg (Tofile f s) | elem f afs = AppendFile f s | otherwise = WriteFile f s doMsg (Closefile f) = error "doSysMessages{mira2hs}: Closefile sys_message not supported" -- doMsg (Closefile f) = CloseFile f -- optional -- doMsg (System cmd) -- = error "doSysMessages{mira2hs}: System sys_message not supported" -- Pick a main. (If I was clever main would be an overloaded fn :-). main :: Dialogue -- main = printString s -- s :: String -- main = interact f -- f :: String -> String -- main = doSysMessages l -- l :: [Sys_message] -- main = print x -- x :: (Text a) => a printString :: String -> Dialogue printString s = appendChan stdout s abort done -------------------- mira2hs functions end -------------------- ++++ # It's amazing what sed can do. sed ' # Type synonyms and constructed types: insert "type" or "data". Add a # dummy :: to flag this line to the type name munging below. Beware # ====== in comments. /[^=]==[^=]/s/\(.*=\)=/::type \1/g /::=/s/\(.*\)::=/::data \1=/g # Change type variable *s to "a"s /::/s/\*/a/g # List length & various other renamed functions (# reused below). s/ *# */ length /g s/\/atan/g s/\/ord/g s/\/flip/g s/\/chr/g s/\/dropWhile/g s/\/isDigit/g s/\/floor/g s/\/head/g s/\/subscripts/g s/\/isAlpha/g s/\/zipWith/g s/\/maximum/g s/\/max/g s/\/minimum/g s/\/min/g s/\/nub/g s/\/negate/g s/\/scanl/g s/\/tail/g # Miranda uncurried zip -> zipPair (above). Do before zip2->zip. s/\/zipPair/g # Miranda curried zip2 -> zip s/\/zip/g # Haskel div and mod are functions, not operators s/\/\`div\`/g s/\/\`mod\`/g # Locate commas introducing guards by temporarily changing others. # Replace comma with # when after || or unmatched ( or [ or before # unmatched ) or ] or in string or char constants. Replace # matched () not containing commas with _<_ _>_ and matched [] # with _{_ _}_ and repeat until no substitutions. : comma s/\(||.*\),/\1#/g s/\([[(][^])]*\),/\1#/g s/,\([^[(]*[])]\)/#\1/g s/(\([^),]*\))/_<_\1_>_/g s/\[\([^],]*\)\]/_{_\1_}_/g s/"\(.*\),\(.*\)"/"\1#\2"/g '"#change quotes s/','/'#'/g "'#change quotes t comma # Restore () and [] s/_<_/(/g s/_>_/)/g s/_{_/[/g s/_}_/]/g # The only commas left now introduce guards, remove optional "if" s/,[ ]*if/,/g s/[ ]*,[ ]*/,/g # Temporarily change ~=, <=, >=. s%~=%/_eq_%g s/<=/<_eq_/g s/>=/>_eq_/g # Replace every = in guard with == (do after type synonyms) : neq s/\(,.*[^=]\)=\([^=]\)/\1==\2/ t neq # Fix other equals s/_eq_/=/g # Replace = , with | () = s/=\(..*\),\(..*\)/| (\2) =\1/g s/(otherwise)/otherwise/g # Restore other commas s/#/,/g # List difference. Beware ------ in comments. s/\([^-]\)--\([^-]\)/\1\\\\\2/g # Comments (do after list diff) s/||/--/g s/--|/---/g # Boolean not, or, and (do after comments) s/ *~ */ not /g s% *\\/ *% || %g s/&/&&/g # list indexing s/!/!!/g # Locate semicolon in list comprehensions by temporarily replacing ones # in string or char constants with #. Replace matched [] not # containing semicolon with _{_ _}_ and repeat until no substitutions. : semico s/\[\([^];]*\)\]/_{_\1_}_/g s/"\([^;"]*\);\([^;"]*\)"/"\1#\2"/g '"#change quotes s/';'/'#'/g "'# change quotes t semico # Remaining [ ] must contain semicolons which we change to comas. : lcomp s/\(\[[^;]*\);/\1,/g s/;\([^;]*\]\)/,\1/g t lcomp # Restore [] and other semicolons s/_{_/[/g s/_}_/]/g s/#/;/g # Miranda dollar turns a function into an infix operator s/\$\([_A-Za-z0-9'\'']\{1,\}\)/`\1`/g ' $1 >> $tmp # Create a sed script to change the first letter of each type name to # upper case. # Dummy definitions for predefined types (num is special). ( echo ::type char = echo ::type bool = echo ::type sys_message = cat $tmp ) | \ # Find type definitions & extract type names sed -n '/::data[ ].*=/{ h;s/::data[ ]*\([^ =]\).*/\1/p y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/;p g;s/::data[ ]*[^ =]\([^ =]*\).*=.*/\1/p } /::type[ ].*=/{ h;s/::type[ ]*\([^ =]\).*/\1/p y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/;p g;s/::type[ ]*[^ =]\([^ =]*\).*=.*/\1/p }' | \ # Read lower case initial, upper case inital and rest of type name. # Type is always after "::". ( echo ": loop" while read h; read H; read t do echo "/::/s/\<$h$t\>/$H$t/g" done cat << "++++" # num -> Int /::/s/\/Int/g # Loop round to catch type,type,.. t loop # Remove the dummy :: flags from type definitions. s/::type/type/ s/::data/data/ # Comment out string type if defined. s/\(type[ ]*String[ ]*=\)/-- \1/ ++++ ) > $script if [ "$out" ] then exec > $out fi sed -f $script $tmp rm -f ${tmp}*