Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Checker: re-sync vo structures after Maxime's commit 16136

 make validate still fails, but that's another issue (#2949) we're
 still working on...

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16198 85f007b7-540e-0410-9357-904b9bb8a0f7
  • Loading branch information...
commit 33c0d04c1ae40fb3eded886f8d82eb941e588fc9 1 parent 351c92f
letouzey authored
3  Makefile.build
@@ -370,7 +370,8 @@ install-ide-info:
370 370
371 371 .PHONY: validate check test-suite $(ALLSTDLIB).v
372 372
373   -VALIDOPTS=-silent -o -m
  373 +
  374 +VALIDOPTS=$(if $(VERBOSE),,-silent) -o -m
374 375
375 376 validate:: $(CHICKEN) $(ALLVO)
376 377 $(SHOW)'COQCHK <theories & plugins>'
26 checker/declarations.ml
@@ -7,6 +7,8 @@ open Validate
7 7 type values
8 8 type reloc_table
9 9 type to_patch_substituted
  10 +(* Native code *)
  11 +type native_name
10 12 (*Retroknowledge *)
11 13 type action
12 14 type retroknowledge
@@ -518,7 +520,9 @@ type constant_body = {
518 520 const_body : constant_def;
519 521 const_type : constant_type;
520 522 const_body_code : to_patch_substituted;
521   - const_constraints : Univ.constraints }
  523 + const_constraints : Univ.constraints;
  524 + const_native_name : native_name ref;
  525 + const_inline_code : bool }
522 526
523 527 let body_of_constant cb = match cb.const_body with
524 528 | Undef _ -> None
@@ -538,7 +542,9 @@ let val_cb = val_tuple ~name:"constant_body"
538 542 val_cst_def;
539 543 val_cst_type;
540 544 no_val;
541   - val_cstrs|]
  545 + val_cstrs;
  546 + no_val;
  547 + val_bool|]
542 548
543 549 let subst_rel_declaration sub (id,copt,t as x) =
544 550 let copt' = Option.smartmap (subst_mps sub) copt in
@@ -689,10 +695,13 @@ type mutual_inductive_body = {
689 695 (* Universes constraints enforced by the inductive declaration *)
690 696 mind_constraints : Univ.constraints;
691 697
  698 + (* Data for native compilation *)
  699 + mind_native_name : native_name ref;
  700 +
692 701 }
693 702 let val_ind_pack = val_tuple ~name:"mutual_inductive_body"
694 703 [|val_array val_one_ind;val_bool;val_bool;val_int;val_nctxt;
695   - val_int; val_int; val_rctxt;val_cstrs|]
  704 + val_int; val_int; val_rctxt;val_cstrs;no_val|]
696 705
697 706
698 707 let subst_arity sub = function
@@ -700,12 +709,12 @@ let subst_arity sub = function
700 709 | PolymorphicArity (ctx,s) -> PolymorphicArity (subst_rel_context sub ctx,s)
701 710
702 711 (* TODO: should be changed to non-coping after Term.subst_mps *)
703   -let subst_const_body sub cb = {
  712 +(* NB: we leave bytecode and native code fields untouched *)
  713 +let subst_const_body sub cb =
  714 + { cb with
704 715 const_hyps = (assert (cb.const_hyps=[]); []);
705 716 const_body = subst_constant_def sub cb.const_body;
706   - const_type = subst_arity sub cb.const_type;
707   - const_body_code = (*Cemitcodes.subst_to_patch_subst sub*) cb.const_body_code;
708   - const_constraints = cb.const_constraints}
  717 + const_type = subst_arity sub cb.const_type }
709 718
710 719 let subst_arity sub = function
711 720 | Monomorphic s ->
@@ -742,7 +751,8 @@ let subst_mind sub mib =
742 751 mind_params_ctxt =
743 752 map_rel_context (subst_mps sub) mib.mind_params_ctxt;
744 753 mind_packets = Array.smartmap (subst_mind_packet sub) mib.mind_packets ;
745   - mind_constraints = mib.mind_constraints }
  754 + mind_constraints = mib.mind_constraints;
  755 + mind_native_name = mib.mind_native_name}
746 756
747 757 (* Modules *)
748 758
9 checker/declarations.mli
@@ -5,6 +5,8 @@ open Term
5 5 type values
6 6 type reloc_table
7 7 type to_patch_substituted
  8 +(* Native code *)
  9 +type native_name
8 10 (*Retroknowledge *)
9 11 type action
10 12 type retroknowledge
@@ -57,7 +59,9 @@ type constant_body = {
57 59 const_body : constant_def;
58 60 const_type : constant_type;
59 61 const_body_code : to_patch_substituted;
60   - const_constraints : Univ.constraints }
  62 + const_constraints : Univ.constraints;
  63 + const_native_name : native_name ref;
  64 + const_inline_code : bool }
61 65
62 66 val body_of_constant : constant_body -> constr_substituted option
63 67 val constant_has_body : constant_body -> bool
@@ -167,6 +171,9 @@ type mutual_inductive_body = {
167 171 (* Universes constraints enforced by the inductive declaration *)
168 172 mind_constraints : Univ.constraints;
169 173
  174 + (* Data for native compilation *)
  175 + mind_native_name : native_name ref;
  176 +
170 177 }
171 178
172 179 (* Modules *)
4 checker/term.ml
@@ -80,8 +80,8 @@ let val_fix f =
80 80 [|val_tuple~name:"fix2"[|val_array val_int;val_int|];val_prec f|]
81 81 let val_cofix f = val_tuple ~name:"pcofixpoint"[|val_int;val_prec f|]
82 82
83   -type cast_kind = VMcast | DEFAULTcast
84   -let val_cast = val_enum "cast_kind" 2
  83 +type cast_kind = VMcast | NATIVEcast | DEFAULTcast
  84 +let val_cast = val_enum "cast_kind" 3
85 85
86 86 (*s*******************************************************************)
87 87 (* The type of constructions *)
2  checker/term.mli
@@ -23,7 +23,7 @@ type 'a pexistential = existential_key * 'a array
23 23 type 'a prec_declaration = name array * 'a array * 'a array
24 24 type 'a pfixpoint = (int array * int) * 'a prec_declaration
25 25 type 'a pcofixpoint = int * 'a prec_declaration
26   -type cast_kind = VMcast | DEFAULTcast
  26 +type cast_kind = VMcast | NATIVEcast | DEFAULTcast
27 27 type constr =
28 28 Rel of int
29 29 | Var of Id.t
2  checker/typeops.ml
@@ -167,7 +167,7 @@ let sort_of_product env domsort rangsort =
167 167 let judge_of_cast env (c,cj) k tj =
168 168 let conversion =
169 169 match k with
170   - | VMcast -> vm_conv CUMUL
  170 + | VMcast | NATIVEcast -> vm_conv CUMUL
171 171 | DEFAULTcast -> conv_leq in
172 172 try
173 173 conversion env cj tj

0 comments on commit 33c0d04

Please sign in to comment.
Something went wrong with that request. Please try again.