diff options
Diffstat (limited to 'src/AST/Pretty.hs')
| -rw-r--r-- | src/AST/Pretty.hs | 29 |
1 files changed, 23 insertions, 6 deletions
diff --git a/src/AST/Pretty.hs b/src/AST/Pretty.hs index f91aff2..b9406d7 100644 --- a/src/AST/Pretty.hs +++ b/src/AST/Pretty.hs @@ -235,9 +235,9 @@ ppExpr' d val expr = case expr of ,e1' ,e2'] - EWith _ e1 e2 -> do + EWith _ t e1 e2 -> do e1' <- ppExpr' 11 val e1 - name <- genNameIfUsedIn' "ac" (STAccum (typeOf e1)) IZ e2 + name <- genNameIfUsedIn' "ac" (STAccum t) IZ e2 e2' <- ppExpr' 0 (Const name `SCons` val) e2 return $ ppParen (d > 0) $ group $ flatAlt @@ -247,12 +247,12 @@ ppExpr' d val expr = case expr of <> hardline <> e2') (ppApp (annotate AWith (ppString "with") <> ppX expr) [e1', ppLam [ppString name] e2']) - EAccum _ i e1 e2 e3 -> do + EAccum _ _ prj e1 e2 e3 -> do e1' <- ppExpr' 11 val e1 e2' <- ppExpr' 11 val e2 e3' <- ppExpr' 11 val e3 return $ ppParen (d > 10) $ - ppApp (annotate AMonoid (ppString "accum") <> ppX expr) [ppString (show (fromSNat i)), e1', e2', e3'] + ppApp (annotate AMonoid (ppString "accum") <> ppX expr) [ppString (ppAcPrj prj), e1', e2', e3'] EZero _ t -> return $ ppParen (d > 0) $ annotate AMonoid (ppString "zero") <> ppX expr <+> ppString "@" <> ppSTy' 11 t @@ -263,11 +263,11 @@ ppExpr' d val expr = case expr of return $ ppParen (d > 10) $ ppApp (annotate AMonoid (ppString "plus") <> ppX expr) [a', b'] - EOneHot _ _ i a b -> do + EOneHot _ _ prj a b -> do a' <- ppExpr' 11 val a b' <- ppExpr' 11 val b return $ ppParen (d > 10) $ - ppApp (annotate AMonoid (ppString "onehot") <> ppX expr) [ppString (show (fromSNat i)), a', b'] + ppApp (annotate AMonoid (ppString "onehot") <> ppX expr) [ppString (ppAcPrj prj), a', b'] EError _ _ s -> return $ ppParen (d > 10) $ ppString "error" <> ppX expr <+> ppString (show s) @@ -300,6 +300,15 @@ ppLam :: [ADoc] -> ADoc -> ADoc ppLam args body = ppString "(" <> hang 2 (ppString "\\" <> sep (args ++ [ppString "->"]) <> softline <> body <> ppString ")") +ppAcPrj :: SAcPrj p a b -> String +ppAcPrj SAPHere = "@" +ppAcPrj (SAPFst prj) = "(" ++ ppAcPrj prj ++ ",)" +ppAcPrj (SAPSnd prj) = "(," ++ ppAcPrj prj ++ ")" +ppAcPrj (SAPLeft prj) = "(" ++ ppAcPrj prj ++ "|)" +ppAcPrj (SAPRight prj) = "(|" ++ ppAcPrj prj ++ ")" +ppAcPrj (SAPJust prj) = "J" ++ ppAcPrj prj +ppAcPrj (SAPArrIdx prj n) = "[" ++ ppAcPrj prj ++ "]" ++ intSubscript (fromSNat n) + ppX :: PrettyX x => Expr x env t -> ADoc ppX expr = annotate AExt $ ppString $ prettyXsuffix (extOf expr) @@ -355,6 +364,14 @@ ppParen :: Bool -> Doc x -> Doc x ppParen True = parens ppParen False = id +intSubscript :: Int -> String +intSubscript = \case 0 -> "₀" + n | n < 0 -> '₋' : go (-n) "" + | otherwise -> go n "" + where go 0 suff = suff + go n suff = let (q, r) = n `quotRem` 10 + in go q ("₀₁₂₃₄₅₆₇₈₉" !! r : suff) + data Annot = AKey | AWith | AHighlight | AMonoid | AExt deriving (Show) |