[pass TiData into Hs -> E conversion, add environment to Ce monad
John Meacham <john@repetae.net>**20060301021734] hunk ./E/FromHs.hs 34
+import E.Program
hunk ./E/FromHs.hs 41
-import E.Program
hunk ./E/FromHs.hs 42
-import FrontEnd.Rename(unRename)
hunk ./E/FromHs.hs 43
-import FrontEnd.TiData
+import FrontEnd.Rename(unRename)
hunk ./E/FromHs.hs 45
-import Util.Gen
+import FrontEnd.Tc.Type hiding(Rule(..), unbox)
hunk ./E/FromHs.hs 47
-import qualified FrontEnd.Tc.Monad as TM
-import qualified FrontEnd.Tc.Type as T(Rule(..))
+import FrontEnd.TiData
hunk ./E/FromHs.hs 57
+import qualified FrontEnd.Tc.Monad as TM
+import qualified FrontEnd.Tc.Type as T(Rule(..))
hunk ./E/FromHs.hs 66
+import Util.Gen
hunk ./E/FromHs.hs 86
-        s <- get
-        put $! s + 2
-        f xs (tVr ( s) x:ys)
+        s <- newUniq
+        f xs (tVr s x:ys)
hunk ./E/FromHs.hs 293
-convertRules ::  ClassHierarchy -> Map.Map Name Scheme -> DataTable -> [HsDecl] -> IO [(String,[TVr],E,E)]
-convertRules classHierarchy assumps dataTable hsDecls = concatMapM f hsDecls where
+convertRules :: TiData -> ClassHierarchy -> Map.Map Name Scheme -> DataTable -> [HsDecl] -> IO [(String,[TVr],E,E)]
+convertRules tiData classHierarchy assumps dataTable hsDecls = concatMapM f hsDecls where
hunk ./E/FromHs.hs 296
-        let ce = convertE classHierarchy assumps dataTable (hsDeclSrcLoc pr)
+        let ce = convertE tiData classHierarchy assumps dataTable (hsDeclSrcLoc pr)
hunk ./E/FromHs.hs 317
-convertE :: Monad m => ClassHierarchy -> Map.Map Name Scheme -> DataTable -> SrcLoc -> HsExp -> m E
-convertE classHierarchy assumps dataTable srcLoc exp = do
-    [(_,_,e)] <- convertDecls classHierarchy assumps dataTable [HsPatBind srcLoc (HsPVar sillyName') (HsUnGuardedRhs exp) []]
+convertE :: Monad m => TiData -> ClassHierarchy -> Map.Map Name Scheme -> DataTable -> SrcLoc -> HsExp -> m E
+convertE tiData classHierarchy assumps dataTable srcLoc exp = do
+    [(_,_,e)] <- convertDecls tiData classHierarchy assumps dataTable [HsPatBind srcLoc (HsPVar sillyName') (HsUnGuardedRhs exp) []]
hunk ./E/FromHs.hs 324
-newtype Ce t a = Ce (StateT Int t a)
-    deriving(Monad,Functor,MonadTrans,MonadIO,MonadState Int)
+data CeEnv = CeEnv {
+    ceAssumps :: Map.Map Name Type,
+    ceCoerce :: Map.Map Name CoerceTerm,
+    ceDataTable :: DataTable
+    }
+
+newtype Ce t a = Ce (RWST CeEnv () Int t a)
+    deriving(Monad,Functor,MonadTrans,MonadIO,MonadReader CeEnv,MonadState Int)
hunk ./E/FromHs.hs 336
-        put $! (i + 1)
+        put $! (i + 2)
hunk ./E/FromHs.hs 340
-convertDecls :: Monad m => ClassHierarchy -> Map.Map Name Scheme -> DataTable -> [HsDecl] -> m [(Name,TVr,E)]
-convertDecls classHierarchy assumps dataTable hsDecls = evalStateT ans 2 where
+convertDecls :: Monad m => TiData -> ClassHierarchy -> Map.Map Name Scheme -> DataTable -> [HsDecl] -> m [(Name,TVr,E)]
+convertDecls tiData classHierarchy assumps dataTable hsDecls = liftM fst $ evalRWST ans ceEnv 2 where
+    ceEnv = CeEnv {
+        ceCoerce = tiCoerce tiData,
+        ceAssumps = Map.map schemeToType assumps,
+        ceDataTable = dataTable
+        }
hunk ./FrontEnd/Tc/Monad.hs 148
-    --r <- fmapM flattenType r
+    r <- fmapM flattenType r
hunk ./Main.hs 189
-    ds <- convertDecls (hoClassHierarchy ho') allAssumps  fullDataTable decls
+    ds <- convertDecls tiData (hoClassHierarchy ho') allAssumps  fullDataTable decls
hunk ./Main.hs 194
-    rawRules <- convertRules (hoClassHierarchy ho') allAssumps fullDataTable decls
+    rawRules <- convertRules tiData (hoClassHierarchy ho') allAssumps fullDataTable decls