pretty: Generate type-tagged fallback names

1 files changed, 13 insertions, 5 deletions

diff --git a/src/AST/Pretty.hs b/src/AST/Pretty.hs
index 19c7cfc..4f637f2 100644
--- a/src/AST/Pretty.hs
+++ b/src/AST/Pretty.hs
@@ -50,12 +50,20 @@ instance Monad M where { M f >>= g = M (\i -> let (x, j) = f i in runM (g x) j)
 genId :: M Int
 genId = M (\i -> (i, i + 1))
 
+nameBaseForType :: STy t -> String
+nameBaseForType STNil = "nil"
+nameBaseForType (STPair{}) = "p"
+nameBaseForType (STEither{}) = "e"
+nameBaseForType (STMaybe{}) = "m"
+nameBaseForType (STScal STI32) = "n"
+nameBaseForType (STScal STI64) = "n"
+nameBaseForType (STArr{}) = "a"
+nameBaseForType (STAccum{}) = "ac"
+nameBaseForType _ = "x"
+
 genName' :: String -> M String
 genName' prefix = (prefix ++) . show <$> genId
 
-genName :: M String
-genName = genName' "x"
-
 genNameIfUsedIn' :: String -> STy a -> Idx env a -> Expr x env t -> M String
 genNameIfUsedIn' prefix ty idx ex
   | occCount idx ex == mempty = case ty of STNil -> return "()"
@@ -63,7 +71,7 @@ genNameIfUsedIn' prefix ty idx ex
   | otherwise                 = genName' prefix
 
 genNameIfUsedIn :: STy a -> Idx env a -> Expr x env t -> M String
-genNameIfUsedIn = genNameIfUsedIn' "x"
+genNameIfUsedIn = \t -> genNameIfUsedIn' (nameBaseForType t) t
 
 pprintExpr :: (KnownEnv env, PrettyX x) => Expr x env t -> IO ()
 pprintExpr = putStrLn . ppExpr knownEnv
@@ -83,7 +91,7 @@ ppExpr senv e = render $ fst . flip runM 1 $ do
     mkVal SNil = return SNil
     mkVal (SCons _ v) = do
       val <- mkVal v
-      name <- genName
+      name <- genName' "arg"
       return (Const name `SCons` val)
 
 ppExpr' :: PrettyX x => Int -> SVal env -> Expr x env t -> M ADoc