greatly improved pretty printer
This commit is contained in:
parent
acb3fe9d6c
commit
e9e388ba05
2 changed files with 26 additions and 15 deletions
32
app/Expr.hs
32
app/Expr.hs
|
|
@ -23,18 +23,28 @@ occursFree n (Pi _ a b) = occursFree n a || occursFree (n + 1) b
|
|||
|
||||
{- --------------------- 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 (Var _ s) = s
|
||||
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 ++ ")"
|
||||
pretty = helper 0
|
||||
|
||||
{- --------------- ACTUAL MATH STUFF ---------------- -}
|
||||
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@ module Main where
|
|||
import Expr
|
||||
import Parser
|
||||
import System.IO
|
||||
|
||||
-- import Check
|
||||
|
||||
main :: IO ()
|
||||
|
|
@ -12,7 +13,7 @@ main = do
|
|||
input <- getLine
|
||||
case pAll input of
|
||||
Left err -> putStrLn err
|
||||
Right expr -> putStrLn $ pretty expr
|
||||
Right expr -> putStrLn (pretty expr)
|
||||
-- Right expr -> case findType [] expr of
|
||||
-- Just ty -> putStrLn $ pretty expr ++ " : " ++ pretty ty
|
||||
-- Nothing -> putStrLn $ "Unable to find type for " ++ pretty expr ++ "!"
|
||||
|
|
|
|||
Loading…
Reference in a new issue