Commit dd209d29 authored by Kim Nguyễn's avatar Kim Nguyễn

Fix variable ordering problem by adding a 'kind' field inside variables so...

Fix variable ordering problem by adding a 'kind' field inside variables so that variables of the function type are processed before arguments types and after Gamma.
parent 06abcb05
...@@ -2835,6 +2835,13 @@ module Positive = struct ...@@ -2835,6 +2835,13 @@ module Positive = struct
let new_t = substitute_aux delta dec (subst h) in let new_t = substitute_aux delta dec (subst h) in
descr (solve new_t) descr (solve new_t)
let substitute_kind delta kind t =
if no_var t then t else
let subst kin d = var (Var.set_kind kind d) in
let dec = decompose t in
let new_t = substitute_aux delta dec (subst kind) in
descr (solve new_t)
(* We cannot use the variance annotation of variables to simplify them, (* We cannot use the variance annotation of variables to simplify them,
since variables are shared amongst types. If we have two types since variables are shared amongst types. If we have two types
A -> A and (A,A) (produced by the algorithm) then we can still simplify the A -> A and (A,A) (produced by the algorithm) then we can still simplify the
...@@ -3592,8 +3599,11 @@ exception FoundApply of t * int * int * Tallying.CS.sl ...@@ -3592,8 +3599,11 @@ exception FoundApply of t * int * int * Tallying.CS.sl
(** find two sets of type substitutions I,J such that (** find two sets of type substitutions I,J such that
s @@ sigma_i < t @@ sigma_j for all i \in I, j \in J *) s @@ sigma_i < t @@ sigma_j for all i \in I, j \in J *)
let apply_raw delta s t = let apply_raw delta s t =
Tallying.NormMemoHash.clear Tallying.memo_norm; Tallying.NormMemoHash.clear Tallying.memo_norm;
let s = Positive.substitute_kind delta Var.function_kind s in
let t = Positive.substitute_kind delta Var.argument_kind t in
let vgamma = Var.mk "Gamma" in let vgamma = Var.mk "Gamma" in
let gamma = var vgamma in let gamma = var vgamma in
let cgamma = cons gamma in let cgamma = cons gamma in
......
module V = struct module V = struct
type t = { id : Ident.U.t ; fr : int } type t = { id : Ident.U.t ; fr : int ; kind : int }
type kind = int
let function_kind = 1
let argument_kind = 2
let dump ppf t = Format.fprintf ppf "{%a(%d)}" Ident.U.print t.id t.fr let dump ppf t = Format.fprintf ppf "{%a(%d)}" Ident.U.print t.id t.fr
let compare x y = Pervasives.compare (x.id,x.fr) (y.id,y.fr) let compare x y = Pervasives.compare (x.kind,x.id,x.fr) (y.kind,y.id,y.fr)
let equal x y = (compare x y) = 0 let equal x y = (compare x y) = 0
let hash x = Hashtbl.hash (x.id,x.fr) let hash x = Hashtbl.hash (x.id,x.fr,x.kind)
let check _ = () let check _ = ()
let freshcounter = ref 0
let is_fresh x = x.fr > 0 let is_fresh x = x.fr > 0
let fresh v = { v with fr = v.fr + 1 }
let mk id = { id = Ident.U.mk id; fr = 0 } let fresh v = { v with fr = (incr freshcounter;!freshcounter) }
let id x = Ident.U.get_str x.id
let mk id = { id = Ident.U.mk id; fr = 0; kind = 0; }
let id x = Ident.U.get_str x.id
let set_kind k v = { v with kind = k }
let pp ppf x = Format.fprintf ppf "'%a" Ident.U.print x.id let pp ppf x = Format.fprintf ppf "'%a" Ident.U.print x.id
let pp ppf x = dump ppf x
end end
include V include V
......
include Custom.T include Custom.T
type kind
type var = t type var = t
val function_kind : kind
val argument_kind : kind
val set_kind : kind -> t -> t
val pp : Format.formatter -> t -> unit val pp : Format.formatter -> t -> unit
val mk : string -> t val mk : string -> t
val id : t -> string val id : t -> string
......
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