Commit e7a6c4dc authored by Andrei Paskevich's avatar Andrei Paskevich

Mlw: stubs for declarations and modules

parent 5332910a
......@@ -152,7 +152,7 @@ LIB_DRIVER = call_provers driver_ast driver_parser driver_lexer driver \
whyconf autodetection \
parse_smtv2_model_parser parse_smtv2_model_lexer parse_smtv2_model
LIB_MLW = ity expr dexpr mdecl
LIB_MLW = ity expr dexpr mdecl wmodule
LIB_PARSER = ptree glob parser typing lexer
......
......@@ -596,6 +596,12 @@ let is_e_void e = match e.e_node with
let rs_func_app = rs_of_ls fs_func_app
let ld_func_app =
let v_args = rs_func_app.rs_cty.cty_args in
let ity = rs_func_app.rs_cty.cty_result in
let c = create_cty v_args [] [] Mexn.empty Mpv.empty eff_empty ity in
LDsym (rs_func_app, c_any c)
let e_func_app fn e =
let c = rs_func_app.rs_cty in
let mtch isb a e = ity_match isb a.pv_ity e.e_ity in
......
......@@ -259,6 +259,7 @@ val is_e_void : expr -> bool
val is_rs_tuple : rsymbol -> bool
val rs_func_app : rsymbol
val ld_func_app : let_defn
val e_func_app : expr -> expr -> expr
val e_func_app_l : expr -> expr list -> expr
......
......@@ -293,8 +293,55 @@ let mk_decl = let r = ref 0 in fun node pure ->
{ md_node = node; md_pure = pure;
md_syms = get_syms node pure;
md_news = get_news node pure;
md_tag = (incr r; !r) }
md_tag = (incr r; !r) }
let create_type_decl dl =
let ldl = assert false (* TODO *) in
mk_decl (MDtype dl) ldl
let create_let_decl ld = let _ = MDlet ld in assert false (* TODO *)
let create_exn_decl xs = let _ = MDexn xs in assert false (* TODO *)
let create_pure_decl _d = let _ = MDpure in assert false (* TODO *)
(** {2 Built-in decls} *)
let md_int = mk_decl (MDtype [mk_itd its_int [] [] []]) [(*TODO*)]
let md_real = mk_decl (MDtype [mk_itd its_real [] [] []]) [(*TODO*)]
let md_unit = mk_decl (MDtype [mk_itd its_unit [] [] []]) [(*TODO*)]
let md_func = mk_decl (MDtype [mk_itd its_func [] [] []]) [(*TODO*)]
let md_pred = mk_decl (MDtype [mk_itd its_pred [] [] []]) [(*TODO*)]
let md_equ = mk_decl MDpure [(*TODO*)]
let md_bool =
mk_decl (MDtype [mk_itd its_bool [] [rs_true;rs_false] []]) [(*TODO*)]
let md_tuple _n = assert false (*TODO*)
let md_func_app = mk_decl (MDlet ld_func_app) [(*TODO*)]
(** {2 Known identifiers} *)
type known_map = mdecl Mid.t
let known_id kn id =
if not (Mid.mem id kn) then raise (Decl.UnknownIdent id)
let merge_known kn1 kn2 =
let check_known id decl1 decl2 =
if md_equal decl1 decl2 then Some decl1
else raise (Decl.RedeclaredIdent id) in
Mid.union check_known kn1 kn2
let known_add_decl kn0 d =
let kn = Mid.map (Util.const d) d.md_news in
let check id decl0 _ =
if md_equal decl0 d
then raise (Decl.KnownIdent id)
else raise (Decl.RedeclaredIdent id) in
let kn = Mid.union check kn0 kn in
let unk = Mid.set_diff d.md_syms kn in
if Sid.is_empty unk then kn else
raise (Decl.UnknownIdent (Sid.choose unk))
......@@ -56,3 +56,29 @@ and mdecl_node = private
| MDpure
val create_type_decl : its_defn list -> mdecl
val create_let_decl : let_defn -> mdecl
val create_exn_decl : xsymbol -> mdecl
val create_pure_decl : Decl.decl -> mdecl
(** {2 Built-in decls} *)
val md_int : mdecl
val md_real : mdecl
val md_equ : mdecl
val md_bool : mdecl
val md_unit : mdecl
val md_tuple : int -> mdecl
val md_func : mdecl
val md_pred : mdecl
val md_func_app : mdecl
(** {2 Known identifiers} *)
type known_map = mdecl Mid.t
val known_id : known_map -> ident -> unit
val known_add_decl : known_map -> mdecl -> known_map
val merge_known : known_map -> known_map -> known_map
This diff is collapsed.
(********************************************************************)
(* *)
(* The Why3 Verification Platform / The Why3 Development Team *)
(* Copyright 2010-2015 -- INRIA - CNRS - Paris-Sud University *)
(* *)
(* This software is distributed under the terms of the GNU Lesser *)
(* General Public License version 2.1, with the special exception *)
(* on linking described in file LICENSE. *)
(* *)
(********************************************************************)
open Stdlib
open Ident
open Theory
open Ity
open Expr
open Mdecl
(** *)
type prog_symbol =
| PV of pvsymbol
| RS of rsymbol
| XS of xsymbol
type namespace = {
ns_ts : itysymbol Mstr.t; (* type symbols *)
ns_ps : prog_symbol Mstr.t; (* program symbols *)
ns_ns : namespace Mstr.t; (* inner namespaces *)
}
val ns_find_its : namespace -> string list -> itysymbol
val ns_find_prog_symbol : namespace -> string list -> prog_symbol
val ns_find_pv : namespace -> string list -> pvsymbol
val ns_find_rs : namespace -> string list -> rsymbol
val ns_find_xs : namespace -> string list -> xsymbol
val ns_find_ns : namespace -> string list -> namespace
(** {2 Module} *)
type wmodule = private {
mod_theory : theory; (* pure theory *)
mod_decls : mdecl list; (* module declarations *)
mod_export : namespace; (* exported namespace *)
mod_known : known_map; (* known identifiers *)
mod_local : Sid.t; (* locally declared idents *)
mod_used : Sid.t; (* used modules *)
}
(** {2 Module under construction} *)
type wmodule_uc = private {
muc_theory : theory_uc;
muc_name : string;
muc_path : string list;
muc_decls : mdecl list;
muc_prefix : string list;
muc_import : namespace list;
muc_export : namespace list;
muc_known : known_map;
muc_local : Sid.t;
muc_used : Sid.t;
muc_env : Env.env option;
}
val create_module : Env.env -> ?path:string list -> preid -> wmodule_uc
val close_module : wmodule_uc -> wmodule
val open_namespace : wmodule_uc -> string -> wmodule_uc
val close_namespace : wmodule_uc -> import:bool -> wmodule_uc
val restore_path : ident -> string list * string * string list
(** [restore_path id] returns the triple (library path, module,
qualified symbol name) if the ident was ever introduced in
a module declaration. If the ident was declared in several
different modules, the first association is retained.
If [id] is a module name, the third component is an empty list.
Raises Not_found if the ident was never declared in/as a module. *)
val restore_module : theory -> wmodule
(** retrieves a module from its underlying theory
raises [Not_found] if no such module exists *)
(** {2 Use and clone} *)
val use_export : wmodule_uc -> wmodule -> wmodule_uc
(** {2 Logic decls} *)
val add_meta : wmodule_uc -> meta -> meta_arg list -> wmodule_uc
(** {2 Program decls} *)
val add_mdecl : wp:bool -> wmodule_uc -> mdecl -> wmodule_uc
(** [add_mdecl ~wp m d] adds declaration [d] in module [m].
If [wp] is [true], VC is computed and added to [m]. *)
(** {2 Builtin symbols} *)
val builtin_module : wmodule
val bool_module : wmodule
(* TODO
val unit_module : wmodule
*)
val highord_module : wmodule
val tuple_module : int -> wmodule
val tuple_module_name : string -> int option
val add_mdecl_with_tuples : wmodule_uc -> mdecl -> wmodule_uc
(** {2 WhyML language} *)
open Env
type mlw_file = wmodule Mstr.t * theory Mstr.t
val mlw_language : mlw_file language
exception ModuleNotFound of pathname * string
val read_module : env -> pathname -> string -> wmodule
......@@ -460,7 +460,7 @@ let print_path fmt sl =
let () = Exn_printer.register (fun fmt e -> match e with
| ModuleNotFound (sl,s) -> Format.fprintf fmt
"Theory %s not found in library %a" s print_path sl
"Module %s not found in library %a" s print_path sl
| ModuleOrTheoryNotFound (sl,s) -> Format.fprintf fmt
"Module/theory %s not found in library %a" s print_path sl
| TooLateInvariant -> Format.fprintf fmt
......
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