diff options
Diffstat (limited to 'src/AST/Pretty.hs')
-rw-r--r-- | src/AST/Pretty.hs | 29 |
1 files changed, 16 insertions, 13 deletions
diff --git a/src/AST/Pretty.hs b/src/AST/Pretty.hs index bf0d350..2ce883b 100644 --- a/src/AST/Pretty.hs +++ b/src/AST/Pretty.hs @@ -42,11 +42,6 @@ genNameIfUsedIn' prefix ty idx ex genNameIfUsedIn :: STy a -> Idx env a -> Expr x env t -> M String genNameIfUsedIn = genNameIfUsedIn' "x" -valprj :: SList f env -> Idx env t -> f t -valprj (x `SCons` _) IZ = x -valprj (_ `SCons` env) (IS i) = valprj env i -valprj SNil i = case i of {} - ppExpr :: SList STy env -> Expr x env t -> String ppExpr senv e = fst (runM (mkVal senv >>= \val -> ppExpr' 0 val e) 1) "" where @@ -59,7 +54,7 @@ ppExpr senv e = fst (runM (mkVal senv >>= \val -> ppExpr' 0 val e) 1) "" ppExpr' :: Int -> SVal env -> Expr x env t -> M ShowS ppExpr' d val = \case - EVar _ _ i -> return $ showString $ getConst $ valprj val i + EVar _ _ i -> return $ showString $ getConst $ slistIdx val i e@ELet{} -> ppExprLet d val e @@ -97,6 +92,9 @@ ppExpr' d val = \case showString "case " . e' . showString (" of { Inl " ++ name1 ++ " -> ") . a' . showString (" ; Inr " ++ name2 ++ " -> ") . b' . showString " }" + EConstArr _ _ ty v + | Dict <- scalRepIsShow ty -> return $ showsPrec d v + EBuild1 _ a b -> do a' <- ppExpr' 11 val a name <- genNameIfUsedIn (STScal STI64) IZ b @@ -111,25 +109,30 @@ ppExpr' d val = \case return $ showParen (d > 10) $ showString "build " . a' . showString (" (\\" ++ name ++ " -> ") . e' . showString ")" - EFold1 _ a b -> do + EFold1Inner _ a b -> do name1 <- genNameIfUsedIn (typeOf a) (IS IZ) a name2 <- genNameIfUsedIn (typeOf a) IZ a a' <- ppExpr' 0 (Const name2 `SCons` Const name1 `SCons` val) a b' <- ppExpr' 11 val b return $ showParen (d > 10) $ - showString ("fold1 (\\" ++ name1 ++ " " ++ name2 ++ " -> ") . a' + showString ("fold1i (\\" ++ name1 ++ " " ++ name2 ++ " -> ") . a' . showString ") " . b' + ESum1Inner _ e -> do + e' <- ppExpr' 11 val e + return $ showParen (d > 10) $ showString "sum1i " . e' + EUnit _ e -> do e' <- ppExpr' 11 val e return $ showParen (d > 10) $ showString "unit " . e' - -- EReplicate _ e -> do - -- e' <- ppExpr' 11 val e - -- return $ showParen (d > 10) $ showString "replicate " . e' + EReplicate1Inner _ a b -> do + a' <- ppExpr' 11 val a + b' <- ppExpr' 11 val b + return $ showParen (d > 10) $ showString "replicate1i " . a' . showString " " . b' - EConst _ ty v -> return $ showString $ case ty of - STI32 -> show v ; STI64 -> show v ; STF32 -> show v ; STF64 -> show v ; STBool -> show v + EConst _ ty v + | Dict <- scalRepIsShow ty -> return $ showsPrec d v EIdx0 _ e -> do e' <- ppExpr' 11 val e |