aboutsummaryrefslogtreecommitdiff
path: root/src/CHAD/AST/Pretty.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/CHAD/AST/Pretty.hs')
-rw-r--r--src/CHAD/AST/Pretty.hs16
1 files changed, 8 insertions, 8 deletions
diff --git a/src/CHAD/AST/Pretty.hs b/src/CHAD/AST/Pretty.hs
index 9ddcb35..b763efe 100644
--- a/src/CHAD/AST/Pretty.hs
+++ b/src/CHAD/AST/Pretty.hs
@@ -63,20 +63,20 @@ nameBaseForType _ = "x"
genName' :: String -> M String
genName' prefix = (prefix ++) . show <$> genId
-genNameIfUsedIn' :: String -> STy a -> Idx env a -> Expr x env t -> M String
+genNameIfUsedIn' :: String -> STy a -> Idx env a -> Expr NoExt x env t -> M String
genNameIfUsedIn' prefix ty idx ex
| occCount idx ex == mempty = case ty of STNil -> return "()"
_ -> return "_"
| otherwise = genName' prefix
-- TODO: let this return a type-tagged thing so that name environments are more typed than Const
-genNameIfUsedIn :: STy a -> Idx env a -> Expr x env t -> M String
+genNameIfUsedIn :: STy a -> Idx env a -> Expr NoExt x env t -> M String
genNameIfUsedIn = \t -> genNameIfUsedIn' (nameBaseForType t) t
-pprintExpr :: (KnownEnv env, PrettyX x) => Expr x env t -> IO ()
+pprintExpr :: (KnownEnv env, PrettyX x) => Expr NoExt x env t -> IO ()
pprintExpr = putStrLn . ppExpr knownEnv
-ppExpr :: PrettyX x => SList STy env -> Expr x env t -> String
+ppExpr :: PrettyX x => SList STy env -> Expr NoExt x env t -> String
ppExpr senv e = render $ fst . flip runM 1 $ do
val <- mkVal senv
e' <- ppExpr' 0 val e
@@ -94,7 +94,7 @@ ppExpr senv e = render $ fst . flip runM 1 $ do
name <- genName' "arg"
return (Const name `SCons` val)
-ppExpr' :: PrettyX x => Int -> SVal env -> Expr x env t -> M ADoc
+ppExpr' :: PrettyX x => Int -> SVal env -> Expr NoExt x env t -> M ADoc
ppExpr' d val expr = case expr of
EVar _ _ i -> return $ ppString (getConst (slistIdx val i)) <> ppX expr
@@ -374,9 +374,9 @@ ppExpr' d val expr = case expr of
EError _ _ s -> return $ ppParen (d > 10) $ ppString "error" <> ppX expr <+> ppString (show s)
-ppExprLet :: PrettyX x => Int -> SVal env -> Expr x env t -> M ADoc
+ppExprLet :: PrettyX x => Int -> SVal env -> Expr NoExt x env t -> M ADoc
ppExprLet d val etop = do
- let collect :: PrettyX x => SVal env -> Expr x env t -> M ([(String, Occ, ADoc)], ADoc)
+ let collect :: PrettyX x => SVal env -> Expr NoExt x env t -> M ([(String, Occ, ADoc)], ADoc)
collect val' (ELet _ rhs body) = do
let occ = occCount IZ body
name <- genNameIfUsedIn (typeOf rhs) IZ body
@@ -426,7 +426,7 @@ ppCommut :: Commutative -> String
ppCommut Commut = "(C)"
ppCommut Noncommut = ""
-ppX :: PrettyX x => Expr x env t -> ADoc
+ppX :: PrettyX x => Expr NoExt x env t -> ADoc
ppX expr = annotate AExt $ ppString $ prettyXsuffix (extOf expr)
data Fixity = Prefix | Infix