{-# LANGUAGE PatternSynonyms #-}

module CodeGen.RiscV.Lib.Types where

import Control.Arrow ((>>>))
import Data.Char (toLower)
import Data.Int (Int64)
import Data.Text (Text)
import Prettyprinter (Pretty (pretty), colon, comma, hsep, indent, layoutCompact, parens, punctuate, vsep, (<+>))
import Prettyprinter.Render.Text (renderStrict)

ppCodeLines :: [CodeLine] -> Text
ppCodeLines :: [CodeLine] -> Text
ppCodeLines =
  (CodeLine -> Doc Any) -> [CodeLine] -> [Doc Any]
forall a b. (a -> b) -> [a] -> [b]
map CodeLine -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. CodeLine -> Doc ann
pretty
    ([CodeLine] -> [Doc Any])
-> ([Doc Any] -> Text) -> [CodeLine] -> Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Doc Any] -> Doc Any
forall ann. [Doc ann] -> Doc ann
vsep
    ([Doc Any] -> Doc Any) -> (Doc Any -> Text) -> [Doc Any] -> Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Doc Any -> SimpleDocStream Any
forall ann1 ann2. Doc ann1 -> SimpleDocStream ann2
layoutCompact
    (Doc Any -> SimpleDocStream Any)
-> (SimpleDocStream Any -> Text) -> Doc Any -> Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict

data CodeLine
  = LabeledDirectiveCodeLine Label Directive
  | LabelCodeLine Label
  | InstructionCodeLine Instruction
  | DirectiveCodeLine Directive

instance Pretty CodeLine where
  pretty :: forall ann. CodeLine -> Doc ann
pretty (LabeledDirectiveCodeLine Label
l Directive
d) = Label -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Label -> Doc ann
pretty Label
l Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Directive -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Directive -> Doc ann
pretty Directive
d
  pretty (LabelCodeLine Label
l) = Label -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Label -> Doc ann
pretty Label
l
  pretty (InstructionCodeLine Instruction
i) = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (Instruction -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Instruction -> Doc ann
pretty Instruction
i)
  pretty (DirectiveCodeLine Directive
d) = Directive -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Directive -> Doc ann
pretty Directive
d

newtype Label = Label Text

instance Pretty Label where
  pretty :: forall ann. Label -> Doc ann
pretty (Label Text
txt) = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
txt Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon

data Instruction = Instruction OpCode [Operand]

instance Pretty Instruction where
  pretty :: forall ann. Instruction -> Doc ann
pretty (Instruction OpCode
opCode [Operand]
args) = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ OpCode -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. OpCode -> Doc ann
pretty OpCode
opCode Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
comma (Operand -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Operand -> Doc ann
pretty (Operand -> Doc ann) -> [Operand] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Operand]
args)

data Directive
  = DirText
  | DirData
  | DirDWord Int64
  | DirGlobl Text

instance Pretty Directive where
  pretty :: forall ann. Directive -> Doc ann
pretty Directive
DirText = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
".section .text"
  pretty Directive
DirData = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
".section .data"
  pretty (DirDWord Int64
initVal) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
".dword" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int64 -> Doc ann
forall ann. Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
initVal
  pretty (DirGlobl Text
name) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
".globl" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
name

data OpCode
  = And
  | Or
  | Add
  | Sub
  | Mul
  | Neg
  | Seqz
  | Snez
  | Slt
  | Sd
  | Ld
  | Li
  | La
  | Addi
  | Beqz
  | J
  | Call
  | Ret
  deriving (Int -> OpCode -> ShowS
[OpCode] -> ShowS
OpCode -> String
(Int -> OpCode -> ShowS)
-> (OpCode -> String) -> ([OpCode] -> ShowS) -> Show OpCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpCode -> ShowS
showsPrec :: Int -> OpCode -> ShowS
$cshow :: OpCode -> String
show :: OpCode -> String
$cshowList :: [OpCode] -> ShowS
showList :: [OpCode] -> ShowS
Show)

instance Pretty OpCode where
  pretty :: forall ann. OpCode -> Doc ann
pretty OpCode
opCode = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpCode -> String
forall a. Show a => a -> String
show OpCode
opCode

data Operand
  = Immediate Int64
  | Register Register
  | RegisterWithOffset Register Offset
  | Symbol Text
  deriving (Operand -> Operand -> Bool
(Operand -> Operand -> Bool)
-> (Operand -> Operand -> Bool) -> Eq Operand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Operand -> Operand -> Bool
== :: Operand -> Operand -> Bool
$c/= :: Operand -> Operand -> Bool
/= :: Operand -> Operand -> Bool
Eq, Eq Operand
Eq Operand
-> (Operand -> Operand -> Ordering)
-> (Operand -> Operand -> Bool)
-> (Operand -> Operand -> Bool)
-> (Operand -> Operand -> Bool)
-> (Operand -> Operand -> Bool)
-> (Operand -> Operand -> Operand)
-> (Operand -> Operand -> Operand)
-> Ord Operand
Operand -> Operand -> Bool
Operand -> Operand -> Ordering
Operand -> Operand -> Operand
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Operand -> Operand -> Ordering
compare :: Operand -> Operand -> Ordering
$c< :: Operand -> Operand -> Bool
< :: Operand -> Operand -> Bool
$c<= :: Operand -> Operand -> Bool
<= :: Operand -> Operand -> Bool
$c> :: Operand -> Operand -> Bool
> :: Operand -> Operand -> Bool
$c>= :: Operand -> Operand -> Bool
>= :: Operand -> Operand -> Bool
$cmax :: Operand -> Operand -> Operand
max :: Operand -> Operand -> Operand
$cmin :: Operand -> Operand -> Operand
min :: Operand -> Operand -> Operand
Ord)

pattern Memory :: Offset -> Operand
pattern $mMemory :: forall {r}. Operand -> (Int64 -> r) -> ((# #) -> r) -> r
$bMemory :: Int64 -> Operand
Memory offset = RegisterWithOffset Sp offset

instance Pretty Operand where
  pretty :: forall ann. Operand -> Doc ann
pretty (Immediate Int64
i) = Int64 -> Doc ann
forall ann. Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
i
  pretty (Register Register
r) = Register -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Register -> Doc ann
pretty Register
r
  pretty (RegisterWithOffset Register
r Int64
o) = Int64 -> Doc ann
forall ann. Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int64
dword Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
o) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Register -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Register -> Doc ann
pretty Register
r)
  pretty (Symbol Text
t) = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t

type Offset = Int64

data Register
  = Zero -- zero == x0
  | Ra -- ra == x1
  | Sp -- sp == x2
  | Gp -- gp == x3
  | Tp -- tp == x4
  | T0 -- t0 == x5
  | T1 -- t1 == x6
  | T2 -- t2 == x7
  | S0 -- s0 == x8
  | S1 -- s1 == x9
  | A0 -- a0 == x10
  | A1 -- a1 == x11
  | A2 -- a2 == x12
  | A3 -- a3 == x13
  | A4 -- a4 == x14
  | A5 -- a5 == x15
  | A6 -- a6 == x16
  | A7 -- a7 == x17
  | S2 -- s2 == x18
  | S3 -- s3 == x19
  | S4 -- s4 == x20
  | S5 -- s5 == x21
  | S6 -- s6 == x22
  | S7 -- s7 == x23
  | S8 -- s8 == x24
  | S9 -- s9 == x25
  | S10 -- s10 == x26
  | S11 -- s11 == x27
  | T3 -- t3 == x28
  | T4 -- t4 == x29
  | T5 -- t5 == x30
  | T6 -- t6 == x31
  deriving (Register -> Register -> Bool
(Register -> Register -> Bool)
-> (Register -> Register -> Bool) -> Eq Register
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Register -> Register -> Bool
== :: Register -> Register -> Bool
$c/= :: Register -> Register -> Bool
/= :: Register -> Register -> Bool
Eq, Eq Register
Eq Register
-> (Register -> Register -> Ordering)
-> (Register -> Register -> Bool)
-> (Register -> Register -> Bool)
-> (Register -> Register -> Bool)
-> (Register -> Register -> Bool)
-> (Register -> Register -> Register)
-> (Register -> Register -> Register)
-> Ord Register
Register -> Register -> Bool
Register -> Register -> Ordering
Register -> Register -> Register
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Register -> Register -> Ordering
compare :: Register -> Register -> Ordering
$c< :: Register -> Register -> Bool
< :: Register -> Register -> Bool
$c<= :: Register -> Register -> Bool
<= :: Register -> Register -> Bool
$c> :: Register -> Register -> Bool
> :: Register -> Register -> Bool
$c>= :: Register -> Register -> Bool
>= :: Register -> Register -> Bool
$cmax :: Register -> Register -> Register
max :: Register -> Register -> Register
$cmin :: Register -> Register -> Register
min :: Register -> Register -> Register
Ord, Int -> Register -> ShowS
[Register] -> ShowS
Register -> String
(Int -> Register -> ShowS)
-> (Register -> String) -> ([Register] -> ShowS) -> Show Register
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Register -> ShowS
showsPrec :: Int -> Register -> ShowS
$cshow :: Register -> String
show :: Register -> String
$cshowList :: [Register] -> ShowS
showList :: [Register] -> ShowS
Show)

instance Pretty Register where
  pretty :: forall ann. Register -> Doc ann
pretty Register
opCode = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Register -> String
forall a. Show a => a -> String
show Register
opCode

dword :: Int64
dword :: Int64
dword = Int64
8