module CSharp.CodeGen where

import CSharp.AbstractSyntax
import CSharp.Algebra
import Debug.Trace

import SSM

import Prelude hiding (LT, GT, EQ)
import qualified Data.Map as M

{-
  This file contains a starting point for the code generation.
-}

-- The types that we generate for each datatype: our type variables for the algebra.
-- Change these definitions instead of the function signatures to get better type errors.  
--
type C = Code                   -- Class 
type M = Code                   -- Member 
type S = Env->(Code,Env)            -- Statement
type E = Env->(ValueOrAddress -> Code) -- Expression

type Level = Int
type Env = [(Ident,(Level,Int))] --A mapping from identifiers to the the level and
--to the address of the variable relative to the MP belonging to the level.

type Decls = [Decl]

codeAlgebra :: CSharpAlgebra C M S E
codeAlgebra = CSharpAlgebra
  fClass
  fMembDecl
  fMembMeth
  fStatDecl
  fStatExpr
  fStatIf
  fStatWhile
  fStatReturn
  fStatBlock
  fExprLit
  fExprVar
  fExprOp
  fExprFunc

seqEval :: [a -> (b,a)] -> a -> ([b],a)
seqEval = foldr f (\x->([],x))
  where
    f g1 g2 env  = let (b,env') = g1 env in let (bs,env'') = g2 env' in (b:bs, env'')
  

maximum' = foldr (\a b -> if a>b then a else b) 0 

fClass :: ClassName -> [M] -> C
fClass c ms = [Bsr "main", HALT] ++ concat ms

levelZero = (\(_,(l,_)) -> l==0)

newAddress = (+1) . maximum' . (map (\(_,(_,a))->a)) . filter levelZero

fMembDecl :: Decl -> M
fMembDecl (Decl retType ident) =[] 

fMembMeth :: RetType -> Ident -> [Decl] -> S -> M
fMembMeth t x ps s = [LABEL x]++ [LINK (length $ filter levelZero  env')]++code ++ [UNLINK] ++ [RET]
  where
    (code,env') = s env
    env = map (\((Decl retType ident),i)-> (ident,(0,i))) (zip ps [1..length ps])

fStatDecl :: Decl -> S
fStatDecl (Decl retType ident) env = ([],(ident, (0,newAddress env)):env)

fStatExpr :: E -> S
fStatExpr e env= (e env Value ++ [pop],env)

fStatIf :: E -> S -> S -> S
fStatIf e s1 s2 env = (c ++ [BRF (n1 + 2)] ++ s1' ++ [BRA n2] ++ s2',env) where
  c        = e env Value
  s1'      = fst $ s1 env
  s2'      = fst $ s2 env
  (n1, n2) = (codeSize s1', codeSize s2')

fStatWhile :: E -> S -> S
fStatWhile e s env = ([BRA n] ++ s' ++ c ++ [BRT (-(n + k + 2))],env) where
  c = e env Value
  s' = fst $ s env
  (n, k) = (codeSize s', codeSize c)

fStatReturn :: E -> S
fStatReturn e env = (e env Value ++ [STR R3] ++ [UNLINK] ++ [RET],env)

fStatBlock :: [S] -> S
fStatBlock xs env = (concat codes,env')
  where 
    (codes, env') = seqEval xs env

fExprLit :: Literal -> E
fExprLit l env va  = [LDC n] where
  n = case l of
    LitInt n -> n
    LitBool b -> bool2int b

fExprVar :: Ident -> E
fExprVar x env va = case va of
    Value   ->  [LDL  loc]
    Address ->  [LDLA loc]
  where loc = case lookup x env of
                   Just (_,addr) -> addr
                   Nothing -> error ("Variable \""++x++"\" does not exist in the current scope")

fExprOp :: Operator -> E -> E -> E
fExprOp OpAsg e1 e2 env va = e2 env Value ++ [LDS 0] ++ e1 env Address ++ [STA 0]
fExprOp op    e1 e2 env va = e1 env Value ++ e2 env Value ++ [
   case op of
    { OpAdd -> ADD; OpSub -> SUB; OpMul -> MUL; OpDiv -> DIV;
    ; OpMod -> MOD
    ; OpAnd -> AND; OpOr -> OR; OpXor -> XOR;
    ; OpLeq -> LE; OpLt -> LT;
    ; OpGeq -> GT; OpGt -> GT;
    ; OpEq  -> EQ; OpNeq -> NE;}
  ]

fExprFunc :: String -> [E] -> E
fExprFunc "print" [e] env va = e env va ++ [TRAP 0] ++ [AJS 1]
fExprFunc m es env va = [AJS 2] ++ concatMap expr es++[AJS (-length es-2)]++[Bsr m]++[LDR R3]
  where
    expr e = e env Value

-- | Whether we are computing the value of a variable, or a pointer to it
data ValueOrAddress = Value | Address
  deriving Show

-- Encode a C# bool as an int, for the SSM
bool2int :: Bool -> Int
bool2int True  = -1
bool2int False = 0