Commit eb5ad68a authored by Andrei Paskevich's avatar Andrei Paskevich

Mlw: use Itypur only for the snapshots of impure types

Both ity_app and ity_pur produce Ityapp(s,tl,[]) when s
is a pure type such as int or list.
parent 20fee52d
......@@ -38,7 +38,7 @@ and dvar =
type dvty = dity list * dity (* A -> B -> C == ([A;B],C) *)
let dity_of_dvty (argl,res) =
List.fold_right (fun a d -> Dpur (its_func, [a;d])) argl res
List.fold_right (fun a d -> Dapp (its_func, [a;d], [])) argl res
let dvar_fresh n = ref (Dtvs (create_tvsymbol (id_fresh n)))
......@@ -169,10 +169,10 @@ let reunify_regions () =
(** Built-in types *)
let dity_int = Dpur (its_int, [])
let dity_real = Dpur (its_real, [])
let dity_bool = Dpur (its_bool, [])
let dity_unit = Dpur (its_unit, [])
let dity_int = Dapp (its_int, [], [])
let dity_real = Dapp (its_real, [], [])
let dity_bool = Dapp (its_bool, [], [])
let dity_unit = Dapp (its_unit, [], [])
let dvty_int = [], dity_int
let dvty_real = [], dity_real
......@@ -206,21 +206,18 @@ let rec print_dity pri fmt = function
| Durg (ity,d) ->
Format.fprintf fmt (protect_on (pri > 1) "%a@ @@%s")
(print_dity 0) d (Ident.id_unique rprinter (reg_of_ity ity).reg_name)
| Dpur (s,[t1;t2]) when its_equal s its_func ->
| Dapp (s,[t1;t2],[]) when its_equal s its_func ->
Format.fprintf fmt (protect_on (pri > 0) "%a@ ->@ %a")
(print_dity 1) t1 (print_dity 0) t2
| Dpur (s,tl) when is_ts_tuple s.its_ts ->
| Dapp (s,tl,[]) when is_ts_tuple s.its_ts ->
Format.fprintf fmt "(%a)" (Pp.print_list Pp.comma (print_dity 0)) tl
| Dpur (s,tl) when its_impure s ->
Format.fprintf fmt (protect_on (pri > 1 && tl <> []) "{%a}%a")
Pretty.print_ts s.its_ts (print_args (print_dity 2)) tl
| Dpur (s,tl) ->
Format.fprintf fmt (protect_on (pri > 1 && tl <> []) "%a%a")
Pretty.print_ts s.its_ts (print_args (print_dity 2)) tl
| Dapp (s,tl,rl) ->
Format.fprintf fmt (protect_on (pri > 1) "%a%a%a")
Pretty.print_ts s.its_ts (print_args (print_dity 2)) tl
(print_regs (print_dity 0)) rl
| Dpur (s,tl) ->
Format.fprintf fmt (protect_on (pri > 1 && tl <> []) "{%a}%a")
Pretty.print_ts s.its_ts (print_args (print_dity 2)) tl
let print_dity fmt d = print_dity 0 fmt d
......
This diff is collapsed.
......@@ -39,9 +39,9 @@ and ity_node = private
| Ityreg of region
(** record with mutable fields and shareable components *)
| Ityapp of itysymbol * ity list * region list
(** algebraic type with shareable components *)
(** immutable type or algebraic type with shareable components *)
| Itypur of itysymbol * ity list
(** immutable type or a snapshot of a mutable type *)
(** pure snapshot of a mutable type *)
| Ityvar of tvsymbol
(** type variable *)
......@@ -139,13 +139,14 @@ val ity_reg : region -> ity
val ity_var : tvsymbol -> ity
val ity_pur : itysymbol -> ity list -> ity
(** [ity_pur] may be applied to mutable type symbols to create a snapshot *)
(** [ity_pur s tl] creates
- an [Itypur] snapshot type if [its_impure s] is true
- an [Ityapp (s,tl,[])] type otherwise *)
val ity_app : itysymbol -> ity list -> region list -> ity
(** [ity_app s tl rl] creates
- a fresh region and an [Ityreg] type if [s] is mutable
- an [Itypur] type if [s] is not mutable and [rl] is empty
- an [Ityapp] type otherwise *)
- an [Ityreg] type with a fresh region if [its_mutable s] is true
- an [Ityapp (s,tl,rl)] type otherwise *)
val ity_app_fresh : itysymbol -> ity list -> ity
(** [ity_app_fresh] creates fresh regions where needed *)
......
......@@ -224,7 +224,7 @@ let count_regions {muc_known = kn} {pv_ity = ity} mr =
| Ityreg r -> fields (add_reg r mr) r.reg_its r.reg_args r.reg_regs
| Ityapp (s,tl,rl) -> fields mr s tl rl
| Itypur (s,tl) -> fields mr s tl []
| Ityvar _ -> mr
| Ityvar _ -> assert false
and fields mr s tl rl = if s.its_privmut then mr else
let add_arg isb v ity = ity_match isb (ity_var v) ity in
let isb = List.fold_left2 add_arg isb_empty s.its_ts.ts_args tl in
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment