Skip to content
This repository
Browse code

[fix] ei: correctly computing the have_typeof set when variables aren…

…'t shared in a recursive set of bindings
  • Loading branch information...
commit 852f58c05c74d3433ad5de5810bbd788588c4c51 1 parent caf4f1e
Valentin Gatien-Baron authored OpaOnWindowsNow committed

Showing 1 changed file with 34 additions and 7 deletions. Show diff stats Hide diff stats

  1. +34 7 qmlpasses/pass_ExplicitInstantiation.ml
41 qmlpasses/pass_ExplicitInstantiation.ml
@@ -1187,9 +1187,19 @@ let walk_generalization (have_typeof:QmlTypeVars.FreeVars.t) id gamma annotmap e
1187 1187
1188 1188 (* Calculates the set of type variables that are used in any @typeof;
1189 1189 can be computed incrementally, but according to the order
1190   - of dependecies between top-level values; until we implement polymorphic
1191   - recursion, we don't need a fixpoint computation for mutual recursion,
1192   - even a local fixpoint (for a single toplevel ValRec set) is not needed *)
  1190 + of dependencies between top-level values
  1191 +
  1192 + We need a fixpoint for recursive bindings if the variables in their schemes
  1193 + are not guaranteed to be identical:
  1194 + rec f(x) = g(x) and g(x) = f(x)
  1195 + if the typeschemes of f and g share the same 'a, then there is no need for a fixpoint
  1196 + (this is the kind of types returned by the typer)
  1197 + However, if the variables are not guaranteed to be shared, then we need
  1198 + the fixpoint (and this happens because the early lambda lifting refreshes
  1199 + variables to avoid some unwanted sharing)
  1200 + Since the lambda lifting refreshes only toplevel declarations, we never need a fixpoint
  1201 + for local recursions
  1202 +*)
1193 1203 let debug fmt = console_debug "have_typeof" fmt
1194 1204 let have_typeof ~set gamma annotmap qmlAst =
1195 1205 let walk (tainted:QmlTypeVars.FreeVars.t) e =
@@ -1263,12 +1273,29 @@ let have_typeof ~set gamma annotmap qmlAst =
1263 1273 let new_tainted = QmlTypeVars.FreeVars.diff tainted _original_tainted in
1264 1274 debug "%s" (QmlTypeVars.FreeVars.to_string new_tainted)
1265 1275 #<End>;
1266   - tainted
1267   - in
  1276 + tainted in
1268 1277 let walk_top tainted top = QmlAstWalk.Expr.fold_up walk tainted top in
  1278 + let size {QmlTypeVars.typevar; rowvar; colvar} =
  1279 + QmlTypeVars.TypeVarSet.cardinal typevar +
  1280 + QmlTypeVars.RowVarSet.cardinal rowvar +
  1281 + QmlTypeVars.ColVarSet.cardinal colvar in
1269 1282 let lt =
1270   - QmlAstWalk.CodeExpr.fold walk_top set qmlAst
1271   - in
  1283 + List.fold_left
  1284 + (fun lt code_elt ->
  1285 + match code_elt with
  1286 + | Q.NewVal (_,iel) ->
  1287 + List.fold_left (fun lt (_,e) -> walk_top lt e) lt iel
  1288 + | Q.NewValRec (_,iel) ->
  1289 + (* fixpointing *)
  1290 + let rec repeat prev_size lt =
  1291 + let lt = List.fold_left (fun lt (_,e) -> walk_top lt e) lt iel in
  1292 + let new_size = size lt in
  1293 + if new_size = prev_size then lt
  1294 + else repeat new_size lt in
  1295 + repeat (size lt) lt
  1296 + | _ ->
  1297 + assert false
  1298 + ) set qmlAst in
1272 1299 #<If:EXPL_INST_DEBUG>
1273 1300 let s_lt = QmlTypeVars.FreeVars.to_string lt in
1274 1301 debug "Total have typeof list is %s" s_lt

0 comments on commit 852f58c

Please sign in to comment.
Something went wrong with that request. Please try again.