aboutsummaryrefslogtreecommitdiff
path: root/kernel
diff options
context:
space:
mode:
authorcoqbot-app[bot]2020-11-12 13:39:48 +0000
committerGitHub2020-11-12 13:39:48 +0000
commit24140636aa5562ba2dee407127339be1c96f4293 (patch)
treef8644de41b093ad0956f9b0537fecaa091ebeb2f /kernel
parentc53abd9bf4517ba66c732034fb5f9aedef6d0930 (diff)
parent332bb8c5199eb264d09d2810546170e0654f4527 (diff)
Merge PR #13331: Fix #13330: Kernel messes with polymorphic side-effects.
Reviewed-by: Zimmi48 Reviewed-by: SkySkimmer Ack-by: gares Ack-by: jfehrle Ack-by: jashug Ack-by: ejgallego
Diffstat (limited to 'kernel')
-rw-r--r--kernel/safe_typing.ml10
1 files changed, 5 insertions, 5 deletions
diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index bf02ceb2c2..6abd283f6c 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -671,7 +671,7 @@ let inline_side_effects env body side_eff =
let side_eff = List.fold_left (fun accu (cb, _) -> cb :: accu) [] side_eff in
let side_eff = List.rev side_eff in
(** Most recent side-effects first in side_eff *)
- if List.is_empty side_eff then (body, Univ.ContextSet.empty, sigs)
+ if List.is_empty side_eff then (body, Univ.ContextSet.empty, sigs, 0)
else
(** Second step: compute the lifts and substitutions to apply *)
let cname c r = Context.make_annot (Name (Label.to_id (Constant.label c))) r in
@@ -725,10 +725,10 @@ let inline_side_effects env body side_eff =
else mkLetIn (na, b, ty, accu)
in
let body = List.fold_right fold_arg args body in
- (body, ctx, sigs)
+ (body, ctx, sigs, len - 1)
let inline_private_constants env ((body, ctx), side_eff) =
- let body, ctx',_ = inline_side_effects env body side_eff in
+ let body, ctx', _, _ = inline_side_effects env body side_eff in
let ctx' = Univ.ContextSet.union ctx ctx' in
(body, ctx')
@@ -880,11 +880,11 @@ let add_constant l decl senv =
match decl with
| OpaqueEntry ce ->
let handle env body eff =
- let body, uctx, signatures = inline_side_effects env body eff in
+ let body, uctx, signatures, skip = inline_side_effects env body eff in
let trusted = check_signatures senv signatures in
let trusted, uctx = match trusted with
| None -> 0, uctx
- | Some univs -> List.length signatures, Univ.ContextSet.union univs uctx
+ | Some univs -> skip, Univ.ContextSet.union univs uctx
in
body, uctx, trusted
in