pretty printing
This commit is contained in:
parent
d5a34360bb
commit
1330966180
2 changed files with 38 additions and 13 deletions
38
app/Expr.hs
38
app/Expr.hs
|
|
@ -3,15 +3,39 @@
|
|||
module Expr where
|
||||
|
||||
import Data.Function (on)
|
||||
import Data.List (genericDrop)
|
||||
|
||||
data Expr where
|
||||
Var :: Integer -> Expr
|
||||
Star :: Expr
|
||||
Square :: Expr
|
||||
App :: Expr -> Expr -> Expr
|
||||
Abs :: Expr -> Expr -> Expr
|
||||
Pi :: Expr -> Expr -> Expr
|
||||
deriving (Show, Eq)
|
||||
Var :: Integer -> Expr
|
||||
Star :: Expr
|
||||
Square :: Expr
|
||||
App :: Expr -> Expr -> Expr
|
||||
Abs :: Expr -> Expr -> Expr
|
||||
Pi :: Expr -> Expr -> Expr
|
||||
deriving (Show, Eq)
|
||||
|
||||
{- --------------------- PRETTY PRINTING ----------------------------- -}
|
||||
|
||||
-- TODO : store parsed identifiers for better printing
|
||||
genName :: Integer -> String
|
||||
genName k = case genericDrop k ["x", "y", "z", "w", "u", "v"] of
|
||||
[] -> 'x' : show (k - 6)
|
||||
(v : _) -> v
|
||||
|
||||
pretty :: Expr -> String
|
||||
pretty = helper 0
|
||||
where
|
||||
helper :: Integer -> Expr -> String
|
||||
helper k (Var n) = genName $ k - n - 1
|
||||
helper _ Star = "*"
|
||||
helper _ Square = "□"
|
||||
helper k (App e1 e2) = "(" ++ helper k e1 ++ " " ++ helper k e2 ++ ")"
|
||||
helper k (Abs ty b) =
|
||||
"(λ" ++ genName k ++ " : " ++ helper k ty ++ " . " ++ helper (k + 1) b ++ ")"
|
||||
helper k (Pi ty b) =
|
||||
"(∏" ++ genName k ++ " : " ++ helper k ty ++ " . " ++ helper (k + 1) b ++ ")"
|
||||
|
||||
{- --------------- ACTUAL MATH STUFF ---------------- -}
|
||||
|
||||
isSort :: Expr -> Bool
|
||||
isSort Star = True
|
||||
|
|
|
|||
13
app/Main.hs
13
app/Main.hs
|
|
@ -1,13 +1,14 @@
|
|||
module Main where
|
||||
|
||||
import Expr
|
||||
import Parser
|
||||
import System.IO
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
_ <- putStr "> "
|
||||
_ <- hFlush stdout
|
||||
input <- getLine
|
||||
case pAll input of
|
||||
Left err -> putStrLn err
|
||||
Right expr -> print expr
|
||||
_ <- putStr "> "
|
||||
_ <- hFlush stdout
|
||||
input <- getLine
|
||||
case pAll input of
|
||||
Left err -> putStrLn err
|
||||
Right expr -> putStrLn $ pretty expr
|
||||
|
|
|
|||
Loading…
Reference in a new issue