-- COMP2209 Coursework 2, University of Southampton 2018 -- DUMMY FILE FOR YOU TO EDIT AND ADD YOUR OWN IMPLEMENTATIONS -- NOTE THAT NO THIRD PARTY MODULES MAY BE USED IN SOLVING THESE EXERCISES AND -- THAT YOU MAY NOT CHANGE THE FUNCTION TYPE SIGNATURES NOR TYPE DEFINITIONS -- This module statement makes public only the specified functions and types -- DO NOT CHANGE THIS LIST OF EXPORTED FUNCTIONS AND TYPES module Challenges (convertLet, prettyPrint, parseLet, countReds, compileArith, Expr(App, Let, Var), LamExpr(LamApp, LamAbs, LamVar)) where import Data.Char import Parsing -- Challenge 1 data Expr = App Expr Expr | Let [Int] Expr Expr | Var Int deriving (Show,Eq) data LamExpr = LamApp LamExpr LamExpr | LamAbs Int LamExpr | LamVar Int deriving (Show,Eq) -- convert a let expression to lambda expression convertLet :: Expr -> LamExpr -- replace the definition below with your solution convertLet (Var v) = LamVar v convertLet (App e e') = LamApp (convertLet e) (convertLet e') convertLet (Let [var] e e') = LamApp (LamAbs var (convertLet e')) (convertLet e) convertLet (Let (var:vars) e e') = LamApp (produceAbstractions [var] e') (produceAbstractions vars e) produceAbstractions :: [Int] -> Expr -> LamExpr produceAbstractions [] (Var v) = LamVar v produceAbstractions [] (App e e') = LamApp (convertLet e) (convertLet e') produceAbstractions [var] e = LamAbs var (convertLet e) produceAbstractions (var:vars) e = LamAbs var (produceAbstractions vars e) -- Challenge 2 -- pretty print a let expression by converting it to a string prettyPrint :: Expr -> String -- replace the definition below with your solution prettyPrint (Let vars e e') = "let " ++ foldl (\acc x -> acc ++ (prettyPrint (Var x)) ++ " ") "" vars ++ "= " ++ prettyPrint e ++ " in " ++ prettyPrint e' prettyPrint (Var v) = "x" ++ (show v) prettyPrint (App e e') = if (isApp e') then left ++ " (" ++ right ++ ")" else if (isLet e) then "(" ++ left ++ ") " ++ right else left ++ " " ++ right where left = prettyPrint e right = prettyPrint e' isApp :: Expr -> Bool isApp (App _ _) = True isApp _ = False isLet :: Expr -> Bool isLet (Let _ _ _) = True isLet _ = False -- Challenge 3 -- parse a let expression parseLet :: String -> Maybe Expr -- replace the definition below with your solution parseLet s = case parse parseExpr s of [(expression, _)] -> Just expression _ -> Nothing parseExpr :: Parser Expr parseExpr = token parseBracket <|> parseVar' <|> parseLet' parseVar' = do vars <- parseVars return (produceApps $ reverse vars) parseVar = do symbol "x" n <- nat return (Var n) parseLet' = do symbol "let" vars <- parseVars symbol "=" v1 <- parseVar symbol "in" v2 <- parseVars return (Let vars v1 (produceApps v2)) parseBracket = do v <- parseVar symbol "(" e <- token parseExpr symbol ")" return (App v e) parseVars = do vars <- some (token parseVar) return [n | (Var n) <- vars] produceApps :: [Int] -> Expr produceApps [v] = Var v produceApps (v:vs) = App (produceApps vs) (produceApps [v]) -- Challenge 4 -- count reductions using two different strategies countReds :: LamExpr -> Int -> (Maybe Int, Maybe Int) -- replace the definition below with your solution countReds e limit = (reduce eval1cbv e limit 0, reduce eval1cbn e limit 0) -- Expression, limit, count -> result -- r not eq e is needed in case no reductions are required lambdaExpr5 = (LamApp (LamAbs 1 (LamAbs 2 (LamVar 1))) (LamVar 3)) lambdaExpr6 = LamApp lambdaExpr5 (LamApp (LamAbs 4 (LamVar 4)) (LamVar 5)) reduce :: (LamExpr -> LamExpr) -> LamExpr -> Int -> Int -> Maybe Int reduce f e l c | c == l && r /= e = Nothing | r == e = Just c | r /= e = reduce f r l (c + 1) where r = f e rename :: Int -> Int rename x = x + 1 free :: Int -> LamExpr -> Bool free x (LamVar y) = x == y free x (LamAbs y e) | x == y = False free x (LamAbs y e) | x /= y = free x e free x (LamApp e1 e2) = (free x e1) || (free x e2) subst :: LamExpr -> Int -> LamExpr -> LamExpr subst (LamVar x) y e | x == y = e subst (LamVar x) y e | x /= y = LamVar x subst (LamAbs x e1) y e | x /= y && not (free x e) = LamAbs x (subst e1 y e) subst (LamAbs x e1) y e | x /= y && (free x e) = let x' = rename x in subst (LamAbs x' (subst e1 x (LamVar x'))) y e subst (LamAbs x e1) y e | x == y = LamAbs x e1 subst (LamApp e1 e2) y e = LamApp (subst e1 y e) (subst e2 y e) eval1cbv :: LamExpr -> LamExpr eval1cbv e@(LamVar _) = e eval1cbv e@(LamApp (LamVar _) (LamVar _)) = e eval1cbv (LamAbs x e) = (LamAbs x e) eval1cbv (LamApp (LamAbs x e1) e@(LamAbs y e2)) = subst e1 x e eval1cbv (LamApp (LamAbs x e1) e@(LamVar _)) = subst e1 x e eval1cbv (LamApp e@(LamAbs x e1) e2) = subst e1 x e2 --LamApp e (eval1cbv e2) -- eval1cbv (LamApp e@(LamVar _) e2) = LamApp e (eval1cbv e2) eval1cbv (LamApp e1 e2) = LamApp (eval1cbv e1) e2 eval1cbn :: LamExpr -> LamExpr eval1cbn e@(LamVar _) = e eval1cbn e@(LamApp (LamVar _) (LamVar _)) = e eval1cbn (LamAbs x e) = (LamAbs x e) eval1cbn (LamApp e@(LamAbs x e1) (LamAbs y e2)) = subst e2 x e eval1cbn (LamApp (LamAbs x e1) e@(LamVar _)) = subst e1 x e --eval1cbn (LamApp e2 e@(LamAbs x e1)) = LamApp (eval1cbn e2) e eval1cbn (LamApp e1 e@(LamVar _)) = LamApp (eval1cbn e1) e eval1cbn (LamApp e1 e2) = LamApp e1 (eval1cbn e2) --eval1cbv e = LamApp e (LamVar 99) --((λt -> t) u)) -- LamApp (LamAbs 1 (LamVar 1)) (LamVar 2) --(λx -> λy -> x) z ((λt -> t) u) -- App (App ( (Var 3))) -- get all redexes first, put them in list, then all combinations -- rather than recursively, go iteratively through the list -- at each step, try to reduce, regenerate --reduce LamExpr Int Int -> Maybe Int : return nothing if same or limit -- Challenge 5 -- compile an arithmetic expression into a lambda calculus equivalent data ArithExpr = Value Int | Plus ArithExpr | Add ArithExpr ArithExpr deriving (Show, Eq) compileArith :: String -> Maybe LamExpr -- replace the definition below with your solution compileArith s = case parse parseA s of [(expression, "")] -> Just (genLamExpr expression) _ -> Nothing parseA :: Parser ArithExpr parseA = token parseAddition <|> parseBrackets <|> parsePlus <|> parseInt parseAddition = do v <- nat do symbol "+" (Value v2) <- parseAddition return (Value (v + v2)) <|> return (Value v) parseBrackets = do symbol "(" p <- parsePlus symbol ")" a <- parseAddition return (Add p a) parsePlus = do symbol "+" (Value v) <- parseA return (Plus (Value v)) parseInt = do n <- nat return (Value n) genLamExprBody :: Int -> LamExpr genLamExprBody 0 = LamVar 2 --genLamExprBody 1 = LamApp (LamVar 1) (genLamExprBody 0) genLamExprBody n = LamApp (LamVar 1) (genLamExprBody (n - 1)) genLamExpr :: ArithExpr -> LamExpr genLamExpr (Value v) = LamAbs 1 (LamAbs 2 (genLamExprBody v)) genLamExpr (Plus v) = LamApp (genLamExpr v) ((LamAbs 1 (LamAbs 2 (LamAbs 3 (LamApp (LamVar 2) (LamApp (LamApp (LamVar 1) (LamVar 2)) (LamVar 3)))))))