Skip to content
Snippets Groups Projects
Commit 16830071 authored by Kilyan Le Gallic's avatar Kilyan Le Gallic Committed by Loïc Correnson
Browse files

[wp] Reworked global env as a record

parent 6e9291ec
No related branches found
No related tags found
No related merge requests found
...@@ -28,6 +28,8 @@ module F = Filepath.Normalized ...@@ -28,6 +28,8 @@ module F = Filepath.Normalized
module W = Why3 module W = Why3
module WConf = Why3.Whyconf module WConf = Why3.Whyconf
let dkey = L.register_category "why3.import" let dkey = L.register_category "why3.import"
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
...@@ -108,21 +110,18 @@ type tenv = C.logic_type_info W.Ty.Hts.t ...@@ -108,21 +110,18 @@ type tenv = C.logic_type_info W.Ty.Hts.t
type lenv = C.logic_info W.Term.Hls.t type lenv = C.logic_info W.Term.Hls.t
type tvars = C.logic_type W.Ty.Mtv.t type tvars = C.logic_type W.Ty.Mtv.t
type genv = W.Env.env * tenv * lenv type lils = W.Term.lsymbol Logic_info.Hashtbl.t
type ltits = W.Ty.tysymbol Logic_type_info.Hashtbl.t
module LogicMap = Map.Make(struct type menv = C.global Datatype.String.Hashtbl.t
type t = C.logic_info
let compare = compare (* Use the default comparison function for type A *)
end)
module TypeMap = Map.Make(struct
type t = C.logic_type
let compare = compare (* Use the default comparison function for type A *)
end)
type _reverse_logic_info = W.Term.lsymbol LogicMap.t type genv = {
type _reverse_logic_type = W.Ty.tysymbol TypeMap.t wenv : W.Env.env;
tenv : tenv;
lenv : lenv;
lils : lils;
ltits : ltits;
menv : menv
}
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
(* --- Built-in --- *) (* --- Built-in --- *)
...@@ -131,21 +130,21 @@ type _reverse_logic_type = W.Ty.tysymbol TypeMap.t ...@@ -131,21 +130,21 @@ type _reverse_logic_type = W.Ty.tysymbol TypeMap.t
let add_builtin (tenv : tenv) ts lt_name lt_params = let add_builtin (tenv : tenv) ts lt_name lt_params =
W.Ty.Hts.add tenv ts C.{lt_name ; lt_params; lt_def=None; lt_attr=[] } W.Ty.Hts.add tenv ts C.{lt_name ; lt_params; lt_def=None; lt_attr=[] }
let find_ts ((wenv,_,_) : genv) pkg thy name = let find_ts genv pkg thy name =
let th = Why3.Env.read_theory wenv pkg thy in let th = Why3.Env.read_theory genv.wenv pkg thy in
try try
Why3.Theory.ns_find_ts th.th_export name Why3.Theory.ns_find_ts th.th_export name
with Not_found -> with Not_found ->
L.fatal "Cannot find %s.%s.%s" L.fatal "Cannot find %s.%s.%s"
(String.concat "." pkg ) thy (String.concat "." name) (String.concat "." pkg ) thy (String.concat "." name)
let add_builtins ((wenv,tenv,lenv) : genv) = let add_builtins genv =
begin begin
let ts_list = find_ts (wenv,tenv,lenv) ["list"] "List" ["list"] in let ts_list = find_ts genv ["list"] "List" ["list"] in
let ts_set = find_ts (wenv,tenv,lenv) ["set"] "Set" ["set"] in let ts_set = find_ts genv ["set"] "Set" ["set"] in
add_builtin tenv W.Ty.ts_bool Utf8_logic.boolean []; add_builtin genv.tenv W.Ty.ts_bool Utf8_logic.boolean [];
add_builtin tenv ts_list "\\list" ["A"]; add_builtin genv.tenv ts_list "\\list" ["A"];
add_builtin tenv ts_set "set" ["A"]; add_builtin genv.tenv ts_set "set" ["A"];
end end
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
...@@ -287,7 +286,10 @@ let () = ...@@ -287,7 +286,10 @@ let () =
let wenv = create_why3_env @@ libs in let wenv = create_why3_env @@ libs in
let tenv : tenv = W.Ty.Hts.create 0 in let tenv : tenv = W.Ty.Hts.create 0 in
let lenv : lenv = W.Term.Hls.create 0 in let lenv : lenv = W.Term.Hls.create 0 in
let genv : genv = (wenv , tenv , lenv) in let lils : lils = Logic_info.Hashtbl.create 0 in
let ltits : ltits = Logic_type_info.Hashtbl.create 0 in
let menv : menv = Datatype.String.Hashtbl.create 0 in
let genv : genv = { wenv ; tenv; lenv; lils; ltits; menv } in
add_builtins genv; add_builtins genv;
List.iter (import_theory wenv tenv lenv) @@ imports; List.iter (import_theory wenv tenv lenv) @@ imports;
W.Ty.Hts.iter (fun (tys) (lti) -> W.Ty.Hts.iter (fun (tys) (lti) ->
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment