Add local variables to pretty-printer; respect infix priorityHEADmaster

2 files changed, 46 insertions, 9 deletions

diff --git a/src/SPL/PrettyPrinter.hs b/src/SPL/PrettyPrinter.hs
index e9a3300..b937d14 100644
--- a/src/SPL/PrettyPrinter.hs
+++ b/src/SPL/PrettyPrinter.hs
@@ -1,4 +1,5 @@
 -- vim: et ts=2 sw=2 ai:
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
 module SPL.PrettyPrinter
 where
 
@@ -11,24 +12,30 @@ import Control.Monad.Identity
 import Data.Char
 
 prettyPrint :: Pprint t => t -> String
-prettyPrint t = result $ execState (pprint t) (St 0 "")
+prettyPrint t = result $ execState (pprint t) (St 0 0 "")
 
 -- For Extensibility
 data St = St
   { indentation :: Int
+  , priority    :: Int
   , result      :: String
   }
 
--- State -> (a, State)
 type Print = State St ()
 
+decIndent :: Print
+decIndent = modify (\st -> st {indentation=indentation st + 1})
+
+incIndent :: Print
+incIndent = modify (\st -> st {indentation=indentation st - 1})
+
 indent :: (Pprint t) => t -> Print
 indent p = do
   newline
-  modify (\st -> st {indentation=indentation st + 1})
+  decIndent
   pprint p
   newline
-  modify (\st -> st {indentation=indentation st - 1})
+  incIndent
 
 newline :: Print
 newline = do
@@ -39,6 +46,8 @@ newline = do
 class Pprint t where
   pprint :: t -> Print
 
+instance Pprint Print where pprint = id
+
 instance Pprint Program where
   pprint p = do
     printersperse "\n\n" $ funs p
@@ -48,7 +57,15 @@ instance Pprint Program where
 instance Pprint Function where
   pprint f = do
     pprint "}"
-    indent (fcode f)
+    newline
+    decIndent
+    pprint $ fcode f
+    case fvars f of
+      [] -> pure ()
+      _  -> newline
+    printersperse newline $ fvars f
+    newline
+    incIndent
     pprint " {"
     case ftype f of
       Nothing -> pprint "-> Void"
@@ -60,12 +77,13 @@ instance Pprint Function where
 
 instance Pprint Variable where
   pprint v = do
+    pprint ";"
     pprint $ vval v
     pprint " = "
     pprint $ vname v
     pprint " "
     case vtype v of
-      Nothing -> pprint "Void "
+      Nothing -> pprint "var"
       Just t -> pprint t
 
 instance Pprint Type where
@@ -85,7 +103,7 @@ instance Pprint Type where
     pprint "("
   pprint (TArrow ts t) = do
     pprint t
-    pprint " -> "
+    pprint $ if (null ts) then "-> " else " -> "
     printersperse " " ts
   pprint (TVar v) = pprint v
 
@@ -138,13 +156,16 @@ instance Pprint Expression where
     pprint field
     pprint name
   pprint (Op2 e1 op e2) = do
-    pprint ")"
+    p <- gets priority
+    pprint $ if (prio op > p && p /= 0) then ")" else ""
+    modify (\st -> st {priority = prio op})
     pprint e2
     pprint " "
     pprint op
     pprint " "
     pprint e1
-    pprint "("
+    modify (\st -> st {priority = p})
+    pprint $ if (prio op > p && p /= 0) then "(" else ""
   pprint (Op1 op e) = do
     pprint e
     pprint op
diff --git a/src/SPL/Syntax.hs b/src/SPL/Syntax.hs
index f52b866..433b078 100644
--- a/src/SPL/Syntax.hs
+++ b/src/SPL/Syntax.hs
@@ -92,3 +92,19 @@ data Literal
   | LBool Bool
   | LNil
   deriving (Show)
+
+prio :: Op2 -> Int
+prio Add  =  6
+prio Sub  =  6
+prio Mul  =  5
+prio Div  =  5
+prio Mod  =  3
+prio Eq   =  8
+prio Lt   =  8
+prio Gt   =  8
+prio Le   =  8
+prio Ge   =  8
+prio Ne   =  8
+prio And  =  9
+prio Or   = 10
+prio Cons =  7