Add pretty printing for top-level AST.

diff --git a/OFC/TopLevel.hs b/OFC/TopLevel.hs
index 39f0968f9c4ee82e6ef7bac2bb6564c2c63c6467..18ad360361ec5deebb50d331ba8cd3061729ec45 100644 (file)
--- a/OFC/TopLevel.hs
+++ b/OFC/TopLevel.hs
@@ -35,7 +35,7 @@ module OFC.TopLevel
 import OFC.TargetMapping
 import OFC.Common
 import Text.PrettyPrint
-import Data.List (foldl')
+import Data.List (foldl', intercalate, intersperse)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Set (Set)
@@ -65,10 +65,34 @@ data Expression =
   SpatialDerivative Expression String Integer
   deriving Show
 
+instance PrettyPrintable Expression where
+  toDoc expression = case expression of 
+    IndexedIdentifier name indices -> text $ name ++ case indices of 
+      [] -> ""
+      nonNil -> "[" ++ (intercalate ", " nonNil) ++ "]"
+    ConstReal r -> text $ show r
+    ConstInteger i -> text $ show i
+    Negate e -> text "(-" <> toDoc e <> text ")"
+    Integrate e -> functionToDoc "integrate" [toDoc e]
+    Sum e i -> functionToDoc "sum" [toDoc e, text i]
+    Multiply a b -> binaryToDoc "*" a b
+    Divide a b -> binaryToDoc "/" a b
+    Add a b -> binaryToDoc "+" a b
+    Sub a b -> binaryToDoc "-" a b
+    Power a b -> binaryToDoc "^" a b
+    PositionComponent index -> text $ "r[" ++ index ++ "]"
+    SpatialDerivative e index degree -> functionToDoc "diff" [toDoc e, text index, text $ show degree]
+    where
+    binaryToDoc op lhs rhs = hcat [text "(", toDoc lhs, text op, toDoc rhs, text ")"]
+    functionToDoc name params = text (name ++ "(") <> hcat (intersperse (text ", ") params) <> text ")"
+
 data Assignment = 
   Assign Expression Expression 
   deriving Show
 
+instance PrettyPrintable Assignment where
+  toDoc (Assign lhs rhs) = hcat [toDoc lhs, text " = ", toDoc rhs]
+
 class OFLKeyword a where
   toOFLString :: a -> String
 
@@ -102,7 +126,7 @@ instance PrettyPrintable OFL where
     symbolDoc = text "Symbol table:"
       $$ nest 1 (vcat [text $ show x | x <- Map.assocs $ symbols ofl])
     assignmentsDoc = text "Assignments: "
-      $$ nest 1 (vcat [text $ show x | x <- assignments ofl])
+      $$ nest 1 (vcat $ map toDoc $ assignments ofl)
     targetMappingsDoc = text "Target properties: "
       $$ nest 1 (vcat [text $ show x | x <- Map.assocs $ targetMappings ofl])
     outputFunctionDoc = text "OutputFunction:"