From 3c4d5fe993796c40fcbe34ac60ab0e16e012b943 Mon Sep 17 00:00:00 2001
From: Yann Herklotz <git@yannherklotz.com>
Date: Tue, 16 Nov 2021 15:00:12 +0000
Subject: Add top-level of pretty printer

---
 app/Main.hs        |  8 ++++++--
 gsa-parser.cabal   |  1 +
 src/GSA.hs         |  4 +++-
 src/GSA/Printer.hs | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 70 insertions(+), 3 deletions(-)
 create mode 100644 src/GSA/Printer.hs

diff --git a/app/Main.hs b/app/Main.hs
index a81cf7c..409fa18 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,9 +1,13 @@
 import GSA
 
-import qualified Data.Text.IO as T (readFile)
+import qualified Data.Text.IO as T (readFile, writeFile)
 import Data.Text (Text)
 
 main :: IO ()
 main = do
   t <- T.readFile "main.gsa"
-  print $ parse "main.gsa" t
+  let p = case parse "main.gsa" t of
+            Left s -> error s
+            Right p' -> p'
+  print p
+  T.writeFile "main_out.gsa" $ programPrinter p
diff --git a/gsa-parser.cabal b/gsa-parser.cabal
index e0115df..0dec6d2 100644
--- a/gsa-parser.cabal
+++ b/gsa-parser.cabal
@@ -36,6 +36,7 @@ library
                  , GSA.Common
                  , GSA.Types
                  , GSA.Parser
+                 , GSA.Printer
   build-depends:
     , containers
     , mtl
diff --git a/src/GSA.hs b/src/GSA.hs
index cbf1220..8d1bb59 100644
--- a/src/GSA.hs
+++ b/src/GSA.hs
@@ -1,10 +1,12 @@
 module GSA
   ( module GSA.Parser,
     module GSA.Types,
-    module GSA.Common
+    module GSA.Common,
+    module GSA.Printer
   )
 where
 
 import GSA.Parser
 import GSA.Types
 import GSA.Common
+import GSA.Printer
diff --git a/src/GSA/Printer.hs b/src/GSA/Printer.hs
new file mode 100644
index 0000000..aca04e1
--- /dev/null
+++ b/src/GSA/Printer.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module GSA.Printer
+  (regPrinter, operationPrinter, instructionPrinter, codePrinter, functionPrinter, programPrinter)
+where
+
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as IMap
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import GSA.Types
+
+tshow :: Show a => a -> Text
+tshow = T.pack . show
+
+parens :: Text -> Text
+parens t = "(" <> t <> ")"
+
+braces :: Text -> Text
+braces t = "{" <> t <> "}"
+
+sep :: Text -> [Text] -> Text
+sep = T.intercalate
+
+commaSep :: [Text] -> Text
+commaSep = sep ", "
+
+regPrinter :: Reg -> Text
+regPrinter (Reg i) = "x" <> tshow i
+
+operationPrinter :: Operation -> [Reg] -> Text
+operationPrinter Omove [r1] = regPrinter r1
+operationPrinter p _ = error $ "Operation printing not implemented: " <> show p
+
+instructionPrinter :: Int -> Instruction -> Text
+instructionPrinter i (Inop (Node n))
+  | i - 1 == n = "   " <> tshow i <> ":\tnop"
+  | otherwise = "   " <> tshow i <> ":\tgoto " <> tshow n
+instructionPrinter i (Iop op args dest (Node n)) =
+  "   " <> tshow i <> ":\t" <> regPrinter dest <> " = " <> operationPrinter op args <>
+  if i - 1 == n then "" else "goto " <> tshow n
+instructionPrinter _ op = error $ "Instruction printing not implemented: " <> show op
+
+codePrinter :: Code -> Text
+codePrinter (Code c) = IMap.foldrWithKey f "" c
+  where
+    f k a b = b <> instructionPrinter k a <> "\n"
+
+functionPrinter :: Text -> Function -> Text
+functionPrinter n f = n
+  <> parens (commaSep $ regPrinter <$> fnParams f) <> " "
+  <> braces ("\n" <> codePrinter (fnCode f))
+
+programPrinter :: Program -> Text
+programPrinter (Program p) = Map.foldrWithKey f "" p
+  where
+    f k a b = b <> functionPrinter k a <> "\n\n"
-- 
cgit