Commit 38377bdd authored by charguer's avatar charguer

interfaces

parent 642ef5d2
......@@ -13,3 +13,8 @@ clean:
rm -rf _build
rm -f *.native
rm -f *~
# Note: to generate mli files, run the following command from ./_build:
# ocamlc -I typing -I utils -I tools -I parsing -I lex -I /usr/local/lib/ocaml/4.01.0/pprint/ -i normalize.ml > ../normalize.mli
......@@ -15,8 +15,6 @@ open Printf
(*#########################################################################*)
(* ** Switch for generating formulae for purely-functional programs *)
let pure_mode = ref false
let use_credits = ref false
......@@ -580,7 +578,7 @@ let rec cfg_exp env e =
let fvs_strict = list_intersect fvs fvs_typ in
let fvs_others = list_minus fvs fvs_strict in
(* pure-mode let-binding *)
(* deprecated: pure-mode let-binding
if !pure_mode then begin
let cf1 = cfg_exp env bod in
......@@ -588,9 +586,10 @@ let rec cfg_exp env e =
let cf2 = cfg_exp env' body in
add_used_label x;
Cf_letpure (x, fvs_strict, fvs_others, typ, cf1, cf2)
end else *)
(* value let-binding *)
end else if Typecore.is_nonexpansive bod then begin
if Typecore.is_nonexpansive bod then begin
let v =
try lift_val env bod
......@@ -775,7 +774,7 @@ let rec cfg_structure_item s : cftops =
let fvs_strict = list_intersect fvs fvs_typ in
let fvs_others = list_minus fvs fvs_strict in
(* pure-mode let-binding *)
(* deprecated: pure-mode let-binding
if !pure_mode then begin
let cf_body = cfg_exp (Ident.empty) bod in
......@@ -788,9 +787,10 @@ let rec cfg_structure_item s : cftops =
Cftop_coqs implicits;
Cftop_pure_cf (x, fvs_strict, fvs_others, cf_body);
Cftop_coqs [register_cf x]; ]
end else*)
(* value let-binding *)
end else if Typecore.is_nonexpansive bod then begin
if Typecore.is_nonexpansive bod then begin
let v =
try lift_val (Ident.empty) bod
......@@ -1347,7 +1347,8 @@ and cfg_module id m =
let cfg_file str =
[ Cftop_coqs ([
Coqtop_set_implicit_args;
Coqtop_require_import (if !pure_mode then "FuncPrim" else "CFHeader") ]
Coqtop_require_import "CFHeader" ]
@ (external_modules_get_coqtop())) ]
@ cfg_structure str
(*deprecated: (if !pure_mode then "FuncPrim" else "CFHeader") *)
\ No newline at end of file
val use_credits : bool ref
(*
val external_modules : string list ref
val external_modules_add : string -> unit
val external_modules_get_coqtop : unit -> Coq.coqtop list
val external_modules_reset : unit -> unit
val lift_ident_name : Ident.t -> string
val lift_full_path : Path.t -> Path.t
val lift_path : Path.t -> Path.t
val lift_full_path_name : Path.t -> string
val lift_path_name : Path.t -> string
val record_type_name : string -> string
val record_constructor : string -> string
val fv_btyp : ?through_arrow:bool -> Print_type.btyp -> string list
val lift_btyp : Print_type.btyp -> Coq.coq
val lift_typ_exp : Types.type_expr -> Coq.coq
val lift_typ_sch : Types.type_expr -> string list * Coq.coq
val coq_typ : Typedtree.expression -> Coq.coq
val coq_typ_pat : Typedtree.pattern -> Coq.coq
val path_decompose : Path.t -> string * string
val get_record_decomposed_name_for_exp :
Typedtree.expression -> string * string
val typ_arity_var : int Ident.tbl -> Path.t -> int
val typ_arity_constr : Types.constructor_description -> int
val coq_of_constructor : Path.t -> Types.constructor_description -> Coq.coq
val pattern_variables : Typedtree.pattern -> Coq.typed_vars
val lift_pat : ?through_aliases:bool -> Typedtree.pattern -> Coq.coq
val pattern_aliases : Typedtree.pattern -> (Coq.typed_var * Coq.coq) list
val register_cf : Coq.var -> Coq.coqtop
val register_spec : Coq.var -> Coq.var -> Coq.coqtop
val prefix_for_label : Types.type_expr -> string
val string_of_label_with : string -> Types.label_description -> string
val name_for_record_new : string -> string
val name_for_record_get : Types.label_description -> string
val name_for_record_set : Types.label_description -> string
val string_of_label : Types.type_expr -> Types.label_description -> string
val simplify_apply_args :
('a * 'b option * Typedtree.optional) list -> 'b list
val exp_find_inlined_primitive :
Typedtree.expression ->
('a * Typedtree.expression option * Typedtree.optional) list ->
string option
val exp_is_inlined_primitive :
Typedtree.expression ->
('a * Typedtree.expression option * Typedtree.optional) list -> bool
val exp_get_inlined_primitive :
Typedtree.expression ->
('a * Typedtree.expression option * Typedtree.optional) list -> string
val lift_exp_path : int Ident.tbl -> Path.t -> Coq.coq
val lift_val : int Ident.tbl -> Typedtree.expression -> Coq.coq
val counter_local_label : int ref
val get_next_local_label : unit -> string
val reset_local_labels : unit -> unit
val used_labels : Coq.var list ref
val reset_used_labels : unit -> unit
val add_used_label : Coq.var -> unit
val cfg_extract_labels : unit -> Formula.cftop list
val pattern_ident : Typedtree.pattern -> Ident.t
val pattern_name : Typedtree.pattern -> string
val extract_label_names_simple : Env.t -> Types.type_expr -> string list
val cfg_exp : int Ident.tbl -> Typedtree.expression -> Formula.cf
val cfg_func :
int Ident.tbl ->
Typedtree.free_vars ->
Typedtree.pattern -> Typedtree.expression -> Formula.cf
val is_algebraic : 'a * Typedtree.type_declaration -> bool
val is_type_abbrev : 'a * Typedtree.type_declaration -> bool
val is_type_record : 'a * Typedtree.type_declaration -> bool
val cfg_structure_item : Typedtree.structure_item -> Formula.cftops
val cfg_type_abbrev :
Ident.t * Typedtree.type_declaration -> Coq.coqtop list * Coq.coqtop list
val cfg_type_record :
Ident.t * Typedtree.type_declaration -> Coq.coqtop list * Coq.coqtop list
val record_functions :
string ->
string ->
Coq.var -> Coq.var list -> string list -> Coq.coq list -> Coq.coqtop list
val cfg_algebraic :
(Ident.t * Typedtree.type_declaration) list ->
Coq.coqtop list * Coq.coqtop list
val cfg_type_decls :
(Ident.t * Typedtree.type_declaration) list -> Coq.coqtops
val cfg_structure : Typedtree.structure -> Formula.cftop list
val cfg_signature_item : Typedtree.signature_item -> Coq.coqtops
val cfg_signature : Typedtree.signature -> Coq.coqtop list
val cfg_modtype : Ident.t -> Typedtree.module_type -> Formula.cftops
val cfg_module : Ident.t -> Typedtree.module_expr -> Formula.cftops
*)
val cfg_file : Typedtree.structure -> Formula.cftop list
This diff is collapsed.
open Coq
(** This module contains a data structure for representing characteristic
formulae. Such data is constructed in file [characteristic.ml] from
the typed abstract syntax tree, and is converted into a Coq expression
(as described in [coq.ml]), using an algorithm contained in this file. *)
(** Characteristic formulae for terms *)
type cf =
| Cf_ret of coq
(* Ret v *)
| Cf_fail
(* Fail *)
| Cf_assert of cf
(* Assert Q *)
| Cf_done
(* Done *)
| Cf_app of coqs * coq * coqs
(* App f Ai xi *)
| Cf_body of var * vars * typed_vars * coq * cf
(* Body f Ai xi => Q *)
| Cf_let of typed_var * cf * cf
(* Let x := Q1 in Q2 *)
| Cf_letpure of var * vars * vars * coq * cf * cf
(* Let x [Ai,Bi] := Q1 in Q2 // where x : forall Ai.T *)
| Cf_letval of var * vars * vars * coq * coq * cf
(* Let x [Ai,Bi] := v in Q2 // where x : forall Ai.T *)
| Cf_letfunc of (var * cf) list * cf
(* Let fi := Qi in Q *)
| Cf_caseif of coq * cf * cf
(* If v Then Q1 else Q2 *)
| Cf_case of coq * typed_vars * coq * coq option * (typed_var*coq) list * cf * cf
(* Case v [xi] p [When c] Then (Alias yk = vk in Q1) else Q2 *)
| Cf_match of var * int * cf
(* Match ?lab n Q *)
| Cf_seq of cf * cf
(* Q1 ;; Q2 *)
| Cf_for of var * coq * coq * cf
(* for i = v1 to v2 do Q done *)
| Cf_while of cf * cf
(* while Q1 do Q2 done *)
| Cf_manual of coq
(* Q *)
| Cf_pay of cf
(* Pay; Q *)
(* not currently used:
| Cf_caseif of cf * cf * cf
(* If Q0 Then Q1 else Q2 *)
*)
(** Characteristic formulae for top-level declarations *)
type cftop =
| Cftop_val of typed_var
(* Lemma x_safe : Inhab t. Proof. typeclass. Qed.
Parameter x : t. *)
| Cftop_heap of var
(* Parameter h : heap. *)
| Cftop_pure_cf of var * vars * vars * cf
(* Parameter x_cf : forall Ai Bi P, F (P Ai) -> P Ai (x Ai) *)
| Cftop_val_cf of var * vars * vars * coq
(* Parameter x_cf: forall Ai, x = V *)
| Cftop_let_cf of var * var * var * cf
(* Parameter x_cf : forall H Q, H h -> F H Q -> Q x h' *)
| Cftop_fun_cf of var * cf
(* Parameter f_cf : Val := H *)
| Cftop_coqs of coqtops
(* arbitrary coq top-level commands *)
and cftops = cftop list
(** Abstract datatype for functions (func) *)
val val_type : Coq.coq
(** Abstract data type for locations (loc) *)
val loc_type : Coq.coq
(** Abstract data type for heaps *)
val heap : Coq.coq
(** Type of proposition on heaps, [hprop], a shorthand for [heap->Prop] *)
val hprop : Coq.coq
(** Constructor for [htype A a], used for representation predicates *)
val htype : Coq.coq -> Coq.coq -> Coq.coq
(** The identity representation predicate *)
val id_repr : Coq.coq
(** constructor for [hdata X x], printed as [x ~> X] in Coq *)
val hdata : Coq.coq -> Coq.coq -> Coq.coq
(** Type of pure post-conditions [_ -> Prop] *)
val wild_to_prop : Coq.coq
(** Type of imperative post-conditions [_ -> hrop] *)
val wild_to_hprop : Coq.coq
(** Precise type of formulae [hprop->(T->hprop)->Prop] *)
val formula_type_of : Coq.coq -> Coq.coq
(** Generic type of formulae [hprop->(_->hprop)->Prop] *)
val formula_type : Coq.coq
(** Hprop entailment [H1 ==> H2] *)
val heap_impl : Coq.coq -> Coq.coq -> Coq.coq
(** Specialized Hprop entailment [H1 ==> Q2 tt] *)
val heap_impl_unit : Coq.coq -> Coq.coq -> Coq.coq
(** Postcondition entailment [Q1 ===> Q2] *)
val post_impl : Coq.coq -> Coq.coq -> Coq.coq
(** Specialized post-conditions [fun (_:unit) => H], i.e. [# H] *)
val post_unit : Coq.coq -> Coq.coq
(** Separating conjunction [H1 * H2] *)
val heap_star : Coq.coq -> Coq.coq -> Coq.coq
(** Base data [heap_is_single c1 c2] *)
val heap_is_single : Coq.coq -> Coq.coq -> Coq.coq
(** Empty heap predicate [[]] *)
val heap_empty : Coq.coq
(** Iterated separating conjunction [H1 * .. * HN] *)
val heap_stars : Coq.coq list -> Coq.coq
(** Lifted existentials [Hexists x, H] *)
val heap_exists : Coq.var -> Coq.coq -> Coq.coq -> Coq.coq
(** Lifted existentials [Hexists x, H], alternative presentation *)
val heap_exists_one : Coq.var * Coq.coq -> Coq.coq -> Coq.coq
(** Iteration of lifted existentials [Hexists x1, .. Hexists xn, H] *)
val heap_existss : (Coq.var * Coq.coq) list -> Coq.coq -> Coq.coq
(** Lifted propositions [ [P] ] *)
val heap_pred : Coq.coq -> Coq.coq
(** Convert a characteristic formula to a coq expression
(internal function) *)
val coqtops_of_imp_cf : cf -> Coq.coq
(** Convert a list of top-level characteristic formulae into a
list of coqtop declarations *)
val coqtops_of_cftops : cftop list -> Coq.coqtops
......@@ -28,7 +28,6 @@ let spec =
Arg.align [
("-I", Arg.String (fun i -> Clflags.include_dirs := i::!Clflags.include_dirs),
" includes a directory where to look for interface files");
("-pure", Arg.Set Characteristic.pure_mode, " generate formulae for purely-functional code");
("-rectypes", Arg.Set Clflags.recursive_types, " activates recursive types");
("-credits", Arg.Set Characteristic.use_credits, " generate 'pay' instructions");
("-nostdlib", Arg.Set no_mystd_include, " do not include standard library");
......@@ -124,10 +123,7 @@ let _ =
(*---------------------------------------------------*)
trace "6) converting caracteristic formula ast to coq ast";
let coq_to_cf = if !Characteristic.pure_mode
then Formula.coq_of_pure_cf
else Formula.coq_of_imp_cf in
let coqtops = Formula.coqtops_of_cftops coq_to_cf cftops in
let coqtops = Formula.coqtops_of_cftops cftops in
(*---------------------------------------------------*)
trace "7) printing coq ast";
......
......@@ -3,6 +3,9 @@ open Parse_type
open Normalize
open Mytools
(** Use this program to compile a MLI file into a CMJ file. *)
(*#########################################################################*)
let ppf = Format.std_formatter
......
(** A-Normalization of the source code. Essentially:
- naming all side-effects
- naming all functions. *)
val normalize_structure : Parsetree.structure -> Parsetree.structure
......@@ -155,7 +155,7 @@ let process_interface_file ppf sourcefile =
*)
(*#########################################################################*)
(* added *)
(* added -- TODO: avoid copy-paste! *)
let typecheck_implementation_file ppf sourcefile parsetree =
init_path ();
......
(** Used for typechecking the initial source code *)
val process_implementation_file :
Format.formatter ->
string ->
(Parsetree.structure * (Typedtree.structure * Typedtree.module_coercion))
option * string
(** Used for typechecking the normalized source code *)
val typecheck_implementation_file :
Format.formatter ->
string ->
Parsetree.structure ->
(Typedtree.structure * Typedtree.module_coercion) option
(** Used for compiling a "mli" interface file and produce a "cmj" file *)
val typecheck_interface_file :
Format.formatter ->
string ->
string ->
unit
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment