aboutsummaryrefslogtreecommitdiffstats
path: root/src/GSA/Printer.hs
blob: aca04e1d40453c063dc2f898c6089fbedb8a5e38 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
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"