{-# LANGUAGE ScopedTypeVariables #-}

module GHC.CmmToAsm.RV64.Ppr (pprNatCmmDecl, pprInstr) where

import GHC.Cmm hiding (topInfoTable)
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Cmm.Dataflow.Label
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Ppr
import GHC.CmmToAsm.RV64.Cond
import GHC.CmmToAsm.RV64.Instr
import GHC.CmmToAsm.RV64.Regs
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Utils
import GHC.Platform
import GHC.Platform.Reg
import GHC.Prelude hiding (EQ)
import GHC.Types.Basic (Alignment, alignmentBytes, mkAlignment)
import GHC.Types.Unique (getUnique, pprUniqueAlways)
import GHC.Utils.Outputable
import GHC.Utils.Panic

pprNatCmmDecl :: forall doc. (IsDoc doc) => NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc
pprNatCmmDecl config (CmmData section dats) =
  pprSectionAlign config section $$ pprDatas config dats
pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
  let platform = ncgPlatform config

      pprProcAlignment :: doc
      pprProcAlignment = maybe empty (pprAlign . mkAlignment) (ncgProcAlignment config)
   in pprProcAlignment
        $$ case topInfoTable proc of
          Nothing ->
            -- special case for code without info table:
            pprSectionAlign config (Section Text lbl)
              $$
              -- do not
              -- pprProcAlignment config $$
              pprLabel platform lbl
              $$ vcat (map (pprBasicBlock config top_info) blocks) -- blocks guaranteed not null, so label needed
              $$ ppWhen
                (ncgDwarfEnabled config)
                (line (pprBlockEndLabel platform lbl) $$ line (pprProcEndLabel platform lbl))
              $$ pprSizeDecl platform lbl
          Just (CmmStaticsRaw info_lbl _) ->
            pprSectionAlign config (Section Text info_lbl)
              $$
              -- pprProcAlignment config $$
              ( if platformHasSubsectionsViaSymbols platform
                  then line (pprAsmLabel platform (mkDeadStripPreventer info_lbl) <> char ':')
                  else empty
              )
              $$ vcat (map (pprBasicBlock config top_info) blocks)
              $$ ppWhen (ncgDwarfEnabled config) (line (pprProcEndLabel platform info_lbl))
              $$
              -- above: Even the first block gets a label, because with branch-chain
              -- elimination, it might be the target of a goto.
              ( if platformHasSubsectionsViaSymbols platform
                  then -- See Note [Subsections Via Symbols]

                    line
                      $ text "\t.long "
                      <+> pprAsmLabel platform info_lbl
                      <+> char '-'
                      <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl)
                  else empty
              )
              $$ pprSizeDecl platform info_lbl
{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc #-}
{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

pprLabel :: (IsDoc doc) => Platform -> CLabel -> doc
pprLabel platform lbl =
  pprGloblDecl platform lbl
    $$ pprTypeDecl platform lbl
    $$ line (pprAsmLabel platform lbl <> char ':')

pprAlign :: (IsDoc doc) => Alignment -> doc
pprAlign alignment =
  -- "The .align directive for RISC-V is an alias to .p2align, which aligns to a
  -- power of two, so .align 2 means align to 4 bytes. Because the definition of
  -- the .align directive varies by architecture, it is recommended to use the
  -- unambiguous .p2align or .balign directives instead."
  -- (https://github.com/riscv-non-isa/riscv-asm-manual/blob/main/riscv-asm.md#-align)
  line $ text "\t.balign " <> int (alignmentBytes alignment)

-- | Print appropriate alignment for the given section type.
--
-- Currently, this always aligns to a full machine word (8 byte.) A future
-- improvement could be to really do this per section type (though, it's
-- probably not a big gain.)
pprAlignForSection :: (IsDoc doc) => SectionType -> doc
pprAlignForSection _seg = pprAlign . mkAlignment $ 8

-- | Print section header and appropriate alignment for that section.
--
-- This will e.g. emit a header like:
--
--     .section .text
--     .balign 8
pprSectionAlign :: (IsDoc doc) => NCGConfig -> Section -> doc
pprSectionAlign _config (Section (OtherSection _) _) =
  panic "RV64.Ppr.pprSectionAlign: unknown section"
pprSectionAlign config sec@(Section seg _) =
  line (pprSectionHeader config sec)
    $$ pprAlignForSection seg

pprProcEndLabel ::
  (IsLine doc) =>
  Platform ->
  -- | Procedure name
  CLabel ->
  doc
pprProcEndLabel platform lbl =
  pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> colon

pprBlockEndLabel ::
  (IsLine doc) =>
  Platform ->
  -- | Block name
  CLabel ->
  doc
pprBlockEndLabel platform lbl =
  pprAsmLabel platform (mkAsmTempEndLabel lbl) <> colon

-- | Output the ELF .size directive (if needed.)
pprSizeDecl :: (IsDoc doc) => Platform -> CLabel -> doc
pprSizeDecl platform lbl
  | osElfTarget (platformOS platform) =
      line $ text "\t.size" <+> asmLbl <> text ", .-" <> asmLbl
  where
    asmLbl = pprAsmLabel platform lbl
pprSizeDecl _ _ = empty

pprBasicBlock ::
  (IsDoc doc) =>
  NCGConfig ->
  LabelMap RawCmmStatics ->
  NatBasicBlock Instr ->
  doc
pprBasicBlock config info_env (BasicBlock blockid instrs) =
  maybe_infotable
    $ pprLabel platform asmLbl
    $$ vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs))
    $$ ppWhen
      (ncgDwarfEnabled config)
      ( -- Emit both end labels since this may end up being a standalone
        -- top-level block
        line
          ( pprBlockEndLabel platform asmLbl
              <> pprProcEndLabel platform asmLbl
          )
      )
  where
    -- TODO: Check if we can  filter more instructions here.
    -- TODO: Shouldn't this be a more general check on a higher level?
    -- Filter out identity moves. E.g. mov x18, x18 will be dropped.
    optInstrs = filter f instrs
      where
        f (MOV o1 o2) | o1 == o2 = False
        f _ = True

    asmLbl = blockLbl blockid
    platform = ncgPlatform config
    maybe_infotable c = case mapLookup blockid info_env of
      Nothing -> c
      Just (CmmStaticsRaw info_lbl info) ->
        --  pprAlignForSection platform Text $$
        infoTableLoc
          $$ vcat (map (pprData config) info)
          $$ pprLabel platform info_lbl
          $$ c
          $$ ppWhen
            (ncgDwarfEnabled config)
            (line (pprBlockEndLabel platform info_lbl))
    -- Make sure the info table has the right .loc for the block
    -- coming right after it. See Note [Info Offset]
    infoTableLoc = case instrs of
      (l@LOCATION {} : _) -> pprInstr platform l
      _other -> empty

pprDatas :: (IsDoc doc) => NCGConfig -> RawCmmStatics -> doc
-- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
pprDatas config (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
  | lbl == mkIndStaticInfoLabel,
    let labelInd (CmmLabelOff l _) = Just l
        labelInd (CmmLabel l) = Just l
        labelInd _ = Nothing,
    Just ind' <- labelInd ind,
    alias `mayRedirectTo` ind' =
      pprGloblDecl (ncgPlatform config) alias
        $$ line (text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind')
pprDatas config (CmmStaticsRaw lbl dats) =
  vcat (pprLabel platform lbl : map (pprData config) dats)
  where
    platform = ncgPlatform config

pprData :: (IsDoc doc) => NCGConfig -> CmmStatic -> doc
pprData _config (CmmString str) = line (pprString str)
pprData _config (CmmFileEmbed path _) = line (pprFileEmbed path)
-- TODO: AFAIK there no Darwin for RISCV, so we may consider to simplify this.
pprData config (CmmUninitialised bytes) =
  line
    $ let platform = ncgPlatform config
       in if platformOS platform == OSDarwin
            then text ".space " <> int bytes
            else text ".skip " <> int bytes
pprData config (CmmStaticLit lit) = pprDataItem config lit

pprGloblDecl :: (IsDoc doc) => Platform -> CLabel -> doc
pprGloblDecl platform lbl
  | not (externallyVisibleCLabel lbl) = empty
  | otherwise = line (text "\t.globl " <> pprAsmLabel platform lbl)

-- Note [Always use objects for info tables]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- See discussion in X86.Ppr for why this is necessary.  Essentially we need to
-- ensure that we never pass function symbols when we might want to lookup the
-- info table.  If we did, we could end up with procedure linking tables
-- (PLT)s, and thus the lookup wouldn't point to the function, but into the
-- jump table.
--
-- Fun fact: The LLVMMangler exists to patch this issue on the LLVM side as
-- well.
pprLabelType' :: (IsLine doc) => Platform -> CLabel -> doc
pprLabelType' platform lbl =
  if isCFunctionLabel lbl || functionOkInfoTable
    then text "@function"
    else text "@object"
  where
    functionOkInfoTable =
      platformTablesNextToCode platform
        && isInfoTableLabel lbl
        && not (isCmmInfoTableLabel lbl)
        && not (isConInfoTableLabel lbl)

-- this is called pprTypeAndSizeDecl in PPC.Ppr
pprTypeDecl :: (IsDoc doc) => Platform -> CLabel -> doc
pprTypeDecl platform lbl =
  if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
    then line (text ".type " <> pprAsmLabel platform lbl <> text ", " <> pprLabelType' platform lbl)
    else empty

pprDataItem :: (IsDoc doc) => NCGConfig -> CmmLit -> doc
pprDataItem config lit =
  lines_ (ppr_item (cmmTypeFormat $ cmmLitType platform lit) lit)
  where
    platform = ncgPlatform config

    imm = litToImm lit

    ppr_item II8 _ = [text "\t.byte\t" <> pprDataImm platform imm]
    ppr_item II16 _ = [text "\t.short\t" <> pprDataImm platform imm]
    ppr_item II32 _ = [text "\t.long\t" <> pprDataImm platform imm]
    ppr_item II64 _ = [text "\t.quad\t" <> pprDataImm platform imm]
    ppr_item FF32 (CmmFloat r _) =
      let bs = floatToBytes (fromRational r)
       in map (\b -> text "\t.byte\t" <> int (fromIntegral b)) bs
    ppr_item FF64 (CmmFloat r _) =
      let bs = doubleToBytes (fromRational r)
       in map (\b -> text "\t.byte\t" <> int (fromIntegral b)) bs
    ppr_item _ _ = pprPanic "pprDataItem:ppr_item" (text $ show lit)

-- | Pretty print an immediate value in the @data@ section
--
-- This does not include any checks. We rely on the Assembler to check for
-- errors. Use `pprOpImm` for immediates in instructions (operands.)
pprDataImm :: (IsLine doc) => Platform -> Imm -> doc
pprDataImm _ (ImmInt i) = int i
pprDataImm _ (ImmInteger i) = integer i
pprDataImm p (ImmCLbl l) = pprAsmLabel p l
pprDataImm p (ImmIndex l i) = pprAsmLabel p l <> char '+' <> int i
pprDataImm _ (ImmLit s) = ftext s
pprDataImm _ (ImmFloat f) = float (fromRational f)
pprDataImm _ (ImmDouble d) = double (fromRational d)
pprDataImm p (ImmConstantSum a b) = pprDataImm p a <> char '+' <> pprDataImm p b
pprDataImm p (ImmConstantDiff a b) =
  pprDataImm p a
    <> char '-'
    <> lparen
    <> pprDataImm p b
    <> rparen

-- | Comment @c@ with @# c@
asmComment :: SDoc -> SDoc
asmComment c = text "#" <+> c

-- | Commen @c@ with @// c@
asmDoubleslashComment :: SDoc -> SDoc
asmDoubleslashComment c = text "//" <+> c

-- | Comment @c@ with @/* c */@ (multiline comment)
asmMultilineComment :: SDoc -> SDoc
asmMultilineComment c = text "/*" $+$ c $+$ text "*/"

-- | Pretty print an immediate operand of an instruction
--
-- The kinds of immediates we can use here is pretty limited: RISCV doesn't
-- support index expressions (as e.g. Aarch64 does.) Floating points need to
-- fit in range. As we don't need them, forbit them to save us from future
-- troubles.
pprOpImm :: (IsLine doc) => Platform -> Imm -> doc
pprOpImm platform im = case im of
  ImmInt i -> int i
  ImmInteger i -> integer i
  ImmCLbl l -> char '=' <> pprAsmLabel platform l
  _ -> pprPanic "RV64.Ppr.pprOpImm" (text "Unsupported immediate for instruction operands" <> colon <+> (text . show) im)

-- | Negate integer immediate operand
--
-- This function is partial and will panic if the operand is not an integer.
negOp :: Operand -> Operand
negOp (OpImm (ImmInt i)) = OpImm (ImmInt (negate i))
negOp (OpImm (ImmInteger i)) = OpImm (ImmInteger (negate i))
negOp op = pprPanic "RV64.negOp" (text $ show op)

-- | Pretty print an operand
pprOp :: (IsLine doc) => Platform -> Operand -> doc
pprOp plat op = case op of
  OpReg w r -> pprReg w r
  OpImm im -> pprOpImm plat im
  OpAddr (AddrRegImm r1 im) -> pprOpImm plat im <> char '(' <> pprReg W64 r1 <> char ')'
  OpAddr (AddrReg r1) -> text "0(" <+> pprReg W64 r1 <+> char ')'

-- | Pretty print register with calling convention name
--
-- This representation makes it easier to reason about the emitted assembly
-- code.
pprReg :: forall doc. (IsLine doc) => Width -> Reg -> doc
pprReg w r = case r of
  RegReal (RealRegSingle i) -> ppr_reg_no i
  -- virtual regs should not show up, but this is helpful for debugging.
  RegVirtual (VirtualRegI u) -> text "%vI_" <> pprUniqueAlways u
  RegVirtual (VirtualRegD u) -> text "%vD_" <> pprUniqueAlways u
  _ -> pprPanic "RiscV64.pprReg" (text (show r) <+> ppr w)
  where
    ppr_reg_no :: Int -> doc
    -- General Purpose Registers
    ppr_reg_no 0 = text "zero"
    ppr_reg_no 1 = text "ra"
    ppr_reg_no 2 = text "sp"
    ppr_reg_no 3 = text "gp"
    ppr_reg_no 4 = text "tp"
    ppr_reg_no 5 = text "t0"
    ppr_reg_no 6 = text "t1"
    ppr_reg_no 7 = text "t2"
    ppr_reg_no 8 = text "s0"
    ppr_reg_no 9 = text "s1"
    ppr_reg_no 10 = text "a0"
    ppr_reg_no 11 = text "a1"
    ppr_reg_no 12 = text "a2"
    ppr_reg_no 13 = text "a3"
    ppr_reg_no 14 = text "a4"
    ppr_reg_no 15 = text "a5"
    ppr_reg_no 16 = text "a6"
    ppr_reg_no 17 = text "a7"
    ppr_reg_no 18 = text "s2"
    ppr_reg_no 19 = text "s3"
    ppr_reg_no 20 = text "s4"
    ppr_reg_no 21 = text "s5"
    ppr_reg_no 22 = text "s6"
    ppr_reg_no 23 = text "s7"
    ppr_reg_no 24 = text "s8"
    ppr_reg_no 25 = text "s9"
    ppr_reg_no 26 = text "s10"
    ppr_reg_no 27 = text "s11"
    ppr_reg_no 28 = text "t3"
    ppr_reg_no 29 = text "t4"
    ppr_reg_no 30 = text "t5"
    ppr_reg_no 31 = text "t6"
    -- Floating Point Registers
    ppr_reg_no 32 = text "ft0"
    ppr_reg_no 33 = text "ft1"
    ppr_reg_no 34 = text "ft2"
    ppr_reg_no 35 = text "ft3"
    ppr_reg_no 36 = text "ft4"
    ppr_reg_no 37 = text "ft5"
    ppr_reg_no 38 = text "ft6"
    ppr_reg_no 39 = text "ft7"
    ppr_reg_no 40 = text "fs0"
    ppr_reg_no 41 = text "fs1"
    ppr_reg_no 42 = text "fa0"
    ppr_reg_no 43 = text "fa1"
    ppr_reg_no 44 = text "fa2"
    ppr_reg_no 45 = text "fa3"
    ppr_reg_no 46 = text "fa4"
    ppr_reg_no 47 = text "fa5"
    ppr_reg_no 48 = text "fa6"
    ppr_reg_no 49 = text "fa7"
    ppr_reg_no 50 = text "fs2"
    ppr_reg_no 51 = text "fs3"
    ppr_reg_no 52 = text "fs4"
    ppr_reg_no 53 = text "fs5"
    ppr_reg_no 54 = text "fs6"
    ppr_reg_no 55 = text "fs7"
    ppr_reg_no 56 = text "fs8"
    ppr_reg_no 57 = text "fs9"
    ppr_reg_no 58 = text "fs10"
    ppr_reg_no 59 = text "fs11"
    ppr_reg_no 60 = text "ft8"
    ppr_reg_no 61 = text "ft9"
    ppr_reg_no 62 = text "ft10"
    ppr_reg_no 63 = text "ft11"
    ppr_reg_no i
      | i < 0 = pprPanic "Unexpected register number (min is 0)" (ppr w <+> int i)
      | i > 63 = pprPanic "Unexpected register number (max is 63)" (ppr w <+> int i)
      -- no support for widths > W64.
      | otherwise = pprPanic "Unsupported width in register (max is 64)" (ppr w <+> int i)

-- | Single precission `Operand` (floating-point)
isSingleOp :: Operand -> Bool
isSingleOp (OpReg W32 _) = True
isSingleOp _ = False

-- | Double precission `Operand` (floating-point)
isDoubleOp :: Operand -> Bool
isDoubleOp (OpReg W64 _) = True
isDoubleOp _ = False

-- | `Operand` is an immediate value
isImmOp :: Operand -> Bool
isImmOp (OpImm _) = True
isImmOp _ = False

-- | `Operand` is an immediate @0@ value
isImmZero :: Operand -> Bool
isImmZero (OpImm (ImmFloat 0)) = True
isImmZero (OpImm (ImmDouble 0)) = True
isImmZero (OpImm (ImmInt 0)) = True
isImmZero _ = False

-- | `Target` represents a label
isLabel :: Target -> Bool
isLabel (TBlock _) = True
isLabel _ = False

-- | Get the pretty-printed label from a `Target`
--
-- This function is partial and will panic if the `Target` is not a label.
getLabel :: (IsLine doc) => Platform -> Target -> doc
getLabel platform (TBlock bid) = pprBlockId platform bid
  where
    pprBlockId :: (IsLine doc) => Platform -> BlockId -> doc
    pprBlockId platform bid = pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
getLabel _platform _other = panic "Cannot turn this into a label"

-- | Pretty-print an `Instr`
--
-- This function is partial and will panic if the `Instr` is not supported. This
-- can happen due to invalid operands or unexpected meta instructions.
pprInstr :: (IsDoc doc) => Platform -> Instr -> doc
pprInstr platform instr = case instr of
  -- see Note [dualLine and dualDoc] in GHC.Utils.Outputable
  COMMENT s -> dualDoc (asmComment s) empty
  MULTILINE_COMMENT s -> dualDoc (asmMultilineComment s) empty
  ANN d i -> dualDoc (pprInstr platform i <+> asmDoubleslashComment d) (pprInstr platform i)
  LOCATION file line' col _name ->
    line (text "\t.loc" <+> int file <+> int line' <+> int col)
  DELTA d -> dualDoc (asmComment $ text "\tdelta = " <> int d) empty
  NEWBLOCK _ -> panic "PprInstr: NEWBLOCK"
  LDATA _ _ -> panic "pprInstr: LDATA"
  PUSH_STACK_FRAME ->
    lines_
      [ text "\taddi sp, sp, -16",
        text "\tsd x1, 8(sp)", -- store RA
        text "\tsd x8, 0(sp)", -- store FP/s0
        text "\taddi x8, sp, 16"
      ]
  POP_STACK_FRAME ->
    lines_
      [ text "\tld x8, 0(sp)", -- restore FP/s0
        text "\tld x1, 8(sp)", -- restore RA
        text "\taddi sp, sp, 16"
      ]
  ADD o1 o2 o3
    | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfadd." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3
    -- This case is used for sign extension: SEXT.W op
    | OpReg W64 _ <- o1, OpReg W32 _ <- o2, isImmOp o3 -> op3 (text "\taddiw") o1 o2 o3
    | otherwise -> op3 (text "\tadd") o1 o2 o3
  MUL o1 o2 o3
    | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfmul." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3
    | otherwise -> op3 (text "\tmul") o1 o2 o3
  MULH o1 o2 o3 -> op3 (text "\tmulh") o1 o2 o3
  NEG o1 o2 | isFloatOp o1 && isFloatOp o2 && isSingleOp o2 -> op2 (text "\tfneg.s") o1 o2
  NEG o1 o2 | isFloatOp o1 && isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tfneg.d") o1 o2
  NEG o1 o2 -> op2 (text "\tneg") o1 o2
  DIV o1 o2 o3
    | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 ->
        -- TODO: This must (likely) be refined regarding width
        op3 (text "\tfdiv." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3
  DIV o1 o2 o3 -> op3 (text "\tdiv") o1 o2 o3
  REM o1 o2 o3
    | isFloatOp o1 || isFloatOp o2 || isFloatOp o3 ->
        panic "pprInstr - REM not implemented for floats (yet)"
  REM o1 o2 o3 -> op3 (text "\trem") o1 o2 o3
  REMU o1 o2 o3 -> op3 (text "\tremu") o1 o2 o3
  SUB o1 o2 o3
    | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfsub." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3
    | isImmOp o3 -> op3 (text "\taddi") o1 o2 (negOp o3)
    | otherwise -> op3 (text "\tsub") o1 o2 o3
  DIVU o1 o2 o3 -> op3 (text "\tdivu") o1 o2 o3
  AND o1 o2 o3
    | isImmOp o3 -> op3 (text "\tandi") o1 o2 o3
    | otherwise -> op3 (text "\tand") o1 o2 o3
  OR o1 o2 o3 -> op3 (text "\tor") o1 o2 o3
  SRA o1 o2 o3 | isImmOp o3 -> op3 (text "\tsrai") o1 o2 o3
  SRA o1 o2 o3 -> op3 (text "\tsra") o1 o2 o3
  XOR o1 o2 o3 -> op3 (text "\txor") o1 o2 o3
  SLL o1 o2 o3 -> op3 (text "\tsll") o1 o2 o3
  SRL o1 o2 o3 -> op3 (text "\tsrl") o1 o2 o3
  MOV o1 o2
    | isFloatOp o1 && isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tfmv.d") o1 o2 -- fmv.d rd, rs is pseudo op fsgnj.d rd, rs, rs
    | isFloatOp o1 && isFloatOp o2 && isSingleOp o2 -> op2 (text "\tfmv.s") o1 o2 -- fmv.s rd, rs is pseudo op fsgnj.s rd, rs, rs
    | isFloatOp o1 && isImmZero o2 && isDoubleOp o1 -> op2 (text "\tfcvt.d.w") o1 zero
    | isFloatOp o1 && isImmZero o2 && isSingleOp o1 -> op2 (text "\tfcvt.s.w") o1 zero
    | isFloatOp o1 && not (isFloatOp o2) && isSingleOp o1 -> op2 (text "\tfmv.w.x") o1 o2
    | isFloatOp o1 && not (isFloatOp o2) && isDoubleOp o1 -> op2 (text "\tfmv.d.x") o1 o2
    | not (isFloatOp o1) && isFloatOp o2 && isSingleOp o2 -> op2 (text "\tfmv.x.w") o1 o2
    | not (isFloatOp o1) && isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tfmv.x.d") o1 o2
    | (OpImm (ImmInteger i)) <- o2,
      fitsIn12bitImm i ->
        lines_ [text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <> comma <+> pprOp platform o2]
    | (OpImm (ImmInt i)) <- o2,
      fitsIn12bitImm i ->
        lines_ [text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <> comma <+> pprOp platform o2]
    | (OpImm (ImmInteger i)) <- o2,
      fitsIn32bits i ->
        lines_
          [ text "\tlui" <+> pprOp platform o1 <> comma <+> text "%hi(" <> pprOp platform o2 <> text ")",
            text "\taddw" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%lo(" <> pprOp platform o2 <> text ")"
          ]
    | (OpImm (ImmInt i)) <- o2,
      fitsIn32bits i ->
        lines_
          [ text "\tlui" <+> pprOp platform o1 <> comma <+> text "%hi(" <> pprOp platform o2 <> text ")",
            text "\taddw" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%lo(" <> pprOp platform o2 <> text ")"
          ]
    | isImmOp o2 ->
        -- Surrender! Let the assembler figure out the right expressions with pseudo-op LI.
        lines_ [text "\tli" <+> pprOp platform o1 <> comma <+> pprOp platform o2]
    | otherwise -> op3 (text "\taddi") o1 o2 (OpImm (ImmInt 0))
  ORI o1 o2 o3 -> op3 (text "\tori") o1 o2 o3
  XORI o1 o2 o3 -> op3 (text "\txori") o1 o2 o3
  J_TBL _ _ r -> pprInstr platform (B (TReg r))
  B l | isLabel l -> line $ text "\tjal" <+> pprOp platform x0 <> comma <+> getLabel platform l
  B (TReg r) -> line $ text "\tjalr" <+> pprOp platform x0 <> comma <+> pprReg W64 r <> comma <+> text "0"
  BL r _ -> line $ text "\tjalr" <+> text "x1" <> comma <+> pprReg W64 r <> comma <+> text "0"
  BCOND c l r t
    | isLabel t ->
        line $ text "\t" <> pprBcond c <+> pprOp platform l <> comma <+> pprOp platform r <> comma <+> getLabel platform t
  BCOND _ _ _ (TReg _) -> panic "RV64.ppr: No conditional branching to registers!"
  CSET o l r c -> case c of
    EQ
      | isIntOp l && isIntOp r ->
          lines_
            [ subFor l r,
              text "\tseqz" <+> pprOp platform o <> comma <+> pprOp platform o
            ]
    EQ | isFloatOp l && isFloatOp r -> line $ binOp ("\tfeq." ++ floatOpPrecision platform l r)
    NE
      | isIntOp l && isIntOp r ->
          lines_
            [ subFor l r,
              text "\tsnez" <+> pprOp platform o <> comma <+> pprOp platform o
            ]
    NE
      | isFloatOp l && isFloatOp r ->
          lines_
            [ binOp ("\tfeq." ++ floatOpPrecision platform l r),
              text "\txori" <+> pprOp platform o <> comma <+> pprOp platform o <> comma <+> text "1"
            ]
    SLT -> lines_ [sltFor l r <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform r]
    SLE ->
      lines_
        [ sltFor l r <+> pprOp platform o <> comma <+> pprOp platform r <> comma <+> pprOp platform l,
          text "\txori" <+> pprOp platform o <> comma <+> pprOp platform o <> comma <+> text "1"
        ]
    SGE ->
      lines_
        [ sltFor l r <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform r,
          text "\txori" <+> pprOp platform o <> comma <+> pprOp platform o <> comma <+> text "1"
        ]
    SGT -> lines_ [sltFor l r <+> pprOp platform o <> comma <+> pprOp platform r <> comma <+> pprOp platform l]
    ULT -> lines_ [sltuFor l r <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform r]
    ULE ->
      lines_
        [ sltuFor l r <+> pprOp platform o <> comma <+> pprOp platform r <> comma <+> pprOp platform l,
          text "\txori" <+> pprOp platform o <> comma <+> pprOp platform o <> comma <+> text "1"
        ]
    UGE ->
      lines_
        [ sltuFor l r <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform r,
          text "\txori" <+> pprOp platform o <> comma <+> pprOp platform o <> comma <+> text "1"
        ]
    UGT -> lines_ [sltuFor l r <+> pprOp platform o <> comma <+> pprOp platform r <> comma <+> pprOp platform l]
    FLT | isFloatOp l && isFloatOp r -> line $ binOp ("\tflt." ++ floatOpPrecision platform l r)
    FLE | isFloatOp l && isFloatOp r -> line $ binOp ("\tfle." ++ floatOpPrecision platform l r)
    FGT | isFloatOp l && isFloatOp r -> line $ binOp ("\tfgt." ++ floatOpPrecision platform l r)
    FGE | isFloatOp l && isFloatOp r -> line $ binOp ("\tfge." ++ floatOpPrecision platform l r)
    x -> pprPanic "RV64.ppr: unhandled CSET conditional" (text (show x) <+> pprOp platform o <> comma <+> pprOp platform r <> comma <+> pprOp platform l)
    where
      subFor l r
        | (OpImm _) <- r = text "\taddi" <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform (negOp r)
        | (OpImm _) <- l = panic "RV64.ppr: Cannot SUB IMM _"
        | otherwise = text "\tsub" <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform r
      sltFor l r
        | (OpImm _) <- r = text "\tslti"
        | (OpImm _) <- l = panic "PV64.ppr: Cannot SLT IMM _"
        | otherwise = text "\tslt"
      sltuFor l r
        | (OpImm _) <- r = text "\tsltui"
        | (OpImm _) <- l = panic "PV64.ppr: Cannot SLTU IMM _"
        | otherwise = text "\tsltu"
      binOp :: (IsLine doc) => String -> doc
      binOp op = text op <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform r
  STR II8 o1 o2 -> op2 (text "\tsb") o1 o2
  STR II16 o1 o2 -> op2 (text "\tsh") o1 o2
  STR II32 o1 o2 -> op2 (text "\tsw") o1 o2
  STR II64 o1 o2 -> op2 (text "\tsd") o1 o2
  STR FF32 o1 o2 -> op2 (text "\tfsw") o1 o2
  STR FF64 o1 o2 -> op2 (text "\tfsd") o1 o2
  LDR _f o1 (OpImm (ImmIndex lbl off)) ->
    lines_
      [ text "\tla" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl,
        text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> int off
      ]
  LDR _f o1 (OpImm (ImmCLbl lbl)) ->
    line $ text "\tla" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl
  LDR II8 o1 o2 -> op2 (text "\tlb") o1 o2
  LDR II16 o1 o2 -> op2 (text "\tlh") o1 o2
  LDR II32 o1 o2 -> op2 (text "\tlw") o1 o2
  LDR II64 o1 o2 -> op2 (text "\tld") o1 o2
  LDR FF32 o1 o2 -> op2 (text "\tflw") o1 o2
  LDR FF64 o1 o2 -> op2 (text "\tfld") o1 o2
  LDRU II8 o1 o2 -> op2 (text "\tlbu") o1 o2
  LDRU II16 o1 o2 -> op2 (text "\tlhu") o1 o2
  LDRU II32 o1 o2 -> op2 (text "\tlwu") o1 o2
  -- double words (64bit) cannot be sign extended by definition
  LDRU II64 o1 o2 -> op2 (text "\tld") o1 o2
  LDRU FF32 o1 o2@(OpAddr (AddrReg _)) -> op2 (text "\tflw") o1 o2
  LDRU FF32 o1 o2@(OpAddr (AddrRegImm _ _)) -> op2 (text "\tflw") o1 o2
  LDRU FF64 o1 o2@(OpAddr (AddrReg _)) -> op2 (text "\tfld") o1 o2
  LDRU FF64 o1 o2@(OpAddr (AddrRegImm _ _)) -> op2 (text "\tfld") o1 o2
  LDRU f o1 o2 -> pprPanic "Unsupported unsigned load" ((text . show) f <+> pprOp platform o1 <+> pprOp platform o2)
  FENCE r w -> line $ text "\tfence" <+> pprFenceType r <> char ',' <+> pprFenceType w
  FCVT FloatToFloat o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.s.d") o1 o2
  FCVT FloatToFloat o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.d.s") o1 o2
  FCVT FloatToFloat o1 o2 ->
    pprPanic "RV64.pprInstr - impossible float to float conversion"
      $ line (pprOp platform o1 <> text "->" <> pprOp platform o2)
  FCVT IntToFloat o1@(OpReg W32 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.s.w") o1 o2
  FCVT IntToFloat o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.s.l") o1 o2
  FCVT IntToFloat o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.d.w") o1 o2
  FCVT IntToFloat o1@(OpReg W64 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.d.l") o1 o2
  FCVT IntToFloat o1 o2 ->
    pprPanic "RV64.pprInstr - impossible integer to float conversion"
      $ line (pprOp platform o1 <> text "->" <> pprOp platform o2)
  FCVT FloatToInt o1@(OpReg W32 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.w.s") o1 o2
  FCVT FloatToInt o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.w.d") o1 o2
  FCVT FloatToInt o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.l.s") o1 o2
  FCVT FloatToInt o1@(OpReg W64 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.l.d") o1 o2
  FCVT FloatToInt o1 o2 ->
    pprPanic "RV64.pprInstr - impossible float to integer conversion"
      $ line (pprOp platform o1 <> text "->" <> pprOp platform o2)
  FABS o1 o2 | isSingleOp o2 -> op2 (text "\tfabs.s") o1 o2
  FABS o1 o2 | isDoubleOp o2 -> op2 (text "\tfabs.d") o1 o2
  FMIN o1 o2 o3 | isSingleOp o1 -> op3 (text "\tfmin.s") o1 o2 o3
                | isDoubleOp o2 -> op3 (text "\tfmin.d") o1 o2 o3
  FMAX o1 o2 o3 | isSingleOp o1 -> op3 (text "\tfmax.s") o1 o2 o3
                | isDoubleOp o2 -> op3 (text "\tfmax.d") o1 o2 o3
  FMA variant d r1 r2 r3 ->
    let fma = case variant of
          FMAdd -> text "\tfmadd" <> dot <> floatPrecission d
          FMSub -> text "\tfmsub" <> dot <> floatPrecission d
          FNMAdd -> text "\tfnmadd" <> dot <> floatPrecission d
          FNMSub -> text "\tfnmsub" <> dot <> floatPrecission d
     in op4 fma d r1 r2 r3
  instr -> panic $ "RV64.pprInstr - Unknown instruction: " ++ instrCon instr
  where
    op2 op o1 o2 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2
    op3 op o1 o2 o3 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
    op4 op o1 o2 o3 o4 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
    pprFenceType FenceRead = text "r"
    pprFenceType FenceWrite = text "w"
    pprFenceType FenceReadWrite = text "rw"
    floatPrecission o
      | isSingleOp o = text "s"
      | isDoubleOp o = text "d"
      | otherwise = pprPanic "Impossible floating point precission: " (pprOp platform o)

floatOpPrecision :: Platform -> Operand -> Operand -> String
floatOpPrecision _p l r | isFloatOp l && isFloatOp r && isSingleOp l && isSingleOp r = "s" -- single precision
floatOpPrecision _p l r | isFloatOp l && isFloatOp r && isDoubleOp l && isDoubleOp r = "d" -- double precision
floatOpPrecision p l r = pprPanic "Cannot determine floating point precission" (text "op1" <+> pprOp p l <+> text "op2" <+> pprOp p r)

-- | Pretty print a conditional branch
--
-- This function is partial and will panic if the conditional is not supported;
-- i.e. if its floating point related.
pprBcond :: (IsLine doc) => Cond -> doc
pprBcond c = text "b" <> pprCond c
  where
    pprCond :: (IsLine doc) => Cond -> doc
    pprCond c = case c of
      EQ -> text "eq"
      NE -> text "ne"
      SLT -> text "lt"
      SLE -> text "le"
      SGE -> text "ge"
      SGT -> text "gt"
      ULT -> text "ltu"
      ULE -> text "leu"
      UGE -> text "geu"
      UGT -> text "gtu"
      -- BCOND cannot handle floating point comparisons / registers
      _ -> panic $ "RV64.ppr: unhandled BCOND conditional: " ++ show c