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