about summary refs log tree commit diff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/AST.hs17
-rw-r--r--src/HW.hs55
-rw-r--r--src/Parse.hs55
3 files changed, 65 insertions, 62 deletions
diff --git a/src/AST.hs b/src/AST.hs
index 456338e..6f21d9e 100644
--- a/src/AST.hs
+++ b/src/AST.hs
@@ -1,28 +1,23 @@
 -- | Abstract syntax tree for the untyped lambda calculus, plus some helpers.
 module AST (
-  Expr (..)
+    Expr (..),
 ) where
 
 -- | Lambda Expressions
 data Expr
-  = Var String
-  | Lam String Expr
-  | App Expr Expr
-  deriving (Eq, Ord)
-
+    = Var String
+    | Lam String Expr
+    | App Expr Expr
+    deriving (Eq, Ord)
 
 -- https://www.haskellforall.com/2020/11/pretty-print-syntax-trees-with-this-one.html
 showLam, showApp, showVar :: Expr -> String
 showLam (Lam i e) = "\\" ++ i ++ " . " ++ showLam e
 showLam e = showApp e
-
 showApp (App e1 e2) = showApp e1 ++ " " ++ showVar e2
 showApp e = showVar e
-
 showVar (Var i) = i
 showVar e = "(" ++ showLam e ++ ")"
 
 instance Show Expr where
-  show e = showLam e
-
-
+    show e = showLam e
diff --git a/src/HW.hs b/src/HW.hs
index ee26584..7e4e579 100644
--- a/src/HW.hs
+++ b/src/HW.hs
@@ -1,11 +1,11 @@
-module HW
-  ( fv
-  , subst
-  , normalstep
-  , pickFresh
-  , repeatedly 
-  , printnormal
-  ) where
+module HW (
+    fv,
+    subst,
+    normalstep,
+    pickFresh,
+    repeatedly,
+    printnormal,
+) where
 
 import AST
 import qualified Data.Set as Set
@@ -17,33 +17,38 @@ fv (Var x) = Set.singleton x
 fv (Lam x m) = x `Set.delete` (fv m)
 fv (App m1 m2) = (fv m1) `Set.union` (fv m2)
 
--- | Substitute n for x in e, avoiding name capture
---    subst n x e     e[x := n]
+{- | Substitute n for x in e, avoiding name capture
+    subst n x e     e[x := n]
+-}
 subst :: Expr -> String -> Expr -> Expr
-subst _ _ _ = Var "UNIMPLEMENTED" -- Replace with your solution to problem 2
-
-
+-- subst _ _ _ = Var "UNIMPLEMENTED" -- Replace with your solution to problem 2
+subst n x (Var e)
+    | x == e = n
+    | otherwise = Var e
 
 -- | Take a single step in normal order reduction or return Nothing
 normalstep :: Expr -> Maybe Expr
 normalstep _ = Just (Var "UNIMPLEMENTED") -- Replace with your solution to problem 3
 
-
-
-
--- | Return a "fresh" name not already in the set.
--- Tries x' then x'', etc.
+{- | Return a "fresh" name not already in the set.
+ Tries x' then x'', etc.
+-}
 pickFresh :: Set.Set String -> String -> String
 pickFresh s = pickFresh'
-  where pickFresh' n | n `Set.notMember` s = n
-        pickFresh' n                       = pickFresh' $ n ++ "'"
-               
--- | Repeatedly apply a function to transform a value, returning the list
--- of steps it took.  The result list starts with the given initial value
+  where
+    pickFresh' n | n `Set.notMember` s = n
+    pickFresh' n = pickFresh' $ n ++ "'"
+
+{- | Repeatedly apply a function to transform a value, returning the list
+ of steps it took.  The result list starts with the given initial value
+-}
 repeatedly :: (a -> Maybe a) -> a -> [a]
 repeatedly f = repeatedly'
-  where repeatedly' x = x : case f x of Nothing -> []
-                                        Just y -> repeatedly' y
+  where
+    repeatedly' x =
+        x : case f x of
+            Nothing -> []
+            Just y -> repeatedly' y
 
 -- | Print out the series of normal order reduction steps
 printnormal :: String -> IO ()
diff --git a/src/Parse.hs b/src/Parse.hs
index 748bd98..c06b20a 100644
--- a/src/Parse.hs
+++ b/src/Parse.hs
@@ -7,17 +7,17 @@ module Parse (parse, tryParse) where
 import qualified AST as A
 
 import Text.Megaparsec (
-  MonadParsec (..),
-  Parsec,
-  errorBundlePretty,
-  noneOf,
-  runParser,
-  some,
-  (<?>),
-  (<|>),
-  between
+    MonadParsec (..),
+    Parsec,
+    between,
+    errorBundlePretty,
+    noneOf,
+    runParser,
+    some,
+    (<?>),
+    (<|>),
  )
-import Text.Megaparsec.Char( space1 )
+import Text.Megaparsec.Char (space1)
 import qualified Text.Megaparsec.Char.Lexer as L
 
 import Control.Monad (void)
@@ -32,8 +32,9 @@ parse = either error id . tryParse
 
 -- | Parse some code 'String' into an 'L.Expr' or an error message.
 tryParse :: String -> Either String A.Expr
-tryParse = first errorBundlePretty .
-           runParser (pSpace >> pExpr <* eof) "<input>"
+tryParse =
+    first errorBundlePretty
+        . runParser (pSpace >> pExpr <* eof) "<input>"
 
 {- * Expression parser
 
@@ -48,13 +49,13 @@ pExpr = pBody <?> "expression"
 -- | Parse expressions at the lowest level of precedence, i.e., lambdas.
 pBody :: Parser A.Expr
 pBody = pLam <|> pApp
- where
-  pLam = do
-    pToken "\\"
-    bs <- some pIdent <?> "lambda binders"
-    pToken "."
-    body <- pBody <?> "lambda body"
-    return $ foldr A.Lam body bs
+  where
+    pLam = do
+        pToken "\\"
+        bs <- some pIdent <?> "lambda binders"
+        pToken "."
+        body <- pBody <?> "lambda body"
+        return $ foldr A.Lam body bs
 
 -- | Parse juxtaposition as application.
 pApp :: Parser A.Expr
@@ -63,8 +64,8 @@ pApp = foldl1 A.App <$> some pAtom <?> "term application"
 -- | Parse expressions at the highest precedence, including parenthesized terms
 pAtom :: Parser A.Expr
 pAtom = A.Var <$> pVar <|> pParens pExpr
- where
-  pVar = pIdent <?> "variable"
+  where
+    pVar = pIdent <?> "variable"
 
 -- * Megaparsec boilerplate and helpers
 
@@ -73,7 +74,7 @@ type Parser = Parsec Void String
 
 -- | Parse an identifier, possible surrounded by spaces
 pIdent :: Parser String
-pIdent = L.lexeme pSpace (some $ noneOf ['\\','.','(',')',' ','\n','\r','\t','-'])
+pIdent = L.lexeme pSpace (some $ noneOf ['\\', '.', '(', ')', ' ', '\n', '\r', '\t', '-'])
 
 -- | Consume a token defined by a string, possibly surrounded by spaces
 pToken :: String -> Parser ()
@@ -85,7 +86,9 @@ pParens = between (pToken "(") (pToken ")")
 
 -- | Consumes whitespace and comments.
 pSpace :: Parser ()
-pSpace = label "whitespace" $ L.space
-    space1
-    (L.skipLineComment "--")
-    (L.skipBlockCommentNested "{-" "-}")
+pSpace =
+    label "whitespace" $
+        L.space
+            space1
+            (L.skipLineComment "--")
+            (L.skipBlockCommentNested "{-" "-}")