fixes for variant 8 for codegen env; just before switching over

UU-ComputerScience · Oct 9, 2015 · fa16f90 · fa16f90
1 parent 750a552
commit fa16f90
Show file tree

Hide file tree

Showing 3 changed files with 21 additions and 17 deletions.
diff --git a/EHC/src/ehc/EHC/BuildFunction/Run.chs b/EHC/src/ehc/EHC/BuildFunction/Run.chs
@@ -219,10 +219,10 @@ bcall bfun = do
                                          , EHSem.chrStore_Inh_AGItf   = EHSem.gathChrStore_Syn_AGItf   ehSem `chrStoreUnion` EHSem.chrStore_Inh_AGItf   ehInh
                                          }
 %%]]
-                                   in  crsi -- From: cpFlowEHSem1
-                                         { _crsiEHInh = ehInh'
-                                         , _crsiCEnv  = cenvDataGam ^$= (EHSem.gathDataGam_Syn_AGItf ehSem `gamUnion`) $ crsi ^. crsiCEnv
-                                         }
+                                   in  -- From: cpFlowEHSem1
+                                       ( ( crsiEHInh ^= ehInh' )
+                                       . ( (crsiCEnv ^* cenvDataGam) ^$= (EHSem.gathDataGam_Syn_AGItf ehSem `gamUnion`) )
+                                       ) $ crsi
 
 %%[[(50 core corein)
                                -- From: cpFlowCoreModSem
@@ -262,7 +262,7 @@ bcall bfun = do
                                let updCoreRunSrc = id
 %%]]
 
-%%[[(50 core grin)
+%%[[(8 core grin)
                                -- From: cpFlowCoreSemAfterFold
                                updCoreGrin <- maybe2M
                                    (allowFlow $ astpMbFromCoreToGrin True)
@@ -272,10 +272,12 @@ bcall bfun = do
                                       bcall $ FoldCore2GrinPlMb bglob modSearchKey pl
                                    ) (return id) $ \_ core2GrinSem -> do
                                  return $ ( (crsiCEnv ^* cenvLamMp) ^$= (Core2GrSem.gathLamMp_Syn_CodeAGItf core2GrinSem `lamMpUnionBindAspMp`) )
+%%[[50
                                         . ( crsiCoreInh ^$= \coreInh ->
                                               -- assumption: old info can safely be overridden, otherwise merge should be done here
                                               coreInh { Core2GrSem.lamMp_Inh_CodeAGItf = Core2GrSem.gathLamMp_Syn_CodeAGItf core2GrinSem `lamMpUnionBindAspMp` Core2GrSem.lamMp_Inh_CodeAGItf coreInh }
                                           )
+%%]]
 %%][50
                                let updCoreGrin = id
 %%]]
@@ -408,18 +410,16 @@ bcall bfun = do
                            coreInh' = coreInh
 %%[[8
                              { Core2GrSem.dataGam_Inh_CodeAGItf = EHSem.gathDataGam_Syn_AGItf ehSem
-                             , Core2GrSem.lamMp_Inh_CodeAGItf   = EHSem.gathLamMp_Syn_AGItf   ehSem
+                             , Core2GrSem.lamMp_Inh_CodeAGItf   = lm
 %%][50
                              { Core2GrSem.dataGam_Inh_CodeAGItf = EHSem.dataGam_Inh_AGItf     ehInh
                              , Core2GrSem.lamMp_Inh_CodeAGItf   = lm `lamMpUnionBindAspMp` Core2GrSem.lamMp_Inh_CodeAGItf coreInh      -- assumption: no duplicates, otherwise merging as done later has to be done
 %%]]
                              }
-%%[[50
-                           lm       = EHSem.gathLamMp_Syn_AGItf      ehSem
-%%]]
+                           lm       = EHSem.gathLamMp_Syn_AGItf ehSem
                            cenv'    = ( cenvDataGam ^$= (EHSem.gathDataGam_Syn_AGItf ehSem `gamUnion`) )
 %%[[(8 core)          
-                                    . ( cenvLamMp   ^$= (lm `lamMpUnionBindAspMp`) )		-- assumption: no duplicates, otherwise merging as done later has to be done
+                                    . ( cenvLamMp   ^$= (EHSem.gathLamMp_Syn_AGItf ehSem `lamMpUnionBindAspMp`) )		-- assumption: no duplicates, otherwise merging as done later has to be done
 %%]]          
                                     $ cenv
                        in  crsi -- From: cpFlowEHSem1

diff --git a/EHC/src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs b/EHC/src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs
@@ -78,7 +78,7 @@ XXX
 %%% Additional processing before flowing into next whatever: in particular, force evaluation
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
-%%[50.prepFlow
+%%[8.prepFlow
 prepFlow :: a -> a
 prepFlow x | x `seq` True = x
 -- prepFlow = id
@@ -87,7 +87,7 @@ gamUnionFlow :: Ord k => Gam k v -> Gam k v -> Gam k v
 gamUnionFlow = gamUnion
 %%]
 
-%%[9999 -50.prepFlow
+%%[9999 -8.prepFlow
 prepFlow :: ForceEval a => a -> a
 prepFlow = forceEval
 
@@ -165,7 +165,7 @@ cpFlowEHSem1 modNm
                  dfg      = prepFlow $! EHSem.gathClDfGam_Syn_AGItf    ehSem
                  cs       = prepFlow $! EHSem.gathChrStore_Syn_AGItf   ehSem
 %%]]
-%%[[(50 core)
+%%[[(8 core)
                  lm       = prepFlow $! EHSem.gathLamMp_Syn_AGItf      ehSem
 %%]]
 %%[[50
@@ -344,28 +344,31 @@ cpFlowCoreModSem modNm
 
 The following flow functions probably can be merged with the semantics itself, TBD & sorted out, 20140407
 
-%%[(50 core grin) export(cpFlowCoreSemAfterFold)
+%%[(8 core grin) export(cpFlowCoreSemAfterFold)
 cpFlowCoreSemAfterFold :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
 cpFlowCoreSemAfterFold modNm
   =  do  {  cr <- get
          ;  let  (ecu,crsi,opts,_) = crBaseInfo modNm cr
                  coreSem  = panicJust "cpFlowCoreSemAfterFold.coreSem" $ _ecuMbCoreSem ecu
-
+                 lm       = prepFlow $! Core2GrSem.gathLamMp_Syn_CodeAGItf coreSem
+%%[[50
                  coreInh  = crsi ^. crsiCoreInh
                  hii      = ecu ^. ecuHIInfo
-                 lm       = prepFlow $! Core2GrSem.gathLamMp_Syn_CodeAGItf coreSem
                  coreInh' = coreInh
                               { Core2GrSem.lamMp_Inh_CodeAGItf   = lm `lamMpUnionBindAspMp` Core2GrSem.lamMp_Inh_CodeAGItf coreInh	-- assumption: old info can be overridden, otherwise merge should be done here
                               }
                  hii'     = hii
                               { HI.hiiLamMp         = lm
                               }
+%%]]
          ;  when (isJust (_ecuMbCoreSem ecu))
                  (do { cpUpdSI $
                            ( (crsiCEnv ^* cenvLamMp) ^$= (lm `lamMpUnionBindAspMp`) )	-- assumption: old info can be overridden, otherwise merge should be done here
+%%[[50
                          . ( crsiCoreInh ^= coreInh')
                      ; cpUpdCU modNm ( ecuStoreHIInfo hii'
                                      )
+%%]]
                      })
          }
 %%]

diff --git a/EHC/src/ehc/EHC/CompilePhase/TopLevelPhases.chs b/EHC/src/ehc/EHC/CompilePhase/TopLevelPhases.chs
@@ -1326,9 +1326,10 @@ cpProcessCoreFold modNm
        ; when (targetIsCoreVariation (ehcOptTarget opts)) $
            cpFoldCore2CoreRun modNm
 %%]]
-%%[[(50 core grin)
+%%[[(8 core grin)
        ; cpFlowCoreSemAfterFold modNm
 %%]]
+       ; return ()
        }
 %%]