From: pimjager <pim@pimjager.nl>
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