Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

log scope updates so we can backtrack them

master
Thomas Refis 2018-02-20 12:04:14 +00:00
parent acf4d56e76
commit 134b1b1693
3 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
typing/btype.ml
View File

@ -72,6 +72,7 @@ type change =
Ctype of type_expr * type_desc
| Ccompress of type_expr * type_desc * type_desc
| Clevel of type_expr * int
| Cscope of type_expr * int option
| Cname of
(Path.t * type_expr list) option ref * (Path.t * type_expr list) option
| Crow of row_field option ref * row_field option
@ -639,6 +640,7 @@ let undo_change = function
Ctype (ty, desc) -> ty.desc <- desc
| Ccompress (ty, desc, _) -> ty.desc <- desc
| Clevel (ty, level) -> ty.level <- level
| Cscope (ty, scope) -> ty.scope <- scope
| Cname (r, v) -> r := v
| Crow (r, v) -> r := v
| Ckind (r, v) -> r := v
@ -672,6 +674,9 @@ let link_type ty ty' =
let set_level ty level =
if ty.id <= !last_snapshot then log_change (Clevel (ty, ty.level));
ty.level <- level
let set_scope ty scope =
if ty.id <= !last_snapshot then log_change (Cscope (ty, ty.scope));
ty.scope <- scope
let set_univar rty ty =
log_change (Cuniv (rty, !rty)); rty := Some ty
let set_name nm v =

1
typing/btype.mli
View File

@ -198,6 +198,7 @@ val link_type: type_expr -> type_expr -> unit
(* Set the desc field of [t1] to [Tlink t2], logging the old
value if there is an active snapshot *)
val set_level: type_expr -> int -> unit
val set_scope: type_expr -> int option -> unit
val set_name:
(Path.t * type_expr list) option ref ->
(Path.t * type_expr list) option -> unit

8
typing/ctype.ml
View File

@ -734,7 +734,7 @@ let update_scope scope ty =
| Some lvl' -> max lvl lvl'
in
if ty.level < scope then raise (Unify [(ty, newvar2 ty.level)]);
ty.scope <- (Some scope)
set_scope ty (Some scope)
let rec update_level env level expand ty =
let ty = repr ty in
@ -985,7 +985,7 @@ let rec copy ?partial ?keep_names ty =
let desc = ty.desc in
save_desc ty desc;
let t = newvar() in (* Stub *)
t.scope <- ty.scope;
set_scope t ty.scope;
ty.desc <- Tsubst t;
t.desc <-
begin match desc with
@ -1454,8 +1454,8 @@ let expand_abbrev_gen kind find_type_expansion env ty =
None -> ()
| Some lv ->
if level < lv then raise (Unify [(ty, newvar2 level)]);
ty.scope <- (Some lv);
ty'.scope <- (Some lv)
set_scope ty (Some lv);
set_scope ty' (Some lv)
end;
ty'
end