diff options
Diffstat (limited to 'src/AST/Pretty.hs')
| -rw-r--r-- | src/AST/Pretty.hs | 15 |
1 files changed, 12 insertions, 3 deletions
diff --git a/src/AST/Pretty.hs b/src/AST/Pretty.hs index 604133b..da4f391 100644 --- a/src/AST/Pretty.hs +++ b/src/AST/Pretty.hs @@ -10,8 +10,9 @@ module AST.Pretty (pprintExpr, ppExpr, ppSTy, ppTy, PrettyX(..)) where import Control.Monad (ap) -import Data.List (intersperse) +import Data.List (intersperse, intercalate) import Data.Functor.Const +import qualified Data.Functor.Product as Product import Data.String (fromString) import Prettyprinter import Prettyprinter.Render.String @@ -67,8 +68,16 @@ genNameIfUsedIn = genNameIfUsedIn' "x" pprintExpr :: (KnownEnv env, PrettyX x) => Expr x env t -> IO () pprintExpr = putStrLn . ppExpr knownEnv -ppExpr :: PrettyX x => SList f env -> Expr x env t -> String -ppExpr senv e = render $ fst (runM (mkVal senv >>= \val -> ppExpr' 0 val e) 1) +ppExpr :: PrettyX x => SList STy env -> Expr x env t -> String +ppExpr senv e = render $ fst . flip runM 1 $ do + val <- mkVal senv + e' <- ppExpr' 0 val e + let lam = "λ" ++ intercalate " " (reverse (unSList (\(Product.Pair (Const name) ty) -> "(" ++ name ++ " : " ++ ppSTy 0 ty ++ ")") (slistZip val senv))) ++ "." + return $ group $ flatAlt + (hang 2 $ + ppString lam + <> hardline <> e') + (ppString lam <+> e') where mkVal :: SList f env -> M (SVal env) mkVal SNil = return SNil |