aboutsummaryrefslogtreecommitdiff
path: root/contrib/correctness/past.ml
blob: 612097612a95d92748e92a5d1d8789287740b267 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
(***********************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
(*   \VV/  *************************************************************)
(*    //   *      This file is distributed under the terms of the      *)
(*         *       GNU Lesser General Public License Version 2.1       *)
(***********************************************************************)

(* Certification of Imperative Programs / Jean-Christophe Filli�tre *)

(* $Id$ *)

open Term
open Ptype

(* Programmes imp�ratifs *)

type termination = RecArg of int
                 | Wf     of Coqast.t * Coqast.t

type variable = Names.identifier

type pattern =
    PatVar       of Names.identifier
  | PatConstruct of Names.identifier * ((Names.section_path * int) * int)
  | PatAlias     of pattern * Names.identifier
  | PatPair      of pattern * pattern
  | PatApp       of pattern list
  
type epattern =
    ExnConstant of Names.identifier
  | ExnBind     of Names.identifier * Names.identifier

type ('a,'b) block_st =
    Label     of string
  | Assert    of 'b assertion
  | Statement of 'a

type ('a,'b) block = ('a,'b) block_st list

(* type of programs with assertions of type 'b and info of type 'a *)

type ('a,'b) t =
  { desc : ('a,'b) t_desc ;
    pre  : 'b precondition list ;
    post : 'b postcondition option ;
    loc  : Coqast.loc ;
    info : 'a }

and ('a,'b) t_desc = 
    Var    of variable
  | Acc    of variable
  | Aff    of variable * (('a,'b) t)
  | TabAcc of bool * variable * (('a,'b) t)
  | TabAff of bool * variable * (('a,'b) t) * (('a,'b) t)
  | Seq    of (('a,'b) t,'b) block
  | While  of (('a,'b) t)           (* test *)
            * 'b assertion option   (* invariant *)
	    * ('b * 'b)             (* variant *)
	    * (('a,'b) t, 'b) block (* corps *)
  | If     of (('a,'b) t)  * (('a,'b) t) * (('a,'b) t)
  | Lam    of 'b ml_type_v binder list * ('a,'b) t
  | App    of (('a,'b) t) * (('a,'b) arg) list
  | SApp   of (('a,'b) t_desc) list * (('a,'b) t) list  (* for connectives *)
  | LetRef of variable * (('a,'b) t) * (('a,'b) t)
  | LetIn  of variable * (('a,'b) t) * (('a,'b) t)
  | LetRec of variable                                 (* nom *)
            * 'b ml_type_v binder list * 'b ml_type_v  (* types *)
            * ('b * 'b)                                (* variant *)
	    * ('a,'b) t                                (* corps *)
  | PPoint of string * ('a,'b) t_desc
  | Expression of constr

  | Debug  of string * (('a,'b) t) 

and ('a,'b) arg = 
    Term   of (('a,'b) t) 
  | Refarg of variable
  | Type   of 'b ml_type_v

type program = (unit, Coqast.t) t


(* AST for intermediate constructions.
 *
 * We define an intermediate type between typed program (above)
 * and CIC terms (constr), because we need to perform some eta-reductions
 * (see prog_red.ml for details)
 *
 * But here types are already CIC terms (constr).
 *)

type cc_type = constr

type cc_bind_type =
    CC_typed_binder of cc_type
  | CC_untyped_binder

type cc_binder = variable * cc_bind_type

type cc_term =
    CC_var   of variable
  | CC_letin of bool                   (* dep. or not *)
              * cc_type                (* type of result *)
	      * cc_binder list
	      * (cc_term * case_info)  (* the matched term and its ind. type *)
	      * cc_term
  | CC_lam   of cc_binder list * cc_term
  | CC_app   of cc_term * cc_term list
  | CC_tuple of bool                   (* dep. or not *)
              * cc_type list * cc_term list
  | CC_case  of cc_type                (* type of result *)
              * (cc_term * case_info)  (* the test and its inductive type *)
	      * cc_term list           (* branches *)
  | CC_expr  of constr
  | CC_hole  of cc_type