implementation module gen


import StdMisc
import StdList
import StdOverloaded
import StdString
from StdFunc import id
import StdTuple

import Data.Func
import qualified Data.Map as Map
import Data.List
import Data.Either
import Data.Tuple
import Data.Functor
import Data.Monoid
import Control.Applicative
import Control.Monad
import Control.Monad.Trans
from Text import class Text(concat), instance Text String

import AST
import RWST

//Instruction is an instruction, with possible arguments and a possible comment
//Or is a label
TRUE :== -1
FALSE :== 0
:: Instr    = Instr String [Arg] String
            | Lab String
:: Label :== String
:: Arg = L Label | Lit Int
:: SSMProgram :== [Instr]


gen :: AST -> String
gen _ = toString    [Lab "Test"
                    ,Instr "ldc" [Lit 1] "Eerste instructie"
                    ,Instr "ldc" [Lit 2] "Tweede instructie"]


//Scrap this, we'll need shared state when generating
//i.e. to figure out the positions of vars relative to the 
//SP/MP/whatever or in which register they are 
//and to supply with fresh labels 

//The generation monad
:: GenError = Error String
:: GenMap :== 'Map'.Map String LoadPlace
:: LoadPlace    = LDA Int | LDC Int | LDH Int | LDL Int 
                | LDR Int | LDS Int
                | FUNC Label
:: Gen a :== RWST [Int] SSMProgram (GenMap, [Label]) (Either GenError) a

genMap :: Gen GenMap
genMap = gets fst

class g a :: a -> Gen ()

instance g Expr where
    g (VarExpr _ (VarDef k fs)) = load k >>= \instr-> tell [instr] //note: pure is pure for list, i.e. []
    g (IntExpr _ i) = loadP (LDC i) >>= \instr-> tell [instr]
    g (CharExpr _ c) = undef //how to deal with strings?
    g (BoolExpr _ True) = loadP (LDC TRUE) >>= \instr-> tell [instr]
    g (BoolExpr _ False) = loadP (LDC FALSE) >>= \instr-> tell [instr]
    g (Op2Expr _ e1 op e2) = g e1 >>| g e2 >>| tell [Instr (op2ins op) [] ""]
    g (Op1Expr _ UnNegation e) = g e >>| tell [Instr "not" [] ""]
    g (Op1Expr _ UnMinus e) = g e >>| tell [Instr "neg" [] ""]
    g (EmptyListExpr _) = abort "Shit, empty list expr"
    g (TupleExpr p (e1,e2)) = abort "How to deal with tuples?"
    g (FunExpr _ k es fs) = mapM g es >>| jump "bra" k >>= \instr-> tell [instr]

op2ins :: Op2 -> String
op2ins op = case op of
    BiPlus = "add"
    BiMinus = "sub"
    BiTimes = "mul"
    BiDivide = "div" 
    BiMod = "mod"
    BiEquals = "eq"
    BiLesser = "lt"
    BiGreater = "gt"
    BiLesserEq = "le"
    BiGreaterEq = "ge"
    BiUnEqual = "ne"
    BiAnd = "and"
    BiOr = "or"
    BiCons = abort "Shit, Cons, how to deal with this?"

load :: String -> Gen Instr
load k = genMap >>= \g-> case 'Map'.member k g of
    False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found in variable mapping"])
    True = loadP $ 'Map'.find k g

loadP :: LoadPlace -> Gen Instr
loadP pl = dec pl >>= \(instr, arg)-> pure $ Instr instr [arg] ""
where
    dec (LDA i) = pure ("lda", Lit i)
    dec (LDC i) = pure ("ldc", Lit i)
    dec (LDH i) = pure ("ldh", Lit i)
    dec (LDL i) = pure ("ldl", Lit i)
    dec (LDR i) = pure ("ldr", Lit i)
    dec (LDS i) = pure ("lds", Lit i)
    dec _       = liftT (Left $ Error "PANIC: trying to load non adres")

//Instruction (String), key of function to jump to    
jump :: String String -> Gen Instr
jump instr k = genMap >>= \g-> case 'Map'.member k g of
    False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found as function"])
    True = dec ('Map'.find k g) >>= \lbl-> pure $ Instr instr [lbl] k 
where
    dec (FUNC l) = pure (L l)
    dec _ = liftT (Left $ Error "PANIC: trying to jump to non label")

class print a :: a -> [String]

instance print Instr where
    print (Lab l) = [l, ":", "\n"]
    print (Instr i args com) = ["\t", i] ++ print args ++ [" ;", com, "\n"]

instance print [Arg] where
    print args = (map toString args)

instance toString Arg where
    toString (L l) = l
    toString (Lit int) = toString int

instance toString SSMProgram where
    toString p = concat $ intersperse " " $ map (\i-> concat $ intersperse " " $ print i) p