greatly improved pretty printer

This commit is contained in:
William Ball 2024-11-11 14:34:55 -08:00
parent acb3fe9d6c
commit e9e388ba05
2 changed files with 26 additions and 15 deletions

View file

@ -23,18 +23,28 @@ occursFree n (Pi _ a b) = occursFree n a || occursFree (n + 1) b
{- --------------------- PRETTY PRINTING ----------------------------- -} {- --------------------- PRETTY PRINTING ----------------------------- -}
-- TODO : store parsed identifiers for better printing parenthesize :: String -> String
parenthesize s = "(" ++ s ++ ")"
helper :: Integer -> Expr -> String
helper _ (Var _ s) = s
helper _ Star = "*"
helper _ Square = ""
helper k (App e1 e2) = if k >= 3 then parenthesize res else res
where
res = helper 3 e1 ++ " " ++ helper 4 e2
helper k (Pi x ty b) = if k >= 2 then parenthesize res else res
where
res =
if occursFree 0 b
then "" ++ x ++ " : " ++ helper 0 ty ++ " . " ++ helper 0 b
else helper 3 ty ++ " -> " ++ helper 2 b
helper k (Abs x ty b) = if k >= 1 then parenthesize res else res
where
res = "λ" ++ x ++ " : " ++ helper 0 ty ++ " . " ++ helper 0 b
pretty :: Expr -> String pretty :: Expr -> String
pretty (Var _ s) = s pretty = helper 0
pretty Star = "*"
pretty Square = ""
pretty (App e1 e2) = "(" ++ pretty e1 ++ " " ++ pretty e2 ++ ")"
pretty (Abs x ty b) = "" ++ x ++ " : " ++ pretty ty ++ " . " ++ pretty b ++ ")"
pretty (Pi x ty b) =
if occursFree 0 b then
"(∏" ++ x ++ " : " ++ pretty ty ++ " . " ++ pretty b ++ ")"
else
"(" ++ pretty ty ++ " -> " ++ pretty b ++ ")"
{- --------------- ACTUAL MATH STUFF ---------------- -} {- --------------- ACTUAL MATH STUFF ---------------- -}

View file

@ -3,6 +3,7 @@ module Main where
import Expr import Expr
import Parser import Parser
import System.IO import System.IO
-- import Check -- import Check
main :: IO () main :: IO ()
@ -12,7 +13,7 @@ main = do
input <- getLine input <- getLine
case pAll input of case pAll input of
Left err -> putStrLn err Left err -> putStrLn err
Right expr -> putStrLn $ pretty expr Right expr -> putStrLn (pretty expr)
-- Right expr -> case findType [] expr of -- Right expr -> case findType [] expr of
-- Just ty -> putStrLn $ pretty expr ++ " : " ++ pretty ty -- Just ty -> putStrLn $ pretty expr ++ " : " ++ pretty ty
-- Nothing -> putStrLn $ "Unable to find type for " ++ pretty expr ++ "!" -- Nothing -> putStrLn $ "Unable to find type for " ++ pretty expr ++ "!"