mirror of
https://github.com/GaloisInc/cryptol.git
synced 2025-01-05 15:07:12 +03:00
Do and-goal splitting in more places.
This alleviates some of the problems in #522
This commit is contained in:
parent
1e5209ade5
commit
0739448933
@ -695,7 +695,7 @@ generalize bs0 gs0 =
|
||||
do {- First, we apply the accumulating substitution to the goals
|
||||
and the inferred types, to ensure that we have the most up
|
||||
to date information. -}
|
||||
gs <- forM gs0 $ \g -> applySubst g
|
||||
gs <- applySubstGoals gs0
|
||||
bs <- forM bs0 $ \b -> do s <- applySubst (dSignature b)
|
||||
return b { dSignature = s }
|
||||
|
||||
@ -801,7 +801,7 @@ checkSigB b (Forall as asmps0 t0, validSchema) = case thing (P.bDef b) of
|
||||
addGoals validSchema
|
||||
() <- simplifyAllConstraints -- XXX: using `asmps` also?
|
||||
return e1
|
||||
cs <- applySubst cs0
|
||||
cs <- applySubstGoals cs0
|
||||
|
||||
let findKeep vs keep todo =
|
||||
let stays (_,cvs) = not $ Set.null $ Set.intersection vs cvs
|
||||
@ -816,12 +816,12 @@ checkSigB b (Forall as asmps0 t0, validSchema) = case thing (P.bDef b) of
|
||||
|
||||
addGoals leave
|
||||
|
||||
asmps1 <- applySubst asmps0
|
||||
asmps1 <- applySubstPreds asmps0
|
||||
|
||||
su <- proveImplication (Just (thing (P.bName b))) as asmps1 stay
|
||||
extendSubst su
|
||||
|
||||
let asmps = apSubst su asmps1
|
||||
let asmps = concatMap pSplitAnd (apSubst su asmps1)
|
||||
t <- applySubst t0
|
||||
e2 <- applySubst e1
|
||||
|
||||
|
@ -343,7 +343,8 @@ newGoals src ps = addGoals =<< mapM (newGoal src) ps
|
||||
The substitution IS applied to them. -}
|
||||
getGoals :: InferM [Goal]
|
||||
getGoals =
|
||||
do goals <- applySubst =<< IM (sets $ \s -> (iCts s, s { iCts = emptyGoals }))
|
||||
do goals <- applySubst =<<
|
||||
IM (sets $ \s -> (iCts s, s { iCts = emptyGoals }))
|
||||
return (fromGoals goals)
|
||||
|
||||
-- | Add a bunch of goals that need solving.
|
||||
@ -504,6 +505,17 @@ applySubst t =
|
||||
do su <- getSubst
|
||||
return (apSubst su t)
|
||||
|
||||
applySubstPreds :: [Prop] -> InferM [Prop]
|
||||
applySubstPreds ps =
|
||||
do ps1 <- applySubst ps
|
||||
return (concatMap pSplitAnd ps1)
|
||||
|
||||
|
||||
applySubstGoals :: [Goal] -> InferM [Goal]
|
||||
applySubstGoals gs =
|
||||
do gs1 <- applySubst gs
|
||||
return [ g { goal = p } | g <- gs1, p <- pSplitAnd (goal g) ]
|
||||
|
||||
-- | Get the substitution that we have accumulated so far.
|
||||
getSubst :: InferM Subst
|
||||
getSubst = IM $ fmap iSubst get
|
||||
|
@ -232,7 +232,8 @@ capture, because we rely on the 'Subst' datatype invariant to ensure
|
||||
that variable scopes will be properly preserved. -}
|
||||
|
||||
instance TVars Schema where
|
||||
apSubst su (Forall xs ps t) = Forall xs (apSubst su ps) (apSubst su t)
|
||||
apSubst su (Forall xs ps t) = Forall xs (concatMap pSplitAnd (apSubst su ps))
|
||||
(apSubst su t)
|
||||
|
||||
instance TVars Expr where
|
||||
apSubst su = go
|
||||
@ -243,7 +244,13 @@ instance TVars Expr where
|
||||
EAbs x t e1 -> EAbs x (apSubst su t) (go e1)
|
||||
ETAbs a e -> ETAbs a (go e)
|
||||
ETApp e t -> ETApp (go e) (apSubst su t)
|
||||
EProofAbs p e -> EProofAbs (apSubst su p) (go e)
|
||||
EProofAbs p e -> EProofAbs hmm (go e)
|
||||
where hmm = case pSplitAnd (apSubst su p) of
|
||||
[p1] -> p1
|
||||
_ -> panic "apSubst@EProofAbs"
|
||||
[ "Predicate split or disappeared after"
|
||||
, "we applied a substitution." ]
|
||||
|
||||
EProofApp e -> EProofApp (go e)
|
||||
|
||||
EVar {} -> expr
|
||||
|
Loading…
Reference in New Issue
Block a user