~naesten/coq/trunk

« back to all changes in this revision

Viewing changes to toplevel/vernacentries.ml

  • Committer: herbelin
  • Date: 2009-11-08 17:31:16 UTC
  • Revision ID: svn-v4:85f007b7-540e-0410-9357-904b9bb8a0f7:trunk:12481
Restructuration of command.ml + generic infrastructure for inductive schemes
- Cleaning and uniformisation in command.ml:
  - For better modularity and better visibility, two files got isolated
    out of command.ml:
    - lemmas.ml is about starting and saving a proof
    - indschemes.ml is about declaring inductive schemes
  - Decomposition of the functions of command.ml into a functional part
    and the imperative part
- Inductive schemes:
  - New architecture in ind_tables.ml for registering scheme builders,
    and for sharing and generating on demand inductive schemes
  - Adding new automatically generated equality schemes (file eqschemes.ml)
    - "_congr" for equality types (completing here commit 12273)
    - "_rew_forward" (similar to vernac-level eq_rect_r), "_rew_forward_dep",
      "_rew_backward" (similar to eq_rect), "_rew_backward_dep" for
      rewriting schemes (warning, rew_forward_dep cannot be stated following
      the standard Coq pattern for inductive types: "t=u" cannot be the
      last argument of the scheme)
    - "_case", "_case_nodep", "_case_dep" for case analysis schemes
  - Preliminary step towards discriminate and injection working on any
    equality-like type (e.g. eq_true)
  - Restating JMeq_congr under the canonical form of congruence schemes
  - Renamed "Set Equality Scheme" into "Set Equality Schemes"
  - Added "Set Rewriting Schemes", "Set Case Analysis Schemes"
  - Activation of the automatic generation of boolean equality lemmas
  - Partial debug and error messages improvements for the generation of
    boolean equality and decidable equality
  - Added schemes for making dependent rewrite working (unfortunately with
    not a fully satisfactory design - see file eqschemes.ml)
- Some names of ML function made more regular (see dev/doc/changes.txt)
- Incidentally, added a flush to obsolete Local/Global syntax warning

Show diffs side-by-side

added added

removed removed

Lines of Context:
36
36
open Pretyping
37
37
open Redexpr
38
38
open Syntax_def
 
39
open Lemmas
39
40
 
40
41
(* Pcoq hooks *)
41
42
 
306
307
  print_subgoals ();
307
308
  if !pcoq <> None then (Option.get !pcoq).start_proof ()
308
309
 
309
 
let vernac_definition (local,_,_ as k) (loc,id as lid) def hook =
 
310
let vernac_definition (local,boxed,k) (loc,id as lid) def hook =
310
311
  Dumpglob.dump_definition lid false "def";
311
312
  (match def with
312
313
    | ProveBody (bl,t) ->   (* local binders, typ *)
321
322
        let red_option = match red_option with
322
323
          | None -> None
323
324
          | Some r ->
324
 
              let (evc,env)= Command.get_current_context () in
 
325
              let (evc,env)= get_current_context () in
325
326
                Some (interp_redexp env evc r) in
326
 
          declare_definition id k bl red_option c typ_opt hook)
 
327
        let ce,imps = interp_definition boxed bl red_option c typ_opt in
 
328
        declare_definition id (local,k) ce imps hook)
327
329
 
328
330
let vernac_start_proof kind l lettop hook =
329
331
  if Dumpglob.dump () then
363
365
        (strbrk "Command 'Proof ...' can only be used at the beginning of the proof.")
364
366
 
365
367
let vernac_assumption kind l nl=
 
368
  if Pfedit.refining () then
 
369
    errorlabstrm ""
 
370
      (str "Cannot declare an assumption while in proof editing mode.");
366
371
  let global = fst kind = Global in
367
372
    List.iter (fun (is_coe,(idl,c)) ->
368
373
      if Dumpglob.dump () then
369
374
        List.iter (fun lid ->
370
375
          if global then Dumpglob.dump_definition lid false "ax"
371
376
          else Dumpglob.dump_definition lid true "var") idl;
372
 
      declare_assumption idl is_coe kind [] c false nl) l
 
377
      let t,imps = interp_assumption [] c in
 
378
      declare_assumptions idl is_coe kind t imps false nl) l
373
379
 
374
380
let vernac_record k finite infer struc binders sort nameopt cfs =
375
381
  let const = match nameopt with
414
420
      | _ -> Util.error "Cannot handle mutually (co)inductive records."
415
421
    in
416
422
    let indl = List.map unpack indl in
417
 
      Command.build_mutual indl (recursivity_flag_of_kind finite)
 
423
    do_mutual_inductive indl (recursivity_flag_of_kind finite)
418
424
 
419
425
let vernac_fixpoint l b =
420
426
  if Dumpglob.dump () then
421
427
    List.iter (fun ((lid, _, _, _, _), _) -> Dumpglob.dump_definition lid false "def") l;
422
 
  build_recursive l b
 
428
  do_fixpoint l b
423
429
 
424
430
let vernac_cofixpoint l b =
425
431
  if Dumpglob.dump () then
426
432
    List.iter (fun ((lid, _, _, _), _) -> Dumpglob.dump_definition lid false "def") l;
427
 
  build_corecursive l b
428
 
 
429
 
let vernac_scheme = build_scheme
430
 
 
431
 
let vernac_combined_scheme = build_combined_scheme
 
433
  do_cofixpoint l b
 
434
 
 
435
let vernac_scheme = Indschemes.do_scheme
 
436
 
 
437
let vernac_combined_scheme = Indschemes.do_combined_scheme
432
438
 
433
439
(**********************)
434
440
(* Modules            *)
761
767
 
762
768
let vernac_syntactic_definition lid =
763
769
  Dumpglob.dump_definition lid false "syndef";
764
 
  Command.syntax_definition (snd lid)
 
770
  Metasyntax.add_syntactic_definition (snd lid)
765
771
 
766
772
let vernac_declare_implicits local r = function
767
773
  | Some imps ->