formatted for submission, fuck challenge 6

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
+      evals :: [Maybe LamMacroExpr]
+      evals = iterate (>>=ssev) $ Just e
\ No newline at end of file
-
-      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") ) 
-