module Micro.Asm.Sdcc where

import Micro.Ast qualified as A
import Text.Parsec (SourcePos, sourceColumn, sourceLine)

toIdent :: A.Ident -> String
toIdent id = "_" ++ id

toLabel :: A.Ident -> Bool -> String
toLabel id False = toIdent id ++ "::"
toLabel id True = toIdent id ++ ":"

toData :: A.Type -> String
toData (A.Type t)
  | t == "bool" || t == "u8" || t == "s8" = ".ds 1"
  | t == "u16" || t == "s16" = ".ds 2"
  | otherwise = ".ds 2"
toData (A.FuncType _ _) = ".ds 2"

toInit :: A.Type -> A.Expr -> String
toInit (A.Type t) (A.Num v _)
  | t == "bool" || t == "u8" || t == "s8" = ".db " ++ show v
  | t == "u16" || t == "s16" = ".dw " ++ show v
  | otherwise = ".dw " ++ show v
toInit _ v = ".dw " ++ show v

posToIdent :: SourcePos -> String
posToIdent p = "l" ++ show (sourceLine p) ++ "$" ++ show (sourceColumn p)

header :: String -> [String]
header version = [";", "; File created by Micro v" ++ version ++ " (SDCC)", ";"]

module' :: String -> String
module' name = "\t.module " ++ name

optsdcc :: String
optsdcc = "\t.optsdcc -mz80"

area :: String -> String
area name = "\n\t.area " ++ name

globl :: String -> String
globl id = "\t.globl " ++ id

mul8 :: A.Expr -> A.Expr -> SourcePos -> [String]
mul8 a b p = do
  let loop = posToIdent p
  let loop0 = loop ++ "z"
  (emit a).oCode
    ++ [ "\tor a",
         "\tjr z, " ++ toIdent loop0,
         "\tld b, a",
         "\tdec b",
         "\tjr z, " ++ toIdent loop0
       ]
    ++ (emit b).oCode
    ++ [ "\tld c, a",
         toLabel loop True,
         "\tadd c",
         "\tdjnz "
           ++ toIdent loop,
         toLabel loop0 True
       ]

mul :: A.Expr -> A.Expr -> SourcePos -> [String]
mul a b@(A.Num v _) p
  | v == 2 = (emit a).oCode ++ ["\tsla a"]
  | v == 4 = (emit a).oCode ++ replicate 2 "\tsla a"
  | v == 8 = (emit a).oCode ++ replicate 3 "\tsla a"
  | v == 16 = (emit a).oCode ++ replicate 4 "\tsla a"
  | v == 32 = (emit a).oCode ++ replicate 5 "\tsla a"
  | v < 6 = (emit a).oCode ++ ["\tld c, a"] ++ replicate (fromInteger v - 1) "\tadd c"
  | otherwise = mul8 a b p
mul _ _ _ = [";; unimplemented"]

data Output = Output
  { oPre :: [String],
    oInit :: [String],
    oData :: [String],
    oCode :: [String]
  }

emit :: A.Expr -> Output
emit x =
  case x of
    (A.Module name _) -> o {oPre = [module' name, optsdcc, ""]}
    (A.Var id typ val priv False _) ->
      o
        { oPre = [globl $ toIdent id | not priv],
          oData = [toLabel id priv, "\t" ++ toData typ],
          oInit = ["__init" ++ toLabel id True, "\t" ++ toInit typ val]
        }
    (A.Num v _) -> o {oCode = ["\tld a, #" ++ show v]}
    (A.Variable id _) -> o {oCode = ["\tld a, (" ++ toIdent id ++ ")"]}
    -- cases where constant folding didn't happen
    (A.BinOp A.Plus _ (A.Num a _) (A.Num b _)) -> o {oCode = [show a ++ "+" ++ show b]}
    (A.BinOp A.Minus _ (A.Num a _) (A.Num b _)) -> o {oCode = [show a ++ "-" ++ show b]}
    (A.BinOp A.Mul _ (A.Num a _) (A.Num b _)) -> o {oCode = [show a ++ "*" ++ show b]}
    (A.BinOp A.Div _ (A.Num a _) (A.Num b _)) -> o {oCode = [show a ++ "/" ++ show b]}
    (A.BinOp A.Plus _ a (A.Num 1 _)) ->
      o {oCode = (emit a).oCode ++ ["\tinc a"]}
    (A.BinOp A.Plus _ a (A.Num v _)) ->
      o {oCode = (emit a).oCode ++ ["\tadd #" ++ show v]}
    (A.BinOp A.Plus _ a b) ->
      o {oCode = (emit a).oCode ++ ["\tld c, a"] ++ (emit b).oCode ++ ["\tadd c"]}
    (A.BinOp A.Minus _ a (A.Num 1 _)) ->
      o {oCode = (emit a).oCode ++ ["\tdec a"]}
    (A.BinOp A.Minus _ a (A.Num v _)) ->
      o {oCode = (emit a).oCode ++ ["\tsub #" ++ show v]}
    (A.BinOp A.Minus _ a b) ->
      o {oCode = (emit a).oCode ++ ["\tld c, a"] ++ (emit b).oCode ++ ["\tld b, a", "\tld a, c", "\tsub b"]}
    (A.BinOp A.Mul _ _ (A.Num 0 _)) ->
      o {oCode = ["\txor a"]}
    (A.BinOp A.Mul _ (A.Num 0 _) _) ->
      o {oCode = ["\txor a"]}
    (A.BinOp A.Mul _ (A.Num 1 _) b) -> o {oCode = (emit b).oCode}
    (A.BinOp A.Mul _ a (A.Num 1 _)) -> o {oCode = (emit a).oCode}
    (A.BinOp A.Mul pos a b@(A.Num _ _)) -> o {oCode = mul a b pos}
    (A.BinOp A.Mul pos a@(A.Num _ _) b) -> o {oCode = mul b a pos}
    (A.BinOp A.Mul p a b) -> o {oCode = mul8 a b p}
    (A.BinOp A.Assign _ (A.Variable id _) b) ->
      o {oCode = (emit b).oCode ++ ["\tld (" ++ toIdent id ++ "), a"]}
    _ -> o {oCode = [";; unimplemented " ++ show x]}
  where
    o = Output [] [] [] []

generate :: String -> [A.Expr] -> String
generate version ast = do
  let out = map emit ast
  let pre = concatMap (\f -> f.oPre) out
  let dat = [area "_DATA", area "_INITIALIZED"] ++ concatMap (\f -> f.oData) out
  let code = [area "_CODE"] ++ concatMap (\f -> f.oCode) out ++ ["hlt0:", "\tjr hlt0"]
  let init = [area "_INITIALIZER"] ++ concatMap (\f -> f.oInit) out ++ [area "_GSINIT", area "_GSFINAL"]
  unlines $ header version ++ pre ++ dat ++ code ++ init