{-# LANGUAGE OverloadedStrings #-}

-- | Codegen.hs
-- Translator from TALM dataflow graph DOT format into TALM assembly.
module Codegen
  ( parseNodes
  , parseEdges
  , generateInstructions
  ) where

import Data.Char      (isSpace)
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T

-- | Parse node definitions in DOT: lines containing "[label=".
parseNodes :: Text -> [(Text, Text)]
parseNodes :: Text -> [(Text, Text)]
parseNodes Text
input =
  [ (Text
name, Text
label)
  | Text
line <- Text -> [Text]
T.lines Text
input
  , Text
"[label=" Text -> Text -> Bool
`T.isInfixOf` Text
line
  , let parts :: [Text]
parts   = Text -> Text -> [Text]
T.splitOn Text
"[" Text
line
  , let name :: Text
name    = Text -> Text
T.strip ([Text] -> Text
forall a. [a] -> a
head [Text]
parts)
  , let lblPart :: Text
lblPart = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"') ([Text]
parts [Text] -> Int -> Text
forall a. [a] -> Int -> a
!! Int
1)
  , let label :: Text
label   = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"') (Int64 -> Text -> Text
T.drop Int64
1 Text
lblPart)
  ]

-- | Parse edges in DOT: lines containing "->".
parseEdges :: Text -> [(Text, Text)]
parseEdges :: Text -> [(Text, Text)]
parseEdges Text
input =
  [ (Text
src, Text
dst)
  | Text
line <- Text -> [Text]
T.lines Text
input
  , Text
"->" Text -> Text -> Bool
`T.isInfixOf` Text
line
  , let (Text
l, Text
r) = Text -> Text -> (Text, Text)
T.breakOn Text
"->" Text
line
  , let src :: Text
src    = Text -> Text
T.strip Text
l
  , let r' :: Text
r'     = Int64 -> Text -> Text
T.drop Int64
2 Text
r
  , let dst :: Text
dst    = Text -> Text
T.strip ((Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';') Text
r')
  ]

-- | Generate TALM instructions for all nodes (order preserved)
generateInstructions :: [(Text, Text)] -> [(Text, Text)] -> [Text]
generateInstructions :: [(Text, Text)] -> [(Text, Text)] -> [Text]
generateInstructions [(Text, Text)]
nodes [(Text, Text)]
edges = ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([(Text, Text)] -> (Text, Text) -> Text
genNode [(Text, Text)]
edges) [(Text, Text)]
nodes

-- | Generate a single TALM instruction from a node and its edges
genNode :: [(Text, Text)] -> (Text, Text) -> Text
genNode :: [(Text, Text)] -> (Text, Text) -> Text
genNode [(Text, Text)]
edges (Text
name, Text
label) =
  let ins :: [Text]
ins      = [ Text
s | (Text
s,Text
d) <- [(Text, Text)]
edges, Text
d Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name ]
      outs :: [Text]
outs     = [ Text
d | (Text
s,Text
d) <- [(Text, Text)]
edges, Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name ]
      (Text
op,Maybe Text
mi)  = case Text -> Text -> [Text]
T.splitOn Text
":" Text
label of
                    [Text
x,Text
y] -> (Text
x, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
y)
                    [Text
x]   -> (Text
x, Maybe Text
forall a. Maybe a
Nothing)
                    [Text]
xs    -> ([Text] -> Text
forall a. [a] -> a
head [Text]
xs, Text -> Maybe Text
forall a. a -> Maybe a
Just ([Text] -> Text
forall a. [a] -> a
last [Text]
xs))
      opcode :: Text
opcode   = Text -> Text
mapOpcode Text
op
      immTxt :: Text
immTxt   = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
T.empty (Char -> Text -> Text
T.cons Char
' ') Maybe Text
mi
      nRes :: Int
nRes     = Text -> [Text] -> Int
calcResults Text
op [Text]
outs
      nSrc :: Int
nSrc     = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ins
      dsts :: Text
dsts     = Text -> [Text] -> Text
T.intercalate Text
"," (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
nRes [Text]
outs)
      srcs :: Text
srcs     = Text -> [Text] -> Text
T.intercalate Text
"," [Text]
ins
      arrowTxt :: Text
arrowTxt = if Int
nSrc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Text
" <- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
srcs else Text
""
  in [Text] -> Text
T.concat [ Text
opcode
              , Text
" " , String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
nRes)
              , Text
" " , String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
nSrc)
              , Text
immTxt
              , Text
" : " , Text
dsts
              , Text
arrowTxt
              ]

-- | Map operation name to TALM opcode\mapOpcode :: Text -> Text
mapOpcode :: Text -> Text
mapOpcode Text
op
  | Text
op Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"var"   = Text
"split"
  | Text
op Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"in"    = Text
"split"
  | Text
op Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Text
"const", Text
"add", Text
"sub", Text
"mul", Text
"div", Text
"mod"
              , Text
"andi",Text
"ori",Text
"xori",Text
"and",Text
"or",Text
"xor"
              , Text
"not", Text
"eq",Text
"neq",Text
"lt",Text
"leq",Text
"gt",Text
"geq"
              , Text
"addi",Text
"subi",Text
"muli",Text
"divi"
              , Text
"steer",Text
"merge",Text
"split"
              , Text
"callgroup",Text
"callsnd",Text
"retsnd",Text
"ret"
              , Text
"inctag",Text
"tagop"
              , Text
"super",Text
"specsuper",Text
"superinstmacro" ] = Text
op
  | Bool
otherwise      = String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Unknown label opcode: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
op

-- | Calculate number of results based on op and outgoing edges
calcResults :: Text -> [Text] -> Int
calcResults :: Text -> [Text] -> Int
calcResults Text
"steer" [Text]
_    = Int
2
calcResults Text
"split" [Text]
outs = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
outs
calcResults Text
op [Text]
_
  | Text
op Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Text
"callgroup",Text
"callsnd",Text
"retsnd",Text
"ret",Text
"inctag" ] = Int
0
  | Bool
otherwise = Int
1