From 1166ca9a0fb0a9aae7a22ae56cd65a47e5dd17c7 Mon Sep 17 00:00:00 2001
From: ik1g19 <ik1g19@soton.ac.uk>
Date: Fri, 8 Jan 2021 19:51:09 +0000
Subject: [PATCH] finished challenge 4

---
 cw/src/Challenges.hs | 332 +++++++++++++++++--------------------------
 1 file changed, 134 insertions(+), 198 deletions(-)

diff --git a/cw/src/Challenges.hs b/cw/src/Challenges.hs
index 295d931..f5ff8e1 100644
--- a/cw/src/Challenges.hs
+++ b/cw/src/Challenges.hs
@@ -7,7 +7,7 @@
 -- DO NOT MODIFY THE FOLLOWING LINES OF CODE
 module Challenges (WordSearchGrid,Placement,Posn,Orientation(..),solveWordSearch, createWordSearch,
     LamMacroExpr(..),LamExpr(..),prettyPrint, parseLamMacro,
-    cpsTransform,innerRedn1,outerRedn1,compareInnerOuter) where
+    cpsTransform,innerRedn1,outerRedn1,compareInnerOuter,unique,macroName,closedParse,expr) 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
@@ -22,23 +22,26 @@ import System.Random
 
 import Control.Applicative
 
+instance NFData Orientation
+instance NFData LamMacroExpr
+instance NFData LamExpr
 
 -- types for Part I
 type WordSearchGrid = [[ Char ]]
 type Placement = (Posn,Orientation)
 type Posn = (Int,Int)
-data Orientation = Forward | Back | Up | Down | UpForward | UpBack | DownForward | DownBack deriving (Eq,Ord,Show,Read)
+data Orientation = Forward | Back | Up | Down | UpForward | UpBack | DownForward | DownBack deriving (Eq,Ord,Show,Read,Generic)
 
 -- types for Parts II and III
-data LamMacroExpr = LamDef [ (String,LamExpr) ] LamExpr deriving (Eq,Show,Read)
+data LamMacroExpr = LamDef [ (String,LamExpr) ] LamExpr deriving (Eq,Show,Read,Generic)
 data LamExpr = LamMacro String | LamApp LamExpr LamExpr  |
-               LamAbs Int LamExpr  | LamVar Int deriving (Eq,Show,Read)
+               LamAbs Int LamExpr  | LamVar Int deriving (Eq,Show,Read,Generic)
 
 -- END OF CODE YOU MUST NOT MODIFY
 
 -- ADD YOUR OWN CODE HERE
 
--- Challenge 1 --
+------------------------------------------Challenge 1-------------------------------------------------          -- | inline comments
 
 
 solveWordSearch :: [ String ] -> WordSearchGrid -> [ (String,Maybe Placement) ]
@@ -49,8 +52,8 @@ findString :: WordSearchGrid -> String -> (String,Maybe Placement)
 findString css s = (s,findLocation css (0,0) s)
 
 
---recursively searches grid for first char of word
---returns Nothing or Placement
+{--| recursively searches grid for first char of word |--
+ --| returns Nothing or Placement                     |--}
 findLocation :: WordSearchGrid -> Posn -> String -> Maybe Placement
 findLocation css (x,y) s@(l:ls) | x > limit && y > limit                     = Nothing
                                 | x > limit                                  = findLocation css (0,y+1) s
@@ -61,7 +64,7 @@ findLocation css (x,y) s@(l:ls) | x > limit && y > limit                     = N
       limit = length css - 1
 
 
---checks for hidden word in possible directions
+{--| checks for hidden word in possible directions    |--}
 findPlacement :: WordSearchGrid -> Posn -> String -> Maybe Placement
 findPlacement css (x,y) s | checkWordDir css (x,y) Forward s           = Just ((x,y),Forward)
                           | checkWordDir css (x,y) Back s              = Just ((x,y),Back)
@@ -81,10 +84,10 @@ checkWordDir css (x,y) dir (l:ls) | nextElem css (x,y) dir == Just l   = checkWo
                                   | otherwise                          = False
 
 
-
 --------------------pattern matching for traversing the grid--------------------
 
---returns position of movement in a given direction
+
+{--| returns position of movement in a given direction |--}
 nextPos :: Orientation -> Posn -> Posn
 nextPos Forward     (x,y) = (x+1,y)
 nextPos Back        (x,y) = (x-1,y)
@@ -97,80 +100,56 @@ nextPos DownBack    (x,y) = (x-1,y+1)
 
 
 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                                                                              -- | ass means list of list of a's,
+                                                                                                                -- | not associated with any other meaning
 
---returns specified adjacent element in grid, relative to given position 
+{--| returns specified adjacent element in grid,      |--
+ --| relative to given position                       |--}
 nextElem :: [[a]] -> Posn -> Orientation -> Maybe a
-nextElem css (x,y) dir | x' < 0 || y' < 0 ||
-                         x' > length css - 1 || y' > length css - 1 = Nothing
-                       | otherwise                                  = Just (elemAt css (x',y'))
+nextElem css (x,y) dir | x' < 0   || y' < 0  ||
+                         x' > length css - 1 ||
+                         y' > length css - 1    = Nothing
+                       | otherwise              = Just (elemAt css (x',y'))
     where
       (x',y') = nextPos dir (x,y)
 
 
--- Two examples for you to try out, the first of which is in the instructions
-
-exGrid1'1 = ["HAGNIRTSH" , "SACAGETAK", "GCSTACKEL",
-             "MGHKMILKI",  "EKNLETGCN", "TNIRTLETE",
-             "IRAAHCLSR",  "MAMROSAGD", "GIZKDDNRG"]
-
-exWords1'1 = [ "HASKELL","STRING","STACK","MAIN","METHOD"]
-
-exGrid1'2 = ["ROBREUMBR","AURPEPSAN","UNLALMSEE",
-             "YGAUNPYYP","NLMNBGENA","NBLEALEOR",
-             "ALRYPBBLG","NREPBEBEP","YGAYAROMR"]
-
-exWords1'2 = [ "BANANA", "ORANGE", "MELON", "RASPBERRY",
-               "APPLE",  "PLUM",   "GRAPE" ]
-
-
--- Challenge 2 --
+------------------------------------------Challenge 2-------------------------------------------------
 
 
---internal grid values are either a character or a placeholder for a random letter
+{--| internal grid values are either a character
+ --| or a placeholder for a random letter             |--}
 data GridVal  = Letter Char | Rand deriving Eq
 type RandGrid = [[GridVal]]
 
 
 createWordSearch :: [ String ] -> Double -> IO WordSearchGrid
-createWordSearch ss den = do gen <- newStdGen                                                                   --initial generator
+createWordSearch ss den = do gen <- newStdGen                                                                   -- | initial generator
                              return (createGrid dim gen ss)
     where
       charInInput    = fromIntegral $ sum $ map length ss :: Double
       longestWordLen = fromIntegral $ foldl1 max $ map length ss :: Double
-      dim            = floor $ head [x | x <- [0..], x^2 > (charInInput / den), x >= longestWordLen]            --calculates needed dimension of grid according to the density
+      dim            = floor $ head [x | x <- [0..], x^2 > (charInInput / den), x >= longestWordLen]            -- | calculates needed dimension of grid according to the density
 
 
 createGrid :: Int -> StdGen -> [String] -> WordSearchGrid
 createGrid dim gen ss = randToWord (charsFromStrs ss) gen' finalGrid
     where
-      tempGrid         = replicate dim (replicate dim Rand)                                                     --fills grid with random values
-      (finalGrid,gen') = addStrsToGrid tempGrid gen ss                                                          --final grid after all strings added
+      tempGrid         = replicate dim (replicate dim Rand)                                                     -- | fills grid with random values
+      (finalGrid,gen') = addStrsToGrid tempGrid gen ss                                                          -- | final grid after all strings added
 
-      charsFromStrs = rmdups . concat                                                                           --list of chars used in given strings
+      charsFromStrs = rmdups . concat                                                                           -- | list of chars used in given strings
 
---removes duplicates from a list
---code from https://stackoverflow.com/a/16109302/10218833
-rmdups :: (Ord a) => [a] -> [a]
-rmdups = map head . group . sort
 
+----------------------------Primary Functions-----------------------------------
 
--- --converts RandGrid to WordSearchGrid
--- --replaces placeholder random values with actual random values
--- randToWord :: RandGrid -> [Char] -> StdGen -> WordSearchGrid
--- randToWord rg cs gen =
---     where
---       charStream :: [Char]
---       charStream = map (cs!!) $ randomRs (0,length cs - 1) g
-
---       replaceRands = map (\Rand -> head charStream)
 
 randToWord :: [Char] -> StdGen -> RandGrid -> WordSearchGrid
 randToWord cs gen []       = []
 randToWord cs gen (row:rs) = let (newRow,newGen) = rowConvert cs gen row
                              in newRow : randToWord cs newGen rs
 
+
 rowConvert :: [Char] -> StdGen -> [GridVal] -> ([Char],StdGen)
 rowConvert cs gen []            = ([],gen)
 rowConvert cs gen (Letter x:xs) = let (rows,gen') = rowConvert cs gen xs
@@ -182,7 +161,7 @@ rowConvert cs gen (Rand:xs)     = let (rows,gen') = rowConvert cs newGen xs
       randChar = cs !! index
 
 
---adds list of strings to given grid one by one
+{--| adds list of strings to given grid one by one    |--}
 addStrsToGrid :: RandGrid -> StdGen -> [String] -> (RandGrid,StdGen)
 addStrsToGrid rg gen (s:[]) = insertString rg s gen
 addStrsToGrid rg gen (s:ss) = addStrsToGrid newGrid newGen ss
@@ -190,14 +169,22 @@ addStrsToGrid rg gen (s:ss) = addStrsToGrid newGrid newGen ss
      (newGrid,newGen) = insertString rg s gen
 
 
---takes a grid, string and a position
---returns a list of valid orientations for the string at that position
+{--| takes a grid, string and a position              |--
+ --| returns a list of valid orientations for the     |--
+ --| string at that position                          |--}
 validDirs :: RandGrid -> String -> Posn -> [Orientation]
-validDirs rg s (x,y) = map fst $ filter ( \(_,b) -> b == True ) (zip dirs (map ( checkDir rg s (x,y) ) dirs) )
+validDirs rg s (x,y) = map fst $ filter (\b -> snd b == True) (zipF ( checkDir rg s (x,y) ) dirs)
     where dirs = [Forward,Back,Up,Down,UpForward,UpBack,DownForward,DownBack]
 
 
---checks whether an orientation for a string at a given position in a grid is valid
+{--| applies given func to list and zips result with  |--
+ --| original list                                    |--}
+zipF :: (a -> b) -> [a] -> [(a,b)]
+zipF f xs = zip xs $ map f xs
+
+
+{--| checks whether an orientation for a string at a
+ --| given position in a grid is valid                |--}
 checkDir :: RandGrid -> String -> Posn -> Orientation -> Bool
 checkDir rg s (x,y) dir | let (x',y') = posns !! (length s - 1),
                           x' < 0 || x' > length rg - 1 ||
@@ -209,12 +196,12 @@ checkDir rg s (x,y) dir | let (x',y') = posns !! (length s - 1),
       lettersGrid = take (length s) $ map (elemAt rg) posns
 
 
---adds an individual string to a given grid
---returns new grid and new generator
+{--| adds an individual string to a given grid        |--
+ --| returns new grid and new generator               |--}
 insertString :: RandGrid -> String -> StdGen -> (RandGrid,StdGen)
 insertString rg s gen | elemAt rg (x,y) /= Rand &&
-                        elemAt rg (x,y) /= Letter (head s) = insertString rg s newGen                           --guard:if position is invalid, generate new position
-                      | length vDirs == 0                  = insertString rg s newGen                           --guard:if no valid orientations exist, generate new position
+                        elemAt rg (x,y) /= Letter (head s) = insertString rg s newGen                           -- | guard:if position is invalid, generate new position
+                      | length vDirs == 0                  = insertString rg s newGen                           -- | guard:if no valid orientations exist, generate new position
                       | otherwise                          = (addToGrid randomDir s rg (x,y),newGen)
     where
       ( (x,y),newGen ) = generatePos gen (length rg)
@@ -228,21 +215,6 @@ insertString rg s gen | elemAt rg (x,y) /= Rand &&
           where
             charAdded :: RandGrid
             charAdded = insertAt2D (Letter c) (x',y') rg
-      --addToGrid dir = map (\(c,(m,n)) -> insertAt2D (Letter c) (m,n) rg) (zip s (take (length s) $ iterate (nextPos dir) (x,y)))
-
-
---inserts element at location in 2d array
-insertAt2D :: a -> (Int,Int) -> [[a]] -> [[a]]
-insertAt2D newElement (x,y) grid | y == 0               = insertAt newElement x (grid !! y) : drop 1 belowRows
-                                 | y == length grid - 1 = aboveRows ++ [insertAt newElement x (grid !! y)]
-                                 | otherwise            = aboveRows ++ [insertAt newElement x (grid !! y)] ++ drop 1 belowRows
-    where
-      (aboveRows,belowRows) = splitAt y grid
-
---using code from https://stackoverflow.com/a/43291593/10218833
-insertAt :: a -> Int -> [a] -> [a]
-insertAt newElement 0 as = newElement : drop 1 as
-insertAt newElement i (a:as) = a : insertAt newElement (i - 1) as
 
 
 generatePos :: StdGen -> Int -> (Posn,StdGen)
@@ -251,84 +223,81 @@ generatePos gen dim = let (x,gen')  = randomR (0,dim - 1) gen  :: (Int,StdGen)
                       in  ((x,y),gen'')
 
 
+----------------------------Utility Functions-----------------------------------
 
---- Convenience functions supplied for testing purposes
-createAndSolve :: [ String ] -> Double -> IO [ (String, Maybe Placement) ]
-createAndSolve words maxDensity =   do g <- createWordSearch words maxDensity
-                                       let soln = solveWordSearch words g
-                                       printGrid g
-                                       return soln
 
-printGrid :: WordSearchGrid -> IO ()
-printGrid [] = return ()
-printGrid (w:ws) = do putStrLn w
-                      printGrid ws
+{--| removes duplicates from a list                          |--
+ --| code from https://stackoverflow.com/a/16109302/10218833 |--}
+rmdups :: (Ord a) => [a] -> [a]
+rmdups = map head . group . sort
 
 
--- Challenge 3 --
+{--| inserts element at location in 2d array          |--}
+insertAt2D :: a -> (Int,Int) -> [[a]] -> [[a]]
+insertAt2D newElement (x,y) grid | y == 0               = insertAt newElement x (grid !! y) : drop 1 belowRows
+                                 | y == length grid - 1 = aboveRows ++ [insertAt newElement x (grid !! y)]
+                                 | otherwise            = aboveRows ++ [insertAt newElement x (grid !! y)] ++ drop 1 belowRows
+    where
+      (aboveRows,belowRows) = splitAt y grid
 
 
--- data LamMacroExpr = LamDef [ (String,LamExpr) ] LamExpr deriving (Eq,Show,Read)
--- data LamExpr = LamMacro String | LamApp LamExpr LamExpr  |
---                LamAbs Int LamExpr  | LamVar Int deriving (Eq,Show,Read)
+{--| inserts element at given index of list                        |--
+ --| using code from https://stackoverflow.com/a/43291593/10218833 |--}
+insertAt :: a -> Int -> [a] -> [a]
+insertAt newElement 0 as = newElement : drop 1 as
+insertAt newElement i (a:as) = a : insertAt newElement (i - 1) as
 
-prettyPrint :: LamMacroExpr -> String
-prettyPrint (LamDef ms e) = exprBrackets e
 
+------------------------------------------Challenge 3-------------------------------------------------
 
---applies brackets to expr if needed
-exprBrackets :: LamExpr -> String
-exprBrackets e | foldl1 (||) $ map (e==) parsed   = str                                                         --omit brackets
-               | otherwise                        = "(" ++ str ++ ")"                                           --include brackets
-    where
-      str = exprToStr e
-      parsed = map fst (parse expr str)                                                                         --possible parsings of str
 
+{--| Repeated for Clarity:                                                           |--
+ --|                                                                                 |--
+ --| data LamMacroExpr = LamDef [ (String,LamExpr) ] LamExpr deriving (Eq,Show,Read) |--
+ --| data LamExpr = LamMacro String | LamApp LamExpr LamExpr  |                      |--
+ --|                LamAbs Int LamExpr  | LamVar Int deriving (Eq,Show,Read)         |--}
+
+prettyPrint :: LamMacroExpr -> String
+prettyPrint (LamDef ms e) = macroDef ms ++ exprToStr ms e
 
---converts expr to string
-exprToStr :: LamExpr -> String
-exprToStr (LamApp e1 e2) = exprBrackets e1 ++ " " ++ exprBrackets e2
-exprToStr (LamAbs x e)   = "\\x" ++ show x ++ " -> " ++ exprBrackets e
-exprToStr (LamVar x)     = "x" ++ show x
-exprToStr (LamMacro m)   = m
 
+macroDef :: [(String,LamExpr)] -> String
+macroDef [] = ""
+macroDef ( (name,expr):ms ) = foldl1 (++) ["def ",name," = ",exprToStr [] expr," in ",macroDef ms]
 
 
--- examples in the instructions
-ex3'1 = LamDef [] (LamApp (LamAbs 1 (LamVar 1)) (LamAbs 1 (LamVar 1)))                                          --"(\x1 -> x1) \x1 -> x1"
-ex3'2 = LamDef [] (LamAbs 1 (LamApp (LamVar 1) (LamAbs 1 (LamVar 1))))                                          --"\x1 -> x1 \x1 -> x1" 
-ex3'3 = LamDef [ ("F", LamAbs 1 (LamVar 1) ) ] (LamAbs 2 (LamApp (LamVar 2) (LamMacro "F")))                    --"def F = \x1-> x1 in \x2 -> x2 F"
-ex3'4 = LamDef [ ("F", LamAbs 1 (LamVar 1) ) ] (LamAbs 2 (LamApp (LamAbs 1 (LamVar 1)) (LamVar 2)))             --"def F = \x1-> x1 in \x2-> F x2"
+{--| replaces a macro with its definition             |--}
+catchMacro :: [(String,LamExpr)] -> LamExpr -> String
+catchMacro ms e | macros == [] = exprToStr ms e
+                | otherwise    = fst $ head macros
+    where
+      macros = filter ( (e==) . snd ) ms
 
 
--- Challenge 4 --
+exprToStr :: [(String,LamExpr)] -> LamExpr -> String
 
+exprToStr ms (LamApp e1@(LamVar _) e2) = catchMacro ms e1 ++ " " ++ catchMacro ms e2
 
--- data LamMacroExpr = LamDef [ (String,LamExpr) ] LamExpr deriving (Eq,Show,Read)
--- data LamExpr = LamMacro String | LamApp LamExpr LamExpr  |
---                LamAbs Int LamExpr  | LamVar Int deriving (Eq,Show,Read)
+exprToStr ms (LamApp e1 e2) | catchMacro ms e1 == exprToStr ms e1 = foldl1 (++) ["(",exprToStr ms e1,") ",catchMacro ms e2]
+                            | otherwise                           = catchMacro ms e1 ++ " " ++ catchMacro ms e2
 
+exprToStr ms (LamAbs   x  e ) = "\\x" ++ show x ++ " -> " ++ catchMacro ms e
+exprToStr ms (LamVar   x    ) = "x"   ++ show x
+exprToStr ms (LamMacro m    ) = m
 
---MacroExpr ::= "def" MacroName "=" Expr "in" MacroExpr | Expr
---Expr ::=  Var | MacroName | Expr Expr | “\” Var “->” Expr | “(“ Expr “)”
---MacroName ::= UChar | UChar MacroName
---UChar ::= "A" | "B" | ... | "Z"
---Var ::= “x” Digits
---Digits ::= Digit | Digit Digits
---Digit ::= “0” | “1” | “2” | “3” | “4” | “5” | “6” | “7” | “8” | “9”
 
+------------------------------------------Challenge 4-------------------------------------------------
 
---MacroExpr ::= "def" MacroName "=" Expr "in" MacroExpr | Expr
---Expr ::=  Var | MacroName | Applicative | Function | Expression
---MacroName ::= UChar | UChar MacroName
---UChar ::= "A" | "B" | ... | "Z"
---Var ::= “x” Digits
---Digits ::= Digit | Digit Digits
---Digit ::= “0” | “1” | “2” | “3” | “4” | “5” | “6” | “7” | “8” | “9”
 
---Applicative ::= Expr Expr
---Function ::= “\” Var “->” Expr
---Expression ::= “(“ Expr “)”
+{--| Corresponding Grammar:                                                   |--
+ --|                                                                          |--
+ --| MacroExpr ::= "def" MacroName "=" Expr "in" MacroExpr | Expr             |--
+ --| Expr ::=  Var | MacroName | Expr Expr | “\” Var “->” Expr | “(“ Expr “)” |--
+ --| MacroName ::= UChar | UChar MacroName                                    |--
+ --| UChar ::= "A" | "B" | ... | "Z"                                          |--
+ --| Var ::= “x” Digits                                                       |--
+ --| Digits ::= Digit | Digit Digits                                          |--
+ --| Digit ::= “0” | “1” | “2” | “3” | “4” | “5” | “6” | “7” | “8” | “9”      |--}
 
 
 parseLamMacro :: String -> Maybe LamMacroExpr
@@ -336,14 +305,13 @@ parseLamMacro str | parsed == [] = Nothing
                   | otherwise    = Just $ fstHead parsed
     where
       parsed = parse (macroExpr []) str
-      fstHead = fst . head
 
 
 macroExpr :: [ (String,LamExpr) ] -> Parser LamMacroExpr
 macroExpr ms = do string "def"
-                  name  <- token macroName
+                  name  <-  unique (map fst ms) (token macroName)
                   symbol "="
-                  e     <- token expr
+                  e     <- closedParse expr
                   token $ string "in"
                   macros <- macroExpr $ ms ++ [(name,e)]
                   return $ macros
@@ -352,6 +320,34 @@ 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 free e then empty else return e
+
+{--| finds if an expression contains free variables   |--
+ --|                                                  |--}
+free :: LamExpr -> Bool
+free (LamVar _)     = True
+free (LamAbs x  e ) = freeVar x e
+free (LamApp e1 e2) = free e1 && free e2
+
+{--| finds if a given variable is free in an expr     |--
+ --|                                                  |--}
+freeVar :: Int -> LamExpr -> Bool
+freeVar x (LamVar y)                 = not $ 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)
           return $ foldl1 LamApp terms
@@ -369,30 +365,9 @@ term = do char '('
           e     <- expr
           return $ LamAbs x e
 
-   <|> do {x    <- var;      return $ LamVar x}
-
-   <|> do {name <- macroName;return $ LamMacro name}
-
--- expr :: Parser LamExpr
--- expr = do e1    <- expr
---           space
---           e2    <- expr
---           return $ LamApp e1 e2
+   <|> do {x <- var; return $ LamVar x}
 
---    <|> do {x    <- var;      return $ LamVar x}
-
---    <|> do {name <- macroName;return $ LamMacro name}
-
---    <|> do char '\\'
---           x     <- var
---           symbol "->"
---           e     <- expr
---           return $ LamAbs x e
-
---    <|> do char '('
---           e     <- token expr
---           char ')'
---           return e
+   <|> do {name <- macroName; return $ LamMacro name}
 
 
 macroName :: Parser String
@@ -406,47 +381,8 @@ var = do char 'x'
          return x
 
 
-
--- examples in the instructions
---Just (LamDef [] (LamApp (LamVar 1) (LamApp (LamVar 2) (LamVar 3))))                                           --"x1 (x2 x3)"
---Just (LamDef [] (LamApp (LamApp (LamVar 1) (LamVar 2)) (LamMacro"F")))                                        --"x1 x2 F"
---Just (LamDef  [  ("F",  LamAbs  1  (LamVar  1)  )  ] (LamAbs  2  (LamApp  (LamVar  2)  (LamMacro "F"))))      --"def F = \x1-> x1 in \x2 -> x2 F"
---Nothing  -not in grammar                                                                                      --"def F = \x1 -> x1 (def G = \x1 -> x1 in x1)in \x2 -> x2"
---Nothing  -repeated macro definition                                                                           --"def F = \x1 -> x1 in def F = \x2 -> x2 x1 in x1"
---Nothing  -macro body not closed                                                                               --"def F = x1 in F"
-
-
---arithmetic expression examples
-
--- expr  ::= term '+' expr ⏐ term
--- term  ::= factor '*' term ⏐ factor
--- factor ::= nat ⏐ '(' expr ')‘
--- nat ::= digit | digit nat
--- digit ::= ’0’ ⏐ '1' ⏐ ... ⏐ '9'
-
--- expr :: Parser AETree
--- expr  = do t ← term
---            char ‘+’
---            e ← expr
---            return (Add t  e)
---         <|> term
-
--- term :: Parser AETree
--- term  = do f ← factor
---            char ‘*’
---            t ← term
---            return (Mul f t)
---         <|> factor
-
--- factor :: Parser AETree
--- factor  = nat <|> do char '('
---                      e ← expr
---                      char ')'
---                      return e
-
--- nat :: Parser AETree
--- nat = do ds ← some digit
---          return (Lit (read  ds))
+fstHead :: [(a,b)] -> a
+fstHead = fst . head
 
 
 -- Challenge 5
-- 
GitLab