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) =
+