diff options
| author | Erin van der Veen | 2018-02-07 12:31:05 +0100 |
|---|---|---|
| committer | Erin van der Veen | 2018-02-07 12:31:05 +0100 |
| commit | c10aa9c62cca20aad1ef4ca869ab1f5986df7fb1 (patch) | |
| tree | 0a3fcf5a55356563c59de1f170e1f3cd6855ae77 /src/SPL/PrettyPrinter.hs | |
| parent | Start with parser (diff) | |
Add PrettyPrinter
Diffstat (limited to 'src/SPL/PrettyPrinter.hs')
| -rw-r--r-- | src/SPL/PrettyPrinter.hs | 131 |
1 files changed, 131 insertions, 0 deletions
diff --git a/src/SPL/PrettyPrinter.hs b/src/SPL/PrettyPrinter.hs new file mode 100644 index 0000000..b0d7fe5 --- /dev/null +++ b/src/SPL/PrettyPrinter.hs @@ -0,0 +1,131 @@ +-- vim: et ts=2 sw=2 ai: +module SPL.PrettyPrinter +where + +import SPL.Syntax + +import Control.Applicative +import Control.Monad +import Control.Monad.State.Lazy +import Control.Monad.Identity +import Data.Char + +-- For Extensibility +data St = St + { indent :: Int + , result :: String + } + +-- State -> (a, State) +type Print = State St () + +class Pprint t where + pprint :: t -> Print + +instance Pprint Program where + pprint _ = error "TODO" + +instance Pprint Function where + pprint _ = error "TODO" + +instance Pprint Variable where + pprint _ = error "TODO" + +instance Pprint Type where + pprint _ = error "TODO" + +instance Pprint Statement where + pprint (If e smt1 (Just smt2)) = do + pprint smt2 + pprint "else" + pprint smt1 + pprint ")" + pprint e + pprint "(" + pprint "if" + pprint _ = error "TODO" + +instance Pprint Expression where + pprint (Field name field) = do + pprint field + pprint name + + pprint (Op2 e1 op e2) = do + pprint ")" + pprint e2 + pprint " " + pprint op + pprint " " + pprint e1 + pprint "(" + + pprint (Op1 op e) = do + pprint e + pprint op + + pprint (Literal l) = do + pprint l + + pprint (FunCall name xs) = do + pprint xs + pprint name + + pprint (Tuple e1 e2) = do + pprint ")" + pprint e2 + pprint ", " + pprint e1 + pprint "(" + +instance Pprint Field where + pprint Hd = pprint ".hd" + pprint Tl = pprint ".tl" + pprint Fst = pprint ".fst" + pprint Snd = pprint ".snd" + pprint _ = error "Cannot pprint unknown field" + +instance Pprint Op2 where + pprint Add = pprint "+" + pprint Sub = pprint "-" + pprint Mul = pprint "*" + pprint Div = pprint "/" + pprint Mod = pprint "%" + pprint Eq = pprint "==" + pprint Lt = pprint "<" + pprint Gt = pprint ">" + pprint Le = pprint "<=" + pprint Ge = pprint ">=" + pprint Ne = pprint "!=" + pprint And = pprint "&&" + pprint Or = pprint "||" + pprint Cons = pprint ":" + pprint _ = error "Cannot pprint unknown binary operator" + +instance Pprint Op1 where + pprint Not = pprint "!" + pprint Neg = pprint "-" + pprint _ = error "Cannot pprint unknown unary operator" + +instance Pprint Literal where + pprint (LInt x) = pprint $ show x + pprint (LChar x) = pprint $ "'" ++ show x ++ "'" + pprint (LBool x) = pprint $ show x + pprint LNil = pprint "[]" + pprint _ = error "Cannot pprint unknown literal" + +instance Pprint a => Pprint [a] where + pprint xs = mapM_ pprint xs + +instance Pprint Char where + pprint c = modify (\st -> st { result = (c : result st) }) + +-- prettyPrint :: [] -> String +-- prettyPrint ts = prettyPrint` ts newState +-- where +-- newState :: State +-- newState = State {indent = 0} +-- +-- prettyPrint` :: [Token] -> Print +-- prettyPrint` [] = \s -> +-- prettyPrint` (t:ts) = + |