Une MAJ de sécurité est nécessaire sur notre version actuelle. Elle sera effectuée lundi 02/08 entre 12h30 et 13h. L'interruption de service devrait durer quelques minutes (probablement moins de 5 minutes).

Commit a75af46a by Jean-Christophe Filliâtre

### coercions: simplified interface for module Coercion

parent 8ebc05d2
 ... ... @@ -11,6 +11,7 @@ module Simple end module SameOne use import Simple end ... ... @@ -31,7 +32,7 @@ module SimplePolymorphic function f (t 'a) : int meta coercion function f goal G: forall x: t (bool,bool). x = 42 goal G: forall x: t (bool,bool). x = 42 end ... ... @@ -53,11 +54,13 @@ module Transitivity end module SameTransitivity use import Transitivity end module SameTransitivityCheck use import Transitivity use import SameTransitivity ... ... @@ -108,27 +111,24 @@ module TrickyPolymorphicBeta function g (t1 'a) : t2 (list 'a) meta coercion function g goal a : forall x:t int, y:t2 (list (list int)). x = y end module InTypeArgs type t1 'a type t2 'a type t3 'a type t1 'a type t2 'a type t3 'a function t2_of_t1 (t1 'a) : t2 'a meta coercion function t2_of_t1 function bool_of_int bool : int meta coercion function bool_of_int function t2_of_t1 (t1 'a) : t2 'a meta coercion function t2_of_t1 function bool_of_int bool : int meta coercion function bool_of_int function h (x: t1 'a) (b: int) : t1 int function h (x: t1 'a) (b: int) : t1 int goal G: forall x: t1 'a, y: t2 int. h x true = y goal G: forall x: t1 'a, y: t2 int. h x true = y end \ No newline at end of file
 ... ... @@ -30,16 +30,19 @@ let create_crc ls = { crc_kind = CRCleaf ls; crc_src = ty1; crc_tar = ty2; crc_len = 1 } | _ -> raise (NotACoercion ls) let mem crcmap ts1 ts2 = try let m = Mts.find ts1 crcmap in Mts.mem ts2 m with Not_found -> false let find crcmap ts1 ts2 = let find_crc crcmap ts1 ts2 = Mts.find ts2 (Mts.find ts1 crcmap) let find crcmap ts1 ts2 = let crc = find_crc crcmap ts1 ts2 in let rec ls_list_of acc = function | CRCleaf ls -> ls :: acc | CRCcomp (k1, k2) -> ls_list_of (ls_list_of acc k2) k1 in ls_list_of [] crc.crc_kind (* replace an old coercion by a new one, or fail *) let rec ck_eq ck_old ck_new = ... ... @@ -55,12 +58,11 @@ let replace c_old c_new _m1 m = try ck_eq c_old.crc_kind c_new.crc_kind; m with Not_found -> raise (CoercionAlreadyDefined c_old) (* add a new coercion c, without making the transitive closure *) let insert crc m = let put crc m1 m2 = Mts.add crc.crc_src (Mts.add crc.crc_tar crc m1) m2 in if mem m crc.crc_tar crc.crc_src then raise (CoercionCycle (find m crc.crc_tar crc.crc_src)); raise (CoercionCycle (find_crc m crc.crc_tar crc.crc_src)); let m1 = Mts.find_def Mts.empty crc.crc_src m in if Mts.mem crc.crc_tar m1 then replace (Mts.find crc.crc_tar m1) crc m1 m else put crc m1 m ... ... @@ -105,7 +107,7 @@ let print_kind fmt crc = let s1, s2 = ty_str_of ls in Format.fprintf fmt "%s: %s -> %s" ls.ls_name.id_string s1 s2 | CRCcomp (k1, k2) -> Format.fprintf fmt "%a \n %a" print_kind k1 print_kind k2 Format.fprintf fmt "%a@\n%a" print_kind k1 print_kind k2 in print_kind fmt crc let rec print_kind_ls fmt = function ... ... @@ -114,10 +116,9 @@ let rec print_kind_ls fmt = function | CRCcomp (k1, k2) -> Format.fprintf fmt "%a; %a" print_kind_ls k1 print_kind_ls k2 let already_a_coercion fmt crc = Format.fprintf fmt "There is already a coercion [%a] from type %s to type %s@ \n %a" Format.fprintf fmt "There is already a coercion [%a] from type %s to type %s:@\n%a" print_kind_ls crc.crc_kind crc.crc_src.ts_name.id_string crc.crc_tar.ts_name.id_string print_kind crc.crc_kind ... ...
 type coercion_kind = | CRCleaf of Term.lsymbol | CRCcomp of coercion_kind * coercion_kind type coercion = private { crc_kind: coercion_kind; crc_src : Ty.tysymbol; crc_tar : Ty.tysymbol; crc_len : int; } open Ty open Term type t (** a set of coercions *) val empty: t val add: t -> Term.lsymbol -> t val add: t -> lsymbol -> t (** adds a new coercion from function [ls: ty1 -> ty2 ] raises an error if - this introduces a cycle, i.e. a coercion from [ty2] to [ty1] is already defined; - function [ls] cannot be coercion, i.e. [ty1 = ty2]; - this introduces a cycle, i.e. a coercion from [ty2] to [ty1] is already defined; - function [ls] cannot be used as a coercion, e.g. [ty1 = ty2]; - a coercion from [ty1] to [ty2] is already defined *) val find: t -> Ty.tysymbol -> Ty.tysymbol -> coercion val find: t -> tysymbol -> tysymbol -> lsymbol list (** returns the coercion, or raises [Not_found] *) val union: t -> t -> t ... ...
 ... ... @@ -296,15 +296,14 @@ let dpattern ?loc node = let slab_coercion = Slab.singleton Pretty.label_coercion let rec apply_coercion ~loc k dt = match k with | Coercion.CRCleaf ls -> let apply_coercion ~loc l dt = let apply dt ls = let (dtyl, dty) = specialize_ls ls in let dtl = [dt] in List.iter2 dterm_expected_type dtl dtyl; let dt = { dt_node = DTapp (ls, dtl); dt_dty = dty; dt_loc = loc } in { dt with dt_node = DTlabel (dt, slab_coercion) } | Coercion.CRCcomp (k1, k2) -> apply_coercion ~loc k2 (apply_coercion ~loc k1 dt) { dt with dt_node = DTlabel (dt, slab_coercion) } in List.fold_left apply dt l (* coercions using just head tysymbols without type arguments: *) (* TODO: this can be improved *) ... ... @@ -333,10 +332,9 @@ let dterm_expected tuc dt dty = if (ts_equal ts1 ts2) then dt else let crc = Coercion.find tuc.Theory.uc_crcmap ts1 ts2 in apply_coercion ~loc:dt.dt_loc crc.Coercion.crc_kind dt apply_coercion ~loc:dt.dt_loc crc dt with Not_found | UndefinedTypeVar _ -> dt let dterm_expected_dterm tuc dt dty = let dt = dterm_expected tuc dt (Some dty) in dterm_expected_type dt dty; ... ... @@ -347,7 +345,6 @@ let dfmla_expected_dterm tuc dt = dfmla_expected_type dt; dt let dterm tuc ?loc node = let dterm_node loc node = let mk_dty ty = { dt_node = node; dt_dty = ty; dt_loc = loc } in ... ...
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!