gen.icl

   1 implementation module gen
   2
   3
   4 import StdMisc
   5 import StdList
   6 import StdOverloaded
   7 import StdString
   8 from StdFunc import id
   9 import StdTuple
  10
  11 import Data.Func
  12 import qualified Data.Map as Map
  13 import Data.List
  14 import Data.Either
  15 import Data.Tuple
  16 import Data.Functor
  17 import Data.Monoid
  18 import Control.Applicative
  19 import Control.Monad
  20 import Control.Monad.Trans
  21 from Text import class Text(concat), instance Text String
  22
  23 import AST
  24 import RWST
  25
  26 //Instruction is an instruction, with possible arguments and a possible comment
  27 //Or is a label
  28 TRUE :== -1
  29 FALSE :== 0
  30 :: Instr    = Instr String [Arg] String
  31             | Lab String
  32 :: Label :== String
  33 :: Arg = L Label | Lit Int
  34 :: SSMProgram :== [Instr]
  35
  36
  37 gen :: AST -> String
  38 gen _ = toString    [Lab "Test"
  39                     ,Instr "ldc" [Lit 1] "Eerste instructie"
  40                     ,Instr "ldc" [Lit 2] "Tweede instructie"]
  41
  42
  43 //Scrap this, we'll need shared state when generating
  44 //i.e. to figure out the positions of vars relative to the
  45 //SP/MP/whatever or in which register they are
  46 //and to supply with fresh labels
  47
  48 //The generation monad
  49 :: GenError = Error String
  50 :: GenMap :== 'Map'.Map String LoadPlace
  51 :: LoadPlace    = LDA Int | LDC Int | LDH Int | LDL Int
  52                 | LDR Int | LDS Int
  53                 | FUNC Label
  54 :: Gen a :== RWST [Int] SSMProgram (GenMap, [Label]) (Either GenError) a
  55
  56 genMap :: Gen GenMap
  57 genMap = gets fst
  58
  59 class g a :: a -> Gen ()
  60
  61 instance g Expr where
  62     g (VarExpr _ (VarDef k fs)) = load k >>= \instr-> tell [instr] //note: pure is pure for list, i.e. []
  63     g (IntExpr _ i) = loadP (LDC i) >>= \instr-> tell [instr]
  64     g (CharExpr _ c) = undef //how to deal with strings?
  65     g (BoolExpr _ True) = loadP (LDC TRUE) >>= \instr-> tell [instr]
  66     g (BoolExpr _ False) = loadP (LDC FALSE) >>= \instr-> tell [instr]
  67     g (Op2Expr _ e1 op e2) = g e1 >>| g e2 >>| tell [Instr (op2ins op) [] ""]
  68
  69 op2ins :: Op2 -> String
  70 op2ins op = case op of
  71     BiPlus = "add"
  72     BiMinus = "sub"
  73     BiTimes = "mul"
  74     BiDivide = "div"
  75     BiMod = "mod"
  76     BiEquals = "eq"
  77     BiLesser = "lt"
  78     BiGreater = "gt"
  79     BiLesserEq = "le"
  80     BiGreaterEq = "ge"
  81     BiUnEqual = "ne"
  82     BiAnd = "and"
  83     BiOr = "or"
  84     BiCons = abort "Shit, Cons, how to deal with this?"
  85
  86 load :: String -> Gen Instr
  87 load k = genMap >>= \g-> case 'Map'.member k g of
  88     False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found in variable mapping"])
  89     True = loadP $ 'Map'.find k g
  90
  91 loadP :: LoadPlace -> Gen Instr
  92 loadP pl = dec pl >>= \(instr, arg)-> pure $ Instr instr [arg] ""
  93 where
  94     dec (LDA i) = pure ("lda", Lit i)
  95     dec (LDC i) = pure ("ldc", Lit i)
  96     dec (LDH i) = pure ("ldh", Lit i)
  97     dec (LDL i) = pure ("ldl", Lit i)
  98     dec (LDR i) = pure ("ldr", Lit i)
  99     dec (LDS i) = pure ("lds", Lit i)
 100     dec _       = liftT (Left $ Error "PANIC: trying to load non adres")
 101
 102 //Instruction (String), key of function to jump to
 103 jump :: String String -> Gen Instr
 104 jump instr k = genMap >>= \g-> case 'Map'.member k g of
 105     False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found as function"])
 106     True = dec ('Map'.find k g) >>= \lbl-> pure $ Instr instr [lbl] k
 107 where
 108     dec (FUNC l) = pure (L l)
 109     dec _ = liftT (Left $ Error "PANIC: trying to jump to non label")
 110
 111 class print a :: a -> [String]
 112
 113 instance print Instr where
 114     print (Lab l) = [l, ":", "\n"]
 115     print (Instr i args com) = ["\t", i] ++ print args ++ [" ;", com, "\n"]
 116
 117 instance print [Arg] where
 118     print args = (map toString args)
 119
 120 instance toString Arg where
 121     toString (L l) = l
 122     toString (Lit int) = toString int
 123
 124 instance toString SSMProgram where
 125     toString p = concat $ intersperse " " $ map (\i-> concat $ intersperse " " $ print i) p