From 10551cb5cfe8f092081a40e2915daf10b49be647 Mon Sep 17 00:00:00 2001 From: ik1g19 <ik1g19@soton.ac.uk> Date: Thu, 14 Jan 2021 04:02:02 +0000 Subject: [PATCH] formatted for submission, fuck challenge 6 --- cw/src/Challenges.hs | 199 ++++++++++++++++++++----------------------- 1 file changed, 92 insertions(+), 107 deletions(-) diff --git a/cw/src/Challenges.hs b/cw/src/Challenges.hs index e9ac1a4..a16ee6d 100644 --- a/cw/src/Challenges.hs +++ b/cw/src/Challenges.hs @@ -4,10 +4,9 @@ -- Skeleton code to be updated with your solutions -- The dummy functions here simply return an arbitrary value that is usually wrong --- DO NOT MODIFY THE FOLLOWING LINES OF CODE module Challenges (WordSearchGrid,Placement,Posn,Orientation(..),solveWordSearch, createWordSearch, LamMacroExpr(..),LamExpr(..),prettyPrint, parseLamMacro, - cpsTransform,innerRedn1,outerRedn1,compareInnerOuter,ex6'1,ex6'2,ex6'3,ex6'4,ex6'5,ex6'6,ex6'7,eval1cbv,eval1cbn,reductions,trace,ex5'1,ex5'2,ex5'3,ex5'4,highestVar,exId,freeVar,unique,closed) where + cpsTransform,innerRedn1,outerRedn1,compareInnerOuter) where -- Import standard library and parsing definitions from Hutton 2016, Chapter 13 -- We import System.Random - make sure that your installation has it installed - use stack ghci and stack ghc @@ -98,9 +97,12 @@ nextPos DownForward (x,y) = (x+1,y+1) nextPos DownBack (x,y) = (x-1,y+1) +----------------------------Utility Functions----------------------------------- + + elemAt :: [[a]] -> Posn -> a -elemAt ass (x,y) = (ass !! y) !! x -- | ass means list of list of a's, - -- | not associated with any other meaning +elemAt ass (x,y) = (ass !! y) !! x + {--| returns specified adjacent element in grid, |-- --| relative to given position |--} @@ -260,6 +262,10 @@ prettyPrint :: LamMacroExpr -> String prettyPrint (LamDef ms e) = macroDef ms ++ exprToStr ms e +----------------------------Primary Functions----------------------------------- + + +{--| converts bindings to strings |--} macroDef :: [(String,LamExpr)] -> String macroDef [] = "" macroDef ( (name,expr):ms ) = foldl1 (++) ["def ",name," = ",exprToStr [] expr," in ",macroDef ms] @@ -284,8 +290,8 @@ exprToStr ms e@(LamApp e1 e2) | e == eNone = none | e == eRight = right | e == eBoth = both where - none = foldl1 (++) [ catchMacro ms e1, " ", catchMacro ms e2 ] - left = foldl1 (++) ["(",catchMacro ms e1,") ", catchMacro ms e2 ] + none = foldl1 (++) [ catchMacro ms e1, " ", catchMacro ms e2 ] -- | applying different uses of parenthese to + left = foldl1 (++) ["(",catchMacro ms e1,") ", catchMacro ms e2 ] -- | determine when they are necessary right = foldl1 (++) [ catchMacro ms e1, " (",catchMacro ms e2,")"] both = foldl1 (++) ["(",catchMacro ms e1,") (",catchMacro ms e2,")"] @@ -315,13 +321,16 @@ exprToStr ms (LamMacro m ) = m parseLamMacro :: String -> Maybe LamMacroExpr parseLamMacro str | parsed == [] = Nothing - | foldl1 (&&) $ - map ( (""/=) . snd ) parsed = Nothing + | foldl1 (&&) $ -- | if anything is left unparsed then the + map ( (""/=) . snd ) parsed = Nothing -- | parsing has failed | otherwise = Just $ fstHead parsed where parsed = parse (macroExpr []) str +----------------------------Primary Functions----------------------------------- + + macroExpr :: [ (String,LamExpr) ] -> Parser LamMacroExpr macroExpr ms = do string "def" name <- unique (map fst ms) (token macroName) @@ -335,31 +344,11 @@ macroExpr ms = do string "def" return $ LamDef ms e -{--| parses an element only if it is unique to a |-- - --| given list |--} -unique :: Eq a => [a] -> Parser a -> Parser a -unique xs p = do x <- p - if x `elem` xs then empty else return x - - {--| parses an expr if it is closed |--} closedParse :: Parser LamExpr -> Parser LamExpr closedParse p = do e <- p if closed e e then return e else empty -{--| finds if an expression is closed |--} -closed :: LamExpr -> LamExpr -> Bool -closed expr (LamVar x) = not $ freeVar x expr -closed expr (LamAbs _ e ) = closed expr e -closed expr (LamApp e1 e2) = closed expr e1 && closed expr e2 - -{--| finds if a given variable is free in an expr |--} -freeVar :: Int -> LamExpr -> Bool -freeVar x (LamVar y) = x == y -freeVar x (LamAbs y e) | x == y = False - | otherwise = freeVar x e -freeVar x (LamApp e1 e2) = freeVar x e1 || freeVar x e2 - expr :: Parser LamExpr expr = do terms <- some $ token term @@ -398,7 +387,31 @@ fstHead :: [(a,b)] -> a fstHead = fst . head --- Challenge 5 +----------------------------Utility Functions----------------------------------- + + +{--| parses an element only if it is unique to a |-- + --| given list |--} +unique :: Eq a => [a] -> Parser a -> Parser a +unique xs p = do x <- p + if x `elem` xs then empty else return x + + +{--| finds if an expression is closed |--} +closed :: LamExpr -> LamExpr -> Bool +closed expr (LamVar x) = not $ freeVar x expr +closed expr (LamAbs _ e ) = closed expr e +closed expr (LamApp e1 e2) = closed expr e1 && closed expr e2 + +{--| finds if a given variable is free in an expr |--} +freeVar :: Int -> LamExpr -> Bool +freeVar x (LamVar y) = x == y +freeVar x (LamAbs y e) | x == y = False + | otherwise = freeVar x e +freeVar x (LamApp e1 e2) = freeVar x e1 || freeVar x e2 + + +------------------------------------------Challenge 5------------------------------------------------- {--| Repeated for Clarity: |-- @@ -411,24 +424,24 @@ fstHead = fst . head cpsTransform :: LamMacroExpr -> LamMacroExpr cpsTransform (LamDef ms e) = LamDef ms' e' where - nextFreeInExpr = if highestVar e == -1 then + nextFreeInExpr = if highestVar e == -1 then -- | the next free variable name in the expression 1 else (+1) $ highestVar e - nextFreeInMacro = if ms == [] then + nextFreeInMacro = if ms == [] then -- | the next free variable name in the bindings 1 else (+1) $ foldl1 max $ map (highestVar . snd) ms - (ms',k) = cpsMacro [] ms $ max nextFreeInMacro nextFreeInExpr - (e',_) = cpsExpr e k + (ms',k) = cpsMacro [] ms $ max nextFreeInMacro nextFreeInExpr -- | next free variable name is passed to converter + (e',_) = cpsExpr e k -- | for use in creating new variables + + +----------------------------Primary Functions----------------------------------- {--| finds the variable name with the highest value |-- - --| in an expression |-- - --| params: |-- - --| -expression to search |-- - --| -highest variable name |--} + --| in an expression |--} highestVar :: LamExpr -> Int highestVar (LamVar x) = x highestVar (LamMacro _) = -1 @@ -472,12 +485,7 @@ cpsExpr (LamApp e1 e2) k = (LamAbs k $ LamApp e1' $ cpsExpr (LamMacro name) k = (LamMacro name,k) --- Examples in the instructions exId = (LamAbs 1 (LamVar 1)) -ex5'1 = LamDef [] (LamApp (LamVar 1) (LamVar 2)) -ex5'2 = (LamDef [ ("F", exId) ] (LamVar 2) ) -ex5'3 = (LamDef [ ("F", exId) ] (LamMacro "F") ) -ex5'4 = (LamDef [ ("F", exId) ] (LamApp (LamMacro "F") (LamMacro "F"))) -- Challenge 6 @@ -492,6 +500,43 @@ ex5'4 = (LamDef [ ("F", exId) ] (LamApp (LamMacro "F") (LamMacro "F"))) --| freeVar x (LamApp e1 e2) = freeVar x e1 || freeVar x e2 |--} +compareInnerOuter :: LamMacroExpr -> Int -> (Maybe Int,Maybe Int,Maybe Int,Maybe Int) +compareInnerOuter e b = (innerSteps,outerSteps,innerCps,outerCps) + where + innerSteps = let reduces = trace innerRedn1 b e + tillNoRedex = takeWhile (Nothing/=) reduces + in if Nothing `elem` reduces then Just $ length tillNoRedex else Nothing + + outerSteps = let reduces = trace outerRedn1 b e + tillNoRedex = takeWhile (Nothing/=) reduces + in if Nothing `elem` reduces then Just $ length tillNoRedex else Nothing + + innerCps = let LamDef ms' e' = cpsTransform e + reduces = trace innerRedn1 b $ LamDef ms' $ LamApp e' exId + tillNoRedex = takeWhile (Nothing/=) reduces + in if Nothing `elem` reduces then Just $ length tillNoRedex else Nothing + + outerCps = let LamDef ms' e' = cpsTransform e + reduces = trace outerRedn1 b $ LamDef ms' $ LamApp e' exId + tillNoRedex = takeWhile (Nothing/=) reduces + in if Nothing `elem` reduces then Just $ length tillNoRedex else Nothing + + +innerRedn1 :: LamMacroExpr -> Maybe LamMacroExpr +innerRedn1 (LamDef ms e) | redex e = Just $ LamDef ms e' + | otherwise = Nothing + where e' = eval1cbv ms e + + +outerRedn1 :: LamMacroExpr -> Maybe LamMacroExpr +outerRedn1 (LamDef ms e) | redex e = Just $ LamDef ms e' + | otherwise = Nothing + where e' = eval1cbn ms e + + +----------------------------Primary Functions----------------------------------- + + {--| substitutes an expression into another expr |-- --| params: |-- --| -expr to sub in to |-- @@ -509,11 +554,11 @@ subst (LamAbs x e) y e' | x /= y && not (freeVar x e') = LamAbs x $ subst e y subst (LamApp e1 e2) y e = LamApp (subst e1 y e) (subst e2 y e) - rename :: Int -> LamExpr -> Int rename x e = highestVar e + 1 +{--| returns true if an expression contains a redex |--} redex :: LamExpr -> Bool redex (LamAbs _ _) = False redex (LamVar _) = False @@ -522,11 +567,6 @@ redex (LamApp (LamAbs _ _) _) = True redex (LamApp e1 e2) = redex e1 || redex e2 -innerRedn1 :: LamMacroExpr -> Maybe LamMacroExpr -innerRedn1 (LamDef ms e) | redex e = Just $ LamDef ms e' - | otherwise = Nothing - where e' = eval1cbv ms e - eval1cbv :: [ (String,LamExpr) ] -> LamExpr -> LamExpr eval1cbv ms (LamAbs x e) = LamAbs x e eval1cbv ms (LamMacro name) = (snd . head) $ filter ((name==) . fst) ms @@ -535,11 +575,6 @@ eval1cbv ms (LamApp e1@(LamAbs x e) e2) = LamApp e1 $ eval1cbv ms e2 eval1cbv ms (LamApp e1 e2) = LamApp (eval1cbv ms e1) e2 -outerRedn1 :: LamMacroExpr -> Maybe LamMacroExpr -outerRedn1 (LamDef ms e) | redex e = Just $ LamDef ms e' - | otherwise = Nothing - where e' = eval1cbn ms e - eval1cbn :: [ (String,LamExpr) ] -> LamExpr -> LamExpr eval1cbn ms (LamAbs x e) = LamAbs x e eval1cbn ms (LamMacro name) = (snd . head) $ filter ((name==) . fst) ms @@ -547,13 +582,6 @@ eval1cbn ms (LamApp (LamAbs x e1) e2) = subst e1 x e2 eval1cbn ms (LamApp e1 e2) = LamApp (eval1cbn ms e1) e2 -reductions :: (LamMacroExpr -> Maybe LamMacroExpr) -> LamMacroExpr -> [Maybe LamMacroExpr] -reductions ssev e = drop 1 evals - where - evals :: [Maybe LamMacroExpr] - evals = iterate (>>=ssev) $ Just e - - {--| returns the trace of reductions for an --| expression |-- --| params: |-- @@ -561,53 +589,10 @@ reductions ssev e = drop 1 evals --| -bound for reductions |-- --| -expr to be reduced |--} trace :: (LamMacroExpr -> Maybe LamMacroExpr) -> Int -> LamMacroExpr -> [Maybe LamMacroExpr] ---trace ssev e = (map fst) $ (takeWhile (uncurry (/=)) $ reductions ssev e) ++ [( head . dropWhile (uncurry (/=)) ssev e)] trace ssev b e = take b $ reductions ssev e - -compareInnerOuter :: LamMacroExpr -> Int -> (Maybe Int,Maybe Int,Maybe Int,Maybe Int) -compareInnerOuter e b = (innerSteps,outerSteps,innerCps,outerCps) +reductions :: (LamMacroExpr -> Maybe LamMacroExpr) -> LamMacroExpr -> [Maybe LamMacroExpr] +reductions ssev e = drop 1 evals where - innerSteps = let reduces = trace innerRedn1 b e - tillNoRedex = takeWhile (Nothing/=) reduces - in if Nothing `elem` reduces then Just $ length tillNoRedex else Nothing - - outerSteps = let reduces = trace outerRedn1 b e - tillNoRedex = takeWhile (Nothing/=) reduces - in if Nothing `elem` reduces then Just $ length tillNoRedex else Nothing - - innerCps = let LamDef ms' e' = cpsTransform e - reduces = trace innerRedn1 b $ LamDef ms' $ LamApp e' exId - tillNoRedex = takeWhile (Nothing/=) reduces - in if Nothing `elem` reduces then Just $ length tillNoRedex else Nothing - - outerCps = let LamDef ms' e' = cpsTransform e - reduces = trace outerRedn1 b $ LamDef ms' $ LamApp e' exId - tillNoRedex = takeWhile (Nothing/=) reduces - in if Nothing `elem` reduces then Just $ length tillNoRedex else Nothing - - --- Examples in the instructions - --- (\x1 -> x1 x2) -ex6'1 = LamDef [] (LamAbs 1 (LamApp (LamVar 1) (LamVar 2))) - --- def F = \x1 -> x1 in F -ex6'2 = LamDef [ ("F",exId) ] (LamMacro "F") - --- (\x1 -> x1) (\x2 -> x2) -ex6'3 = LamDef [] ( LamApp exId (LamAbs 2 (LamVar 2))) - --- (\x1 -> x1 x1)(\x1 -> x1 x1) -wExp = (LamAbs 1 (LamApp (LamVar 1) (LamVar 1))) -ex6'4 = LamDef [] (LamApp wExp wExp) - --- def ID = \x1 -> x1 in def FST = (\x1 -> λx2 -> x1) in FST x3 (ID x4) -ex6'5 = LamDef [ ("ID",exId) , ("FST",LamAbs 1 (LamAbs 2 (LamVar 1))) ] ( LamApp (LamApp (LamMacro "FST") (LamVar 3)) (LamApp (LamMacro "ID") (LamVar 4))) - --- def FST = (\x1 -> λx2 -> x1) in FST x3 ((\x1 ->x1) x4)) -ex6'6 = LamDef [ ("FST", LamAbs 1 (LamAbs 2 (LamVar 1)) ) ] ( LamApp (LamApp (LamMacro "FST") (LamVar 3)) (LamApp (exId) (LamVar 4))) - --- def ID = \x1 -> x1 in def SND = (\x1 -> λx2 -> x2) in SND ((\x1 -> x1 x1 ) (\x1 -> x1 x1)) ID -ex6'7 = LamDef [ ("ID",exId) , ("SND",LamAbs 1 (LamAbs 2 (LamVar 2))) ] (LamApp (LamApp (LamMacro "SND") (LamApp wExp wExp) ) (LamMacro "ID") ) - + evals :: [Maybe LamMacroExpr] + evals = iterate (>>=ssev) $ Just e \ No newline at end of file -- GitLab