diff options
| -rw-r--r-- | src/SPL/PrettyPrinter.hs | 39 | ||||
| -rw-r--r-- | src/SPL/Syntax.hs | 16 |
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 |