(** To be increased each time the command type below changes, used for "safe"
* marshalling *)
-let magic = 36
+let magic = 37
(* composed magic: term + command magics. No need to change this value *)
let magic = magic + 10000 * NotationPt.magic
| NObj of loc * nterm NotationPt.obj * bool
| NDiscriminator of loc * nterm
| NInverter of loc * string * nterm * bool list option * nterm option
- | NUnivConstraint of loc * NUri.uri * NUri.uri
+ | NUnivConstraint of loc * bool * NUri.uri * NUri.uri
| NCopy of loc * string * NUri.uri * (NUri.uri * NUri.uri) list
| NCoercion of loc * string * bool *
(nterm * nterm * (string * nterm) * nterm) option
;;
let inject_constraint =
- let basic_eval_add_constraint (u1,u2)
+ let basic_eval_add_constraint (acyclic,u1,u2)
~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
~alias_only status
=
(* NCicLibrary.add_constraint adds the constraint to the NCicEnvironment
* and also to the storage (for undo/redo). During inclusion of compiled
* files the storage must not be touched. *)
- NCicEnvironment.add_lt_constraint u1 u2;
+ NCicEnvironment.add_lt_constraint acyclic u1 u2;
status
else
status
GrafiteTypes.Serializer.register#run "constraints" basic_eval_add_constraint
;;
-let eval_add_constraint status u1 u2 =
- let status = NCicLibrary.add_constraint status u1 u2 in
- NCicLibrary.dump_obj status (inject_constraint (u1,u2))
+let eval_add_constraint status acyclic u1 u2 =
+ let status = NCicLibrary.add_constraint status acyclic u1 u2 in
+ NCicLibrary.dump_obj status (inject_constraint (acyclic,u1,u2))
;;
let eval_ng_tac tac =
eval_ncommand ~include_paths opts status
("",0,GrafiteAst.NQed(Stdpp.dummy_loc,false))
| _ -> assert false)
- | GrafiteAst.NUnivConstraint (loc,u1,u2) ->
- eval_add_constraint status [`Type,u1] [`Type,u2]
+ | GrafiteAst.NUnivConstraint (loc,acyclic,u1,u2) ->
+ eval_add_constraint status acyclic [`Type,u1] [`Type,u2]
(* ex lexicon commands *)
| GrafiteAst.Interpretation (loc, dsc, (symbol, args), cic_appl_pattern) ->
let cic_appl_pattern =
paramspec = OPT inverter_param_list ;
outsort = OPT [ SYMBOL ":" ; outsort = term -> outsort ] ->
G.NInverter (loc,name,indty,paramspec,outsort)
- | IDENT "universe"; IDENT "constraint"; u1 = tactic_term;
+ | IDENT "universe"; cyclic = OPT [ IDENT "cyclic" -> () ] ; IDENT "constraint"; u1 = tactic_term;
SYMBOL <:unicode<lt>> ; u2 = tactic_term ->
+ let acyclic = match cyclic with None -> true | Some () -> false in
let urify = function
| NotationPt.AttributedTerm (_, NotationPt.Sort (`NType i)) ->
NUri.uri_of_string ("cic:/matita/pts/Type"^i^".univ")
in
let u1 = urify u1 in
let u2 = urify u2 in
- G.NUnivConstraint (loc,u1,u2)
+ G.NUnivConstraint (loc,acyclic,u1,u2)
| IDENT "unification"; IDENT "hint"; n = int; t = tactic_term ->
G.UnificationHint (loc, t, n)
| IDENT "coercion"; name = IDENT;
| C.Prop -> (C.Type [])
;;
-let add_lt_constraint a b =
+let add_lt_constraint ~acyclic a b =
match a,b with
| [`Type,a2],[`Type,b2] ->
if not (lt_path_uri [] a2 b2) then (
- if lt_path_uri [] b2 a2 || NUri.eq a2 b2 then
+ if acyclic && (lt_path_uri [] b2 a2 || NUri.eq a2 b2) then
(raise(BadConstraint(lazy("universe inconsistency adding "^
pp_constraint a2 b2
^ " to:\n" ^ pp_constraints ()))));
(* raise BadConstraints if the second arg. is an inferred universe or
* if the added constraint gives circularity *)
exception BadConstraint of string Lazy.t;;
-val add_lt_constraint: NCic.universe -> NCic.universe -> unit
+val add_lt_constraint: acyclic:bool -> NCic.universe -> NCic.universe -> unit
val universe_eq: NCic.universe -> NCic.universe -> bool
val universe_leq: NCic.universe -> NCic.universe -> bool
val universe_lt: NCic.universe -> NCic.universe -> bool
status#set_timestamp (!storage,!local_aliases)
;;
-let add_constraint status u1 u2 =
+let add_constraint status ~acyclic u1 u2 =
if
List.exists
(function `Constr (u1',u2') when u1=u1' && u2=u2' -> true | _ -> false)
then
(*CSC: raise an exception here! *)
(prerr_endline "CANNOT ADD A CONSTRAINT TWICE"; assert false);
- NCicEnvironment.add_lt_constraint u1 u2;
+ NCicEnvironment.add_lt_constraint ~acyclic u1 u2;
storage := (`Constr (u1,u2)) :: !storage;
status#set_timestamp (!storage,!local_aliases)
;;
(* it also checks it and add it to the environment *)
val add_obj: #status as 'status -> NCic.obj -> 'status
val add_constraint:
- #status as 'status -> NCic.universe -> NCic.universe -> 'status
+ #status as 'status -> acyclic:bool ->
+ NCic.universe -> NCic.universe -> 'status
val aliases_of: NUri.uri -> NReference.reference list
val resolve: string -> NReference.reference list
(*
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+universe cyclic constraint Type[U] < Type[U].
+
+definition inconsistent: Type[U] ≝ Type[U].
<keyword>coinductive</keyword>
<keyword>constraint</keyword>
<keyword>corec</keyword>
+ <keyword>cyclic</keyword>
<keyword>default</keyword>
<keyword>discriminator</keyword>
<keyword>for</keyword>