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     g (Op1Expr _ UnNegation e) = g e >>| tell [Instr "not" [] ""]
  69     g (Op1Expr _ UnMinus e) = g e >>| tell [Instr "neg" [] ""]
  70     g (EmptyListExpr _) = abort "Shit, empty list expr"
  71     g (TupleExpr p (e1,e2)) = abort "How to deal with tuples?"
  72     g (FunExpr _ k es fs) = mapM g es >>| jump "bra" k >>= \instr-> tell [instr]
  73
  74 op2ins :: Op2 -> String
  75 op2ins op = case op of
  76     BiPlus = "add"
  77     BiMinus = "sub"
  78     BiTimes = "mul"
  79     BiDivide = "div"
  80     BiMod = "mod"
  81     BiEquals = "eq"
  82     BiLesser = "lt"
  83     BiGreater = "gt"
  84     BiLesserEq = "le"
  85     BiGreaterEq = "ge"
  86     BiUnEqual = "ne"
  87     BiAnd = "and"
  88     BiOr = "or"
  89     BiCons = abort "Shit, Cons, how to deal with this?"
  90
  91 load :: String -> Gen Instr
  92 load k = genMap >>= \g-> case 'Map'.member k g of
  93     False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found in variable mapping"])
  94     True = loadP $ 'Map'.find k g
  95
  96 loadP :: LoadPlace -> Gen Instr
  97 loadP pl = dec pl >>= \(instr, arg)-> pure $ Instr instr [arg] ""
  98 where
  99     dec (LDA i) = pure ("lda", Lit i)
 100     dec (LDC i) = pure ("ldc", Lit i)
 101     dec (LDH i) = pure ("ldh", Lit i)
 102     dec (LDL i) = pure ("ldl", Lit i)
 103     dec (LDR i) = pure ("ldr", Lit i)
 104     dec (LDS i) = pure ("lds", Lit i)
 105     dec _       = liftT (Left $ Error "PANIC: trying to load non adres")
 106
 107 //Instruction (String), key of function to jump to
 108 jump :: String String -> Gen Instr
 109 jump instr k = genMap >>= \g-> case 'Map'.member k g of
 110     False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found as function"])
 111     True = dec ('Map'.find k g) >>= \lbl-> pure $ Instr instr [lbl] k
 112 where
 113     dec (FUNC l) = pure (L l)
 114     dec _ = liftT (Left $ Error "PANIC: trying to jump to non label")
 115
 116 class print a :: a -> [String]
 117
 118 instance print Instr where
 119     print (Lab l) = [l, ":", "\n"]
 120     print (Instr i args com) = ["\t", i] ++ print args ++ [" ;", com, "\n"]
 121
 122 instance print [Arg] where
 123     print args = (map toString args)
 124
 125 instance toString Arg where
 126     toString (L l) = l
 127     toString (Lit int) = toString int
 128
 129 instance toString SSMProgram where
 130     toString p = concat $ intersperse " " $ map (\i-> concat $ intersperse " " $ print i) p