diff options
| author | Pierre-Marie Pédrot | 2018-10-09 16:54:16 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2018-10-11 13:05:38 +0200 |
| commit | 1af17614793bfcdaa73afc9965db7fd3918bdc1c (patch) | |
| tree | 05390d2b26cee8c4689a4974040d3e739eee4618 /kernel/conv_oracle.ml | |
| parent | 4a244648cff78c7f7333ac5b335de3f6e742908a (diff) | |
Stupid but critical unfolding heuristic.
We favour unfolding of variables over constants because it is more frequent
for the former to depend on the latter. This has huge consequences on a few
extremely slow lines in mathcomp, up to dividing by 3 single-line invocations
that were taking about 30s on my laptop before the patch.
Diffstat (limited to 'kernel/conv_oracle.ml')
| -rw-r--r-- | kernel/conv_oracle.ml | 15 |
1 files changed, 12 insertions, 3 deletions
diff --git a/kernel/conv_oracle.ml b/kernel/conv_oracle.ml index c74f2ab318..ac78064235 100644 --- a/kernel/conv_oracle.ml +++ b/kernel/conv_oracle.ml @@ -83,18 +83,27 @@ let fold_strategy f { var_opacity; cst_opacity; _ } accu = let get_transp_state { var_trstate; cst_trstate; _ } = (var_trstate, cst_trstate) +let dep_order l2r k1 k2 = match k1, k2 with +| RelKey _, RelKey _ -> l2r +| RelKey _, (VarKey _ | ConstKey _) -> true +| VarKey _, RelKey _ -> false +| VarKey _, VarKey _ -> l2r +| VarKey _, ConstKey _ -> true +| ConstKey _, (RelKey _ | VarKey _) -> false +| ConstKey _, ConstKey _ -> l2r + (* Unfold the first constant only if it is "more transparent" than the second one. In case of tie, use the recommended default. *) let oracle_order f o l2r k1 k2 = match get_strategy o f k1, get_strategy o f k2 with - | Expand, Expand -> l2r + | Expand, Expand -> dep_order l2r k1 k2 | Expand, (Opaque | Level _) -> true | (Opaque | Level _), Expand -> false - | Opaque, Opaque -> l2r + | Opaque, Opaque -> dep_order l2r k1 k2 | Level _, Opaque -> true | Opaque, Level _ -> false | Level n1, Level n2 -> - if Int.equal n1 n2 then l2r + if Int.equal n1 n2 then dep_order l2r k1 k2 else n1 < n2 let get_strategy o = get_strategy o (fun x -> x) |
