Commit 3d86e1c5 authored by Rehan MALAK's avatar Rehan MALAK

extends Ptree/Typing API to the entire mlw file

parent b88f3d74
......@@ -1925,9 +1925,9 @@ OCAMLCODE_CALLPROVERS = proveranswer proverresult resourcelimit
OCAMLCODE_TRANSFORM = negate register
OCAMLCODE_MLWTREE = buildenv openmodule useimport \
source1 code1 helper1 source2 code2 source3 code3 \
closemodule checkingvcs
OCAMLCODE_MLWTREE = buildenv \
source1 code1 helper1 source2 code2 source3 code3 source4 code4 \
getmodules checkingvcs
OCAMLCODE_MLWEXPR = buildenv source2 code2_import code2 createmodule checkingvcs
......
......@@ -328,51 +328,50 @@ The examples of this section are available in the file
The first step is to build an environment as already illustrated in
Section~\ref{sec:api:callingprovers}, and open the OCaml module
\verb|Ptree| which contains most of the OCaml functions we need in
\verb|Ptree| (``parse tree'') which contains most of the OCaml functions we need in
this section.
\lstinputlisting{generated/mlw_tree__buildenv.ml}
To contain all the example programs we are going to build we need a
module. We start the creation of that module using the following
declarations, that first introduces a pseudo ``file'' to hold the
module, then the module itself called \verb|Program|.
\lstinputlisting{generated/mlw_tree__openmodule.ml}
Notice the use of a first
simple helper function \verb|mk_ident| to build an identifier without
any attributes nor any location.
To write our programs, we need to import some other modules from the
standard library. The following introduces two helper functions for
building qualified identifiers and importing modules, and finally
imports \verb|int.Int|.
\lstinputlisting{generated/mlw_tree__useimport.ml}
We want now to build a program equivalent to the following code in concrete Why3 syntax.
Each of our example programs will build a module.
Let's consider the Why3 code.
\lstinputlisting[language=why3]{generated/mlw_tree__source1.ml}
The OCaml code that programmatically build this Why3 function is as follows.
The Ocaml code that programmatically builds it is as follows.
\lstinputlisting{generated/mlw_tree__code1.ml}
This code makes uses of helper functions that are given in Figure~\ref{fig:helpers}.
Most of the code is not using directly the \verb|Ptree| constructors
but instead makes uses of the helper
functions that are given in Figure~\ref{fig:helpers}.
Notice \verb|mk_ident| which builds an identifier (\verb|Ptree.ident|) without
any attributes nor any location and \verb|use_import| which lets us to import
some other modules and in particular the ones from the standard library. At the end,
our module is no more than the identifier and a list of two declarations (\verb|Ptree.decl list|)
\begin{figure}[t]
\lstinputlisting{generated/mlw_tree__helper1.ml}
\caption{Helper functions for building WhyML programs}
\label{fig:helpers}
\end{figure}
We want now to build a program equivalent to the following code in concrete Why3 syntax.
\lstinputlisting[language=why3]{generated/mlw_tree__source2.ml}
We need to import the \verb|ref.Ref| module first. The rest is similar to the first example, the code is as follows
The OCaml code that programmatically build this Why3 function is as follows.
\lstinputlisting{generated/mlw_tree__code2.ml}
The next example makes use of arrays.
We want now to build a program equivalent to the following code in concrete Why3 syntax.
\lstinputlisting[language=why3]{generated/mlw_tree__source3.ml}
The corresponding OCaml code is as follows
We need to import the \verb|ref.Ref| module first. The rest is similar to the first example, the code is as follows
\lstinputlisting{generated/mlw_tree__code3.ml}
Having declared all the programs we wanted to write, we can now close
the module and the file, and get as a result the set of modules of our
The next example makes use of arrays.
\lstinputlisting[language=why3]{generated/mlw_tree__source4.ml}
The corresponding OCaml code is as follows
\lstinputlisting{generated/mlw_tree__code4.ml}
Having declared all the modules we wanted to write, we can now call the \why typing procedure
and get as a result the set of modules of our
file, under the form of a map of module names to modules.
\lstinputlisting{generated/mlw_tree__closemodule.ml}
\lstinputlisting{generated/mlw_tree__getmodules.ml}
We can then construct the proofs tasks for our module, and then try to
call the Alt-Ergo prover. The rest of that code is using OCaml
......
This diff is collapsed.
......@@ -309,7 +309,7 @@ and block env ~loc = function
let e = Efun (params, None, Ity.MaskVisible, sp, body) in
Elet (id, false, Expr.RKnone, mk_expr ~loc e, s) in
mk_expr ~loc e
| (Dimport _ | Py_ast.Dlogic _) :: sl ->
| (Py_ast.Dimport _ | Py_ast.Dlogic _) :: sl ->
block env ~loc sl
let fresh_type_var =
......@@ -350,7 +350,8 @@ let read_channel env path file c =
let use_import (f, m) =
let m = mk_id ~loc m in
Typing.open_scope loc m;
Typing.add_decl loc (Ptree.Duse (Qdot (Qident (mk_id ~loc f), m)));
let decl = Ptree.Duseimport(loc,false,[((Qdot (Qident (mk_id ~loc f), m)),None)]) in
Typing.add_decl loc decl ;
Typing.close_scope loc ~import:true in
List.iter use_import
["int", "Int"; "ref", "Refint"; "python", "Python"];
......
......@@ -12,10 +12,6 @@
%{
open Ptree
let qualid_last = function Qident x | Qdot (_, x) -> x
let use_as q = function Some x -> x | None -> qualid_last q
let floc s e = Loc.extract (s,e)
let add_attr id l = (* id.id_ats is usually nil *)
......@@ -322,7 +318,7 @@ module_decl:
| scope_head module_decl* END
{ Typing.close_scope (floc $startpos($1) $endpos($1)) ~import:$1 }
| IMPORT uqualid
{ Typing.import_scope (floc $startpos $endpos) $2 }
{ Typing.add_decl (floc $startpos $endpos) (Dimport($2)) }
| d = pure_decl | d = prog_decl | d = meta_decl
{ Typing.add_decl (floc $startpos $endpos) d;
add_record_projections d
......@@ -347,27 +343,33 @@ module_decl_no_head:
use_clone:
| USE EXPORT tqualid
{ Typing.add_decl (floc $startpos $endpos) (Duse $3) }
{ let loc = floc $startpos $endpos in
let decl = Ptree.Duseexport $3 in
Typing.add_decl loc decl
}
| CLONE EXPORT tqualid clone_subst
{ Typing.add_decl (floc $startpos $endpos) (Dclone ($3, $4)) }
{ let loc = floc $startpos $endpos in
let decl = Ptree.Dcloneexport($3,$4) in
Typing.add_decl loc decl
}
| USE boption(IMPORT) m_as_list = comma_list1(use_as)
{ let loc = floc $startpos $endpos in
let exists_as = List.exists (fun (_, q) -> q <> None) m_as_list in
if $2 && not exists_as then Warning.emit ~loc
let import = $2 in
if import && not exists_as then Warning.emit ~loc
"the keyword `import' is redundant here and can be omitted";
let add_import (m, q) = let import = $2 || q = None in
Typing.open_scope loc (use_as m q);
Typing.add_decl loc (Duse m);
Typing.close_scope loc ~import in
List.iter add_import m_as_list }
let decl = Ptree.Duseimport(loc,import,m_as_list) in
Typing.add_decl loc decl
}
| CLONE boption(IMPORT) tqualid option(preceded(AS, uident)) clone_subst
{ let loc = floc $startpos $endpos in
if $2 && $4 = None then Warning.emit ~loc
let import = $2 in
let as_opt = $4 in
if import && as_opt = None then Warning.emit ~loc
"the keyword `import' is redundant here and can be omitted";
let import = $2 || $4 = None in
Typing.open_scope loc (use_as $3 $4);
Typing.add_decl loc (Dclone ($3, $5));
Typing.close_scope loc ~import }
let decl = Ptree.Dcloneimport(loc,import,$3,as_opt,$5) in
Typing.add_decl loc decl
}
use_as:
| n = tqualid q = option(preceded(AS, uident)) { (n, q) }
......
......@@ -263,7 +263,19 @@ type decl =
(** declaration of global exceptions *)
| Dmeta of ident * metarg list
(** `meta` *)
| Dclone of qualid * clone_subst list
| Dcloneexport of qualid * clone_subst list
(** `clone` *)
| Duse of qualid
| Duseexport of qualid
(** `use` *)
| Dcloneimport of Loc.position * bool * qualid * ident option * clone_subst list
(** `clone import ... as ...` *)
| Duseimport of Loc.position * bool * (qualid * ident option) list
(** `use import ... as ...` *)
| Dimport of qualid
(** `import` *)
| Dscope of Loc.position * bool * ident * decl list
(** `scope` *)
type mlw_file =
| Modules of (ident * decl list) list
| Decls of decl list
......@@ -35,6 +35,11 @@ let debug_ignore_useless_at = Debug.register_flag "ignore_useless_at"
(** symbol lookup *)
let qualid_last = function Qident x | Qdot (_, x) -> x
let use_as q = function Some x -> x | None -> qualid_last q
let rec qloc = function
| Qdot (p, id) -> Loc.join (qloc p) id.id_loc
| Qident id -> id.id_loc
......@@ -1463,7 +1468,7 @@ let type_inst ({muc_theory = tuc} as muc) ({mod_theory = t} as m) s =
in
List.fold_left add_inst (empty_mod_inst m) s
let add_decl muc env file d =
let rec add_decl muc env file d =
let vc = muc.muc_theory.uc_path = [] &&
Debug.test_noflag debug_type_only in
match d with
......@@ -1501,12 +1506,57 @@ let add_decl muc env file d =
let ity = ity_of_pty muc pty in
let xs = create_xsymbol (create_user_id id) ~mask ity in
add_pdecl ~vc muc (create_exn_decl xs)
| Ptree.Duse use ->
| Ptree.Duseexport use ->
use_export muc (find_module env file use)
| Ptree.Dclone (use, inst) ->
| Ptree.Dcloneexport (use, inst) ->
let m = find_module env file use in
warn_clone_not_abstract (qloc use) m.mod_theory;
clone_export muc m (type_inst muc m inst)
| Ptree.Duseimport (_loc,import,uses) ->
let add_import muc (m, q) =
let import = import || q = None in
let muc = open_scope muc (use_as m q).id_str in
let m = find_module env file m in
let muc = use_export muc m in
close_scope muc ~import in
List.fold_left add_import muc uses
| Ptree.Dcloneimport (_loc,import,qid,as_opt,inst) ->
let import = import || as_opt = None in
let muc = open_scope muc (use_as qid as_opt).id_str in
let m = find_module env file qid in
warn_clone_not_abstract (qloc qid) m.mod_theory;
let muc = clone_export muc m (type_inst muc m inst) in
let muc = close_scope muc ~import in
muc
| Ptree.Dimport q ->
import_scope muc (string_list_of_qualid q)
| Ptree.Dscope (_loc,import,qid,decls) ->
let muc = open_scope muc qid.id_str in
let add_decl_env_file muc d = add_decl muc env file d in
let muc = List.fold_left add_decl_env_file muc decls in
let muc = close_scope muc ~import in
muc
let type_module file env loc path (id,dl) =
let muc = create_module env ~path (create_user_id id) in
let add_decl_env_file muc d = add_decl muc env file d in
let muc = List.fold_left add_decl_env_file muc dl in
let m = Loc.try1 ~loc close_module muc in
let file = Mstr.add m.mod_theory.th_name.id_string m file in
file
let type_mlw_file env path filename mlw_file =
let file = Mstr.empty in
let loc = Loc.user_position filename 0 0 0 in
let file =
match mlw_file with
| Ptree.Decls decls -> type_module file env loc path ({id_str=""; id_ats=[]; id_loc=loc},decls)
| Ptree.Modules m_or_t ->
let type_module_env_loc_path file (id,dl) = type_module file env loc path (id,dl) in
List.fold_left type_module_env_loc_path file m_or_t
in
file
(* incremental parsing *)
......@@ -1574,14 +1624,6 @@ let close_scope loc ~import =
let muc = Loc.try1 ~loc (close_scope ~import) (Opt.get slice.muc) in
slice.muc <- Some muc
let import_scope loc q =
assert (not (Stack.is_empty state));
let slice = Stack.top state in
let muc = top_muc_on_demand loc slice in
if Debug.test_noflag debug_parse_only then
let muc = Loc.try2 ~loc import_scope muc (string_list_of_qualid q) in
slice.muc <- Some muc
let add_decl loc d =
assert (not (Stack.is_empty state));
let slice = Stack.top state in
......
......@@ -17,6 +17,8 @@ val debug_parse_only : Debug.flag
val debug_type_only : Debug.flag
val type_mlw_file : Env.env -> string list -> string -> Ptree.mlw_file -> Pmodule.pmodule Wstdlib.Mstr.t
(** {2 Incremental typing of parsed modules} *)
val open_file : Env.env -> Env.pathname -> unit
......@@ -33,8 +35,6 @@ val open_scope : Loc.position -> Ptree.ident -> unit
val close_scope : Loc.position -> import:bool -> unit
val import_scope : Loc.position -> Ptree.qualid -> unit
val add_decl : Loc.position -> Ptree.decl -> unit
(** {2 Typing terms and formulas in isolation} *)
......
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