implementation module gen


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

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

import AST

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


gen :: AST -> String
gen _ = toString    [Label "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
:: Gen a :== StateT (GenMap) (Either GenError) a

genMap :: Gen GenMap
genMap = gets id

class g a :: a -> Gen SSMProgram

instance g Expr where
    g (VarExpr _ (VarDef k fs)) = pure <$> load k //note: pure is pure for list, i.e. []

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 = pure (loadP $ 'Map'.find k g)

loadP :: LoadPlace -> Instr
loadP pl = let (instr, arg) = dec pl in Instr instr [Lit arg] ""
where
    dec (LDA i) = ("lda", i)
    dec (LDC i) = ("ldc", i)
    dec (LDH i) = ("ldh", i)
    dec (LDL i) = ("ldl", i)
    dec (LDR i) = ("ldr", i)
    dec (LDS i) = ("lds", i)

class print a :: a -> [String]

instance print Instr where
    print (Label 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

instance MonadTrans (StateT GenMap) where
    liftT m = StateT \s-> m >>= \a-> return (a, s)