Skip to content

Commit

Permalink
fixed merge bugs
Browse files Browse the repository at this point in the history
  • Loading branch information
rgvwille committed Mar 26, 2010
1 parent eb904aa commit 5a09651
Show file tree
Hide file tree
Showing 7 changed files with 29 additions and 28 deletions.
8 changes: 4 additions & 4 deletions EHC/src/ehc/GrinCode.cag
View file
Expand Up @@ -409,12 +409,12 @@ willUseForNodeField n m = maybe False (WillUseFor_NodeField `Set.member`) $ Map.

%%[(20 codegen grin) hs
instance Serialize GrInl where
sput (GrInl_Call a b) = sputWord8 0 >> sput a >> sput b
sput (GrInl_CAF a ) = sputWord8 1 >> sput a
sput (GrInl_Call a b c d) = sputWord8 0 >> sput a >> sput b >> sput c >> sput d
sput (GrInl_CAF a b) = sputWord8 1 >> sput a >> sput b
sget = do t <- sgetWord8
case t of
0 -> liftM2 GrInl_Call sget sget
1 -> liftM GrInl_CAF sget
0 -> liftM4 GrInl_Call sget sget sget sget
1 -> liftM2 GrInl_CAF sget sget

instance Serialize GrExpr where
sput (GrExpr_Seq a b c ) = sputWord8 0 >> sput a >> sput b >> sput c
Expand Down
2 changes: 1 addition & 1 deletion EHC/src/ehc/GrinCode/AbsSyn.cag
View file
Expand Up @@ -49,7 +49,7 @@ DATA GrExpr
pat : GrPatLam
body : GrExpr
| Unit val : GrVal
type : GrType
type : GrType
| UpdateUnit nm : {HsName}
val : GrVal
| Case val : GrVal
Expand Down
3 changes: 1 addition & 2 deletions EHC/src/ehc/GrinCode/SolveEqs.chs
View file
Expand Up @@ -72,7 +72,7 @@ envChanges equat env
; IsSelection d v i t -> d
; IsEvaluation d v ev -> d
; IsApplication d vs ev -> d
} in if True {-d == 222-} then trace ("222 eq = " ++ show equat) a else a) $
} in if True {-d == 222-} then trace ("eq = " ++ show equat) a else a) $
case equat of
IsBasic d -> return [(d, AbsBasic)]

Expand Down Expand Up @@ -248,7 +248,6 @@ procChange env (i,e1) =
do { (c,_,e0) <- readArray env i
; let e2 = e0 `mappend` e1
changed = e0 /= e2
; case e2 of { AbsError e -> error $ "variable " ++ show i ++ " going bad, err = " ++ e; _ -> return ()}
; when changed (writeArray env i (c,True,e2) <?< (True,const $ "hptChange = " ++ show (i,e2)))
--; when changed (trace ("change " ++ show i ++ " from " ++ show e0 ++ "\n to " ++ show e2) (return ()))
; return changed
Expand Down
4 changes: 3 additions & 1 deletion EHC/src/ehc/GrinCode/Trf/ApplyUnited.cag
View file
@@ -1,5 +1,7 @@
%%[doesWhat doclatex

Changed by Remy. Made recursive so that unit (PApp) Apply Apply can remove both applies.

do not do \textit{APPLY} on variables that bind the result of a previous \textit{UNIT} of a P-node.
Instead, do a \textit{CALL} of the function if it is now saturated, or build a new P-node if it is undersaturated.

Expand Down Expand Up @@ -79,7 +81,7 @@ SEM GrExpr
(\val -> --(const $ "\ninserting " ++ show @pat.getName ++ " with expr = " ++ show @expr.grTrf) >>>
Map.insert @pat.getName val @lhs.env)
(case @expr.grTrf of
GrExpr_Unit val@(GrVal_Node (GrTag_PApp _ _) _) -> Just val
GrExpr_Unit val@(GrVal_Node (GrTag_PApp _ _) _) _ -> Just val
_ -> Nothing
)

Expand Down
9 changes: 5 additions & 4 deletions EHC/src/ehc/GrinCode/Trf/CopyPropagation.cag
View file
Expand Up @@ -198,10 +198,11 @@ getHsName nm subst
= case Map.lookup nm subst of
Nothing -> nm
Just repl -> case repl of
GrVal_Var v -> v
_ -> error ("CopyPropagation cannot substitute for name " ++ show nm ++ "\nvalue " ++ disp (ppGrExpr (GrExpr_Unit repl)) 0 ""
++ "\nvalue2 = " ++ show repl
++ "\nsubst = " ++ show subst)
GrVal_Var v -> v
_ -> error ("CopyPropagation cannot substitute for name " ++ show nm ++ "\nvalue "
++ disp (ppGrExpr (GrExpr_Unit repl GrType_None)) 0 ""
++ "\nvalue2 = " ++ show repl
++ "\nsubst = " ++ show subst)

mbSubstTag nm subst
= case Map.lookup nm subst of
Expand Down
16 changes: 7 additions & 9 deletions EHC/src/ehc/GrinCode/Trf/HptInline.cag
View file
Expand Up @@ -23,8 +23,9 @@

%%[(20 codegen grin) -8.grInline hs export(hptInline)
hptInline :: Bool -> HsNameS -> GrInlMp -> (GrModule,HptMap) -> Maybe ((GrModule,HptMap),GrInlMp)
hptInline allow expNmS inlMp (grMod,hptMap) =
let inlineResult = grInline allow expNmS inlMp grMod
hptInline allow expNmS inlMp (grMod,evalInlinedHptMap) =
let inlineResult = grInline allow expNmS inlMp grMod
hptMap = heapPointsToAnalysis grMod
debug = False
processInline :: (GrModule,GrInlMp,[(HsName,HsName)]) -> ((GrModule,HptMap),GrInlMp)
processInline (grMod,inlMp,varSubs) =
Expand All @@ -36,17 +37,14 @@ hptInline allow expNmS inlMp (grMod,hptMap) =

hptExtended :: HptMap
hptExtended =
let (low,high) = bounds hptMap
extra = foldl (\i -> max i . getNr . snd) high varSubs - high
res = listArray (low, high+extra) (elems hptMap ++ replicate extra AbsBottom)
hptAddedBinds :: [(Int,AbstractValue)]
let hptAddedBinds :: [(Int,AbstractValue)]
hptAddedBinds = map (\(fromId,toId) -> (getNr toId,AbsBottom)) varSubs
in addEnvNamedElems hptMap hptAddedBinds


(count,updatedHpt) = --(0,hptWithNewBindings)
-- heapPointsToAnalysis grMod
continuedHeapPointsToAnalysis (hptExtended,grMod)
(count,updatedHpt) = -- (0,hptWithNewBindings)
heapPointsToAnalysis grMod
-- continuedHeapPointsToAnalysis (hptExtended,grMod)
diffHpt = diffMap hptExtended (snd $ heapPointsToAnalysis grMod)
in ((grMod,updatedHpt),inlMp)
<<< (const $ "hptExtended = " ++ disp (pp hptExtended) 80 [])
Expand Down
15 changes: 8 additions & 7 deletions EHC/src/ehc/GrinCode/Trf/SingleCase.cag
View file
Expand Up @@ -70,11 +70,12 @@ SEM GrPatAlt

-- Do the replacement if possible
SEM GrExpr
| Case (lhs.grTrf,lhs.changed) = maybe (@loc.grTrf,False)
(\(p,e) -> (case p of
Nothing -> e
Just pat -> GrExpr_Seq (GrExpr_Unit @val.grTrf) pat e
,True))

@altL.onlyAlt
| Case (lhs.grTrf,lhs.changed) =
maybe (@loc.grTrf,False)
(\(p,e) -> (case p of
Nothing -> e
Just pat -> GrExpr_Seq (GrExpr_Unit @val.grTrf GrType_None) pat e
,True))

@altL.onlyAlt
%%]

0 comments on commit 5a09651

Please sign in to comment.