diff options
Diffstat (limited to 'src/AST/Pretty.hs')
| -rw-r--r-- | src/AST/Pretty.hs | 32 |
1 files changed, 26 insertions, 6 deletions
diff --git a/src/AST/Pretty.hs b/src/AST/Pretty.hs index b50506a..acd0dc3 100644 --- a/src/AST/Pretty.hs +++ b/src/AST/Pretty.hs @@ -6,7 +6,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} -module AST.Pretty (ppExpr) where +module AST.Pretty (ppExpr, ppTy) where import Control.Monad (ap) import Data.List (intersperse) @@ -42,10 +42,10 @@ genNameIfUsedIn' prefix ty idx ex genNameIfUsedIn :: STy a -> Idx env a -> Expr x env t -> M String genNameIfUsedIn = genNameIfUsedIn' "x" -ppExpr :: SList STy env -> Expr x env t -> String +ppExpr :: SList f env -> Expr x env t -> String ppExpr senv e = fst (runM (mkVal senv >>= \val -> ppExpr' 0 val e) 1) "" where - mkVal :: SList STy env -> M (SVal env) + mkVal :: SList f env -> M (SVal env) mkVal SNil = return SNil mkVal (SCons _ v) = do val <- mkVal v @@ -112,14 +112,14 @@ ppExpr' d val = \case EBuild1 _ a b -> do a' <- ppExpr' 11 val a - name <- genNameIfUsedIn (STScal STI64) IZ b + name <- genNameIfUsedIn' "i" (STScal STI64) IZ b b' <- ppExpr' 0 (Const name `SCons` val) b return $ showParen (d > 10) $ showString "build1 " . a' . showString (" (\\" ++ name ++ " -> ") . b' . showString ")" EBuild _ n a b -> do a' <- ppExpr' 11 val a - name <- genNameIfUsedIn (tTup (sreplicate n tIx)) IZ b + name <- genNameIfUsedIn' "i" (tTup (sreplicate n tIx)) IZ b e' <- ppExpr' 0 (Const name `SCons` val) b return $ showParen (d > 10) $ showString "build " . a' . showString (" (\\" ++ name ++ " -> ") . e' . showString ")" @@ -195,7 +195,7 @@ ppExpr' d val = \case e2' <- ppExpr' 11 val e2 e3' <- ppExpr' 11 val e3 return $ showParen (d > 10) $ - showString ("accum " ++ show (unSNat i) ++ " ") . e1' . showString " " . e2' . showString " " . e3' + showString ("accum " ++ show (fromSNat i) ++ " ") . e1' . showString " " . e2' . showString " " . e3' EZero _ -> return $ showString "zero" @@ -243,6 +243,26 @@ operator OLt{} = (Infix, "<") operator OLe{} = (Infix, "<=") operator OEq{} = (Infix, "==") operator ONot = (Prefix, "not") +operator OAnd = (Infix, "&&") +operator OOr = (Infix, "||") operator OIf = (Prefix, "ifB") operator ORound64 = (Prefix, "round") operator OToFl64 = (Prefix, "toFl64") + +ppTy :: Int -> STy t -> String +ppTy d ty = ppTys d ty "" + +ppTys :: Int -> STy t -> ShowS +ppTys _ STNil = showString "1" +ppTys d (STPair a b) = showParen (d > 7) $ ppTys 8 a . showString " * " . ppTys 8 b +ppTys d (STEither a b) = showParen (d > 6) $ ppTys 7 a . showString " + " . ppTys 7 b +ppTys d (STMaybe t) = showParen (d > 10) $ showString "Maybe " . ppTys 11 t +ppTys d (STArr n t) = showParen (d > 10) $ + showString "Arr " . shows (fromSNat n) . showString " " . ppTys 11 t +ppTys _ (STScal sty) = showString $ case sty of + STI32 -> "i32" + STI64 -> "i64" + STF32 -> "f32" + STF64 -> "f64" + STBool -> "bool" +ppTys d (STAccum t) = showParen (d > 10) $ showString "Accum " . ppTys 11 t |