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