From: pimjager Date: Sat, 7 May 2016 21:54:10 +0000 (+0200) Subject: Start of Gen monad X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=45cc0294086de13a530878f198ad3e6d82f773c8;p=cc1516.git Start of Gen monad --- diff --git a/gen.icl b/gen.icl index 71fe103..cd01d95 100644 --- a/gen.icl +++ b/gen.icl @@ -5,10 +5,18 @@ import StdMisc import StdList import StdOverloaded import StdString - -from Data.Func import $ -from Text import class Text(join), instance Text String -from Data.List import intersperse +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 @@ -30,12 +38,36 @@ gen _ = toString [Label "Test" //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 -class g a :: a -> SSMProgram -instance g Expr where - g _ = undef +//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] @@ -51,4 +83,7 @@ instance toString Arg where toString (Lit int) = toString int instance toString SSMProgram where - toString p = join " " $ map (\i-> join " " $ print i) p \ No newline at end of file + 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) \ No newline at end of file