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
  10 import Data.Func
  11 import qualified Data.Map as Map
  12 import Data.List
  13 import Data.Either
  14 import Data.Functor
  15 import Control.Applicative
  16 import Control.Monad
  17 import Control.Monad.State
  18 import Control.Monad.Trans
  19 from Text import class Text(concat), instance Text String
  20
  21 import AST
  22
  23 //Instruction is an instruction, with possible arguments and a possible comment
  24 //Or is a label
  25 :: Instr    = Instr String [Arg] String
  26             | Label String
  27 :: Arg = L String | Lit Int
  28 :: SSMProgram :== [Instr]
  29
  30
  31 gen :: AST -> String
  32 gen _ = toString    [Label "Test"
  33                     ,Instr "ldc" [Lit 1] "Eerste instructie"
  34                     ,Instr "ldc" [Lit 2] "Tweede instructie"]
  35
  36
  37 //Scrap this, we'll need shared state when generating
  38 //i.e. to figure out the positions of vars relative to the
  39 //SP/MP/whatever or in which register they are
  40 //and to supply with fresh labels
  41
  42 //The generation monad
  43 :: GenError = Error String
  44 :: GenMap :== 'Map'.Map String LoadPlace
  45 :: LoadPlace    = LDA Int | LDC Int | LDH Int | LDL Int
  46                 | LDR Int | LDS Int
  47 :: Gen a :== StateT (GenMap) (Either GenError) a
  48
  49 genMap :: Gen GenMap
  50 genMap = gets id
  51
  52 class g a :: a -> Gen SSMProgram
  53
  54 instance g Expr where
  55     g (VarExpr _ (VarDef k fs)) = pure <$> load k //note: pure is pure for list, i.e. []
  56
  57 load :: String -> Gen Instr
  58 load k = genMap >>= \g-> case 'Map'.member k g of
  59     False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found in variable mapping"])
  60     True = pure (loadP $ 'Map'.find k g)
  61
  62 loadP :: LoadPlace -> Instr
  63 loadP pl = let (instr, arg) = dec pl in Instr instr [Lit arg] ""
  64 where
  65     dec (LDA i) = ("lda", i)
  66     dec (LDC i) = ("ldc", i)
  67     dec (LDH i) = ("ldh", i)
  68     dec (LDL i) = ("ldl", i)
  69     dec (LDR i) = ("ldr", i)
  70     dec (LDS i) = ("lds", i)
  71
  72 class print a :: a -> [String]
  73
  74 instance print Instr where
  75     print (Label l) = [l, ":", "\n"]
  76     print (Instr i args com) = ["\t", i] ++ print args ++ [" ;", com, "\n"]
  77
  78 instance print [Arg] where
  79     print args = (map toString args)
  80
  81 instance toString Arg where
  82     toString (L l) = l
  83     toString (Lit int) = toString int
  84
  85 instance toString SSMProgram where
  86     toString p = concat $ intersperse " " $ map (\i-> concat $ intersperse " " $ print i) p
  87
  88 instance MonadTrans (StateT GenMap) where
  89     liftT m = StateT \s-> m >>= \a-> return (a, s)