PA1Helper.hs

module PA1Helper(runProgram,Lexp(..)) where

import Text.Parsec
import Text.Parsec.String
import Text.Parsec.Expr
import Text.Parsec.Token
import Text.Parsec.Language
import Text.Parsec.Char

-- Haskell representation of lambda expression
-- In Lambda Lexp Lexp, the first Lexp should always be Atom String
data Lexp = Atom String | Lambda Lexp Lexp | Apply Lexp Lexp

-- Make it possible to determine if two lambda expressions are structurally equal
instance Eq Lexp  where
    (Atom v1) == (Atom v2) = v1 == v2
    (Lambda (Atom v1) exp1) == (Lambda (Atom v2) exp2) = v1 == v2 && exp1 == exp2
    (Apply exp1 exp2) == (Apply exp3 exp4) = exp1 == exp3 && exp2 == exp4  
    _ == _ = False

-- Allow for Lexp datatype to be printed like the Oz representation of a lambda expression
instance Show Lexp  where 
    show (Atom v) = v
    show (Lambda exp1 exp2) = "\\" ++ show exp1 ++ "." ++ show exp2 
    show (Apply exp1 exp2) = "(" ++ show exp1 ++ " " ++ show exp2 ++ ")" 


-- Reserved keywords in Oz
-- P. 841 Table C.8, "Concepts, Techniques, and Models of Computer Programming", 
-- Van Roy, Haridi
ozKeywords=["andthen" , "at"     , "attr"     , "break"   ,
            "case"    , "catch"  , "choice"   , "class"   ,
            "collect" , "cond"   , "continue" , "declare" ,
            "default" , "define" , "dis"      , "div"     ,
            "do"      , "else"   , "elsecase" , "elseif"  ,
            "elseof"  , "end"    , "export"   , "fail"    ,
            "false"   , "feat"   , "finally"  , "for"     ,
            "from"    , "fun"    , "functor"  , "if"      ,
            "import"  , "in"     , "lazy"     , "local"   ,
            "lock"    , "meth"   , "mod"      , "not"     ,
            "of"      , "or"     , "orelse"   , "prepare" ,
            "proc"    , "prop"   , "raise"    , "require" ,
            "return"  , "self"   , "skip"     , "then"    ,
            "thread"  , "true"   , "try"      , "unit"    ]

-- Sparse language definition to define a proper Oz identifier
-- An atom is defined as follows:
-- 1. sequence of alphanumeric chars starting with a lowercase letter, 
--   excluding language keywords
-- 2. arbitrary printable chars enclosed in single quotes, 
--   excluding "'", "\", and "NUL"
-- lDef defines an atom as only 1.
-- P. 825,"Concepts, Techniques, and Models of Computer Programming", 
-- Van Roy, Haridi
lDef = emptyDef { identStart = lower
                , identLetter = alphaNum
                , reservedNames = ozKeywords
                } 
-- Obtains helper functions for parsing 
TokenParser{ parens = m_parens
           , identifier = m_identifier
           , reserved = m_reserved
           , brackets   = m_brackets
           } = makeTokenParser lDef

-- Below is code to parse Oz lambda expressions and represent them in Haskell
atom = do
  var <- m_identifier
  return (Atom var)

lambargs = do
  var1 <- atom
  char '.'
  var2 <- start
  return (Lambda var1 var2)

lamb = do
  char '\\'
  lambargs

appargs = do
    var1 <- start
    spaces
    var2 <- start
    return (Apply var1 var2)

app = m_parens appargs 

start = atom <|> lamb <|> app

-- Use previously defined parser to parse a given String
parseLExpr :: String -> Either ParseError Lexp 
parseLExpr = parse start ""

-- Given a list of Strings, return a list containing only Lexp objects
-- for strings that are valid lambda expressions
parseLEList :: [String]->[Lexp]
parseLEList [] = []
parseLEList (x:xs) = let xs' = parseLEList xs 
                              in case parseLExpr x of
                                   Left err -> xs' 
                                   Right x' -> x':xs' 

-- Pretty printer for outputting inputted lambda expressions along with
-- their reduced expressions. Integer used to distiguish between test cases.
outputPrinter :: Int -> [(Lexp,Lexp)] -> IO()
outputPrinter _ [] = return ()
outputPrinter n ((lexp,lexp'):lexps) = do
    putStrLn ("Input  " ++ show n ++ ": " ++ show lexp)
    putStrLn ("Result " ++ show n ++ ": " ++ show lexp')
    outputPrinter (n+1) lexps

-- Given a filename and function for reducing lambda expressions,
-- reduce all valid lambda expressions in the file and output results.
runProgram :: String -> (Lexp -> Lexp) -> IO()
runProgram fileName reducer = do
    fcontents <- readFile fileName
    let inList = lines fcontents 
    let parsedList = parseLEList inList
    let reducedList = map reducer parsedList
    outputPrinter 1 (zip parsedList reducedList)