diff options
Diffstat (limited to 'checker')
| -rw-r--r-- | checker/checkInductive.ml | 10 | ||||
| -rw-r--r-- | checker/checker.ml | 21 | ||||
| -rw-r--r-- | checker/values.ml | 12 |
3 files changed, 20 insertions, 23 deletions
diff --git a/checker/checkInductive.ml b/checker/checkInductive.ml index c370a77ea0..ef606c9a75 100644 --- a/checker/checkInductive.ml +++ b/checker/checkInductive.ml @@ -101,11 +101,17 @@ let check_kelim k1 k2 = Sorts.family_leq k1 k2 (* Use [eq_ind_chk] because when we rebuild the recargs we have lost the knowledge of who is the canonical version. Try with to see test-suite/coqchk/include.v *) +let eq_nested_types ty1 ty2 = match ty1, ty2 with +| NestedInd ind1, NestedInd ind2 -> eq_ind_chk ind1 ind2 +| NestedInd _, _ -> false +| NestedPrimitive c1, NestedPrimitive c2 -> Names.Constant.equal c1 c2 +| NestedPrimitive _, _ -> false + let eq_recarg a1 a2 = match a1, a2 with | Norec, Norec -> true | Mrec i1, Mrec i2 -> eq_ind_chk i1 i2 - | Imbr i1, Imbr i2 -> eq_ind_chk i1 i2 - | (Norec | Mrec _ | Imbr _), _ -> false + | Nested ty1, Nested ty2 -> eq_nested_types ty1 ty2 + | (Norec | Mrec _ | Nested _), _ -> false let eq_reloc_tbl = Array.equal (fun x y -> Int.equal (fst x) (fst y) && Int.equal (snd x) (snd y)) diff --git a/checker/checker.ml b/checker/checker.ml index ab0ea41a36..e2c90e2b93 100644 --- a/checker/checker.ml +++ b/checker/checker.ml @@ -95,12 +95,10 @@ let add_rec_path ~unix_path ~coq_root = else Feedback.msg_warning (str "Cannot open " ++ str unix_path) -(* By the option -include -I or -R of the command line *) +(* By the option -R/-Q of the command line *) let includes = ref [] let push_include (s, alias) = includes := (s,alias) :: !includes -let set_default_include d = - push_include (d, Check.default_root_prefix) let set_include d p = let p = dirpath_of_string p in push_include (d,p) @@ -127,7 +125,7 @@ let init_load_path () = List.iter (fun s -> add_rec_path ~unix_path:s ~coq_root:Check.default_root_prefix) coqpath; (* then current directory *) add_path ~unix_path:"." ~coq_root:Check.default_root_prefix; - (* additional loadpath, given with -I -include -R options *) + (* additional loadpath, given with -R/-Q options *) List.iter (fun (unix_path, coq_root) -> add_rec_path ~unix_path ~coq_root) (List.rev !includes); @@ -321,9 +319,6 @@ let explain_exn = function report ()) | e -> CErrors.print e (* for anomalies and other uncaught exceptions *) -let deprecated flag = - Feedback.msg_warning (str "Deprecated flag " ++ quote (str flag)) - let parse_args argv = let rec parse = function | [] -> () @@ -339,16 +334,8 @@ let parse_args argv = Envars.set_user_coqlib s; parse rem - | ("-I"|"-include") :: d :: "-as" :: p :: rem -> deprecated "-I"; set_include d p; parse rem - | ("-I"|"-include") :: d :: "-as" :: [] -> usage () - | ("-I"|"-include") :: d :: rem -> deprecated "-I"; set_default_include d; parse rem - | ("-I"|"-include") :: [] -> usage () - - | "-Q" :: d :: p :: rem -> set_include d p;parse rem - | "-Q" :: ([] | [_]) -> usage () - - | "-R" :: d :: p :: rem -> set_include d p;parse rem - | "-R" :: ([] | [_]) -> usage () + | ("-Q"|"-R") :: d :: p :: rem -> set_include d p;parse rem + | ("-Q"|"-R") :: ([] | [_]) -> usage () | "-debug" :: rem -> set_debug (); parse rem diff --git a/checker/values.ml b/checker/values.ml index 178a3d8624..38cb243f80 100644 --- a/checker/values.ml +++ b/checker/values.ml @@ -152,7 +152,8 @@ let rec v_constr = [|v_cofix|]; (* CoFix *) [|v_proj;v_constr|]; (* Proj *) [|v_uint63|]; (* Int *) - [|Float64|] (* Int *) + [|Float64|]; (* Float *) + [|v_instance;Array v_constr;v_constr;v_constr|] (* Array *) |]) and v_prec = Tuple ("prec_declaration", @@ -235,7 +236,7 @@ let v_template_universes = v_tuple "template_universes" [|List(Opt v_level);v_context_set|] let v_primitive = - v_enum "primitive" 44 (* Number of "Primitive" in Int63.v and PrimFloat.v *) + v_enum "primitive" 50 (* Number of "Primitive" in Int63.v and PrimFloat.v *) let v_cst_def = v_sum "constant_def" 0 @@ -259,8 +260,11 @@ let v_cb = v_tuple "constant_body" v_bool; v_typing_flags|] +let v_nested = v_sum "nested" 0 + [|[|v_ind|] (* NestedInd *);[|v_cst|] (* NestedPrimitive *)|] + let v_recarg = v_sum "recarg" 1 (* Norec *) - [|[|v_ind|] (* Mrec *);[|v_ind|] (* Imbr *)|] + [|[|v_ind|] (* Mrec *);[|v_nested|] (* Nested *)|] let rec v_wfp = Sum ("wf_paths",0, [|[|Int;Int|]; (* Rtree.Param *) @@ -317,7 +321,7 @@ let v_ind_pack = v_tuple "mutual_inductive_body" let v_prim_ind = v_enum "prim_ind" 6 (* Number of "Register ... as kernel.ind_..." in Int63.v and PrimFloat.v *) -let v_prim_type = v_enum "prim_type" 2 +let v_prim_type = v_enum "prim_type" 3 (* Number of constructors of prim_type in "kernel/cPrimitives.ml" *) let v_retro_action = |