diff options
Diffstat (limited to 'src/AST/Pretty.hs')
| -rw-r--r-- | src/AST/Pretty.hs | 18 |
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 |