diff options
Diffstat (limited to 'ghc/CONTRIB/mira2hs')
| -rw-r--r-- | ghc/CONTRIB/mira2hs | 364 |
1 files changed, 0 insertions, 364 deletions
diff --git a/ghc/CONTRIB/mira2hs b/ghc/CONTRIB/mira2hs deleted file mode 100644 index 1ad61040f7..0000000000 --- a/ghc/CONTRIB/mira2hs +++ /dev/null @@ -1,364 +0,0 @@ -#!/bin/sh - -# mira2hs - Convert Miranda to Haskell (or Gofer) - -# usage: mira2hs [infile [outfile]] -# -# Input defaults to stdin, output defaults to <infile>.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 <dbh@doc.ic.ac.uk> - -# NOTE: This program needs a sed which understands \<word\> 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 \<word\> 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/\<arctan\>/atan/g -s/\<code\>/ord/g -s/\<converse\>/flip/g -s/\<decode\>/chr/g -s/\<dropwhile\>/dropWhile/g -s/\<digit\>/isDigit/g -s/\<entier\>/floor/g -s/\<hd\>/head/g -s/\<index\>/subscripts/g -s/\<letter\>/isAlpha/g -s/\<map2\>/zipWith/g -s/\<max\>/maximum/g -s/\<max2\>/max/g -s/\<min\>/minimum/g -s/\<min2\>/min/g -s/\<mkset\>/nub/g -s/\<neg\>/negate/g -s/\<scan\>/scanl/g -s/\<tl\>/tail/g -# Miranda uncurried zip -> zipPair (above). Do before zip2->zip. -s/\<zip\>/zipPair/g -# Miranda curried zip2 -> zip -s/\<zip2\>/zip/g -# Haskel div and mod are functions, not operators -s/\<div\>/\`div\`/g -s/\<mod\>/\`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 <pattern> = <rhs> , <guard> with <pattern> | (<guard>) = <rhs> -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/\<num\>/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}* |