From 54bcc4595f28ba76384b5f018d72bca353cd88d3 Mon Sep 17 00:00:00 2001 From: tzlil Date: Sat, 15 Apr 2023 01:54:47 +0300 Subject: fourmolu formatting --- Setup.hs | 1 + flake.nix | 3 +++ lambda.cabal | 44 +++++++++++++++++++++++++------------------- plc/Main.hs | 4 ++-- src/AST.hs | 17 ++++++----------- src/HW.hs | 55 ++++++++++++++++++++++++++++++------------------------- src/Parse.hs | 55 +++++++++++++++++++++++++++++-------------------------- 7 files changed, 96 insertions(+), 83 deletions(-) diff --git a/Setup.hs b/Setup.hs index 9a994af..e8ef27d 100644 --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/flake.nix b/flake.nix index 57945c8..f513119 100644 --- a/flake.nix +++ b/flake.nix @@ -28,6 +28,9 @@ projectRootFile = "flake.nix"; programs.nixpkgs-fmt.enable = true; programs.cabal-fmt.enable = true; + programs.ormolu.enable = true; + programs.hlint.enable = true; + programs.ormolu.package = pkgs.haskellPackages.fourmolu; }; }; }; diff --git a/lambda.cabal b/lambda.cabal index 6189111..aee89e6 100644 --- a/lambda.cabal +++ b/lambda.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- @@ -11,33 +11,39 @@ maintainer: sedwards@cs.columbia.edu copyright: 2023 John Hui and Stephen Edwards license: BSD3 build-type: Simple -extra-source-files: - README.md +extra-source-files: README.md library exposed-modules: - AST - HW - Parse - other-modules: - Paths_lambda - hs-source-dirs: - src - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + AST + HW + Parse + + other-modules: Paths_lambda + hs-source-dirs: src + ghc-options: + -Wall -Wcompat -Widentities -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wmissing-export-lists + -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + build-depends: - base >=4.7 && <5 + base >=4.7 && <5 , containers , megaparsec + default-language: Haskell2010 executable plc - main-is: Main.hs - other-modules: - Paths_lambda - hs-source-dirs: - plc - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + main-is: Main.hs + other-modules: Paths_lambda + hs-source-dirs: plc + ghc-options: + -Wall -Wcompat -Widentities -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wmissing-export-lists + -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + build-depends: - base >=4.7 && <5 + base >=4.7 && <5 , lambda + default-language: Haskell2010 diff --git a/plc/Main.hs b/plc/Main.hs index 9e8a7b8..a91563e 100644 --- a/plc/Main.hs +++ b/plc/Main.hs @@ -4,5 +4,5 @@ import Parse main :: IO () main = do - s <- getContents - print $ parse s + s <- getContents + print $ parse s 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) "" +tryParse = + first errorBundlePretty + . runParser (pSpace >> pExpr <* eof) "" {- * 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 "{-" "-}") -- cgit 1.4.1