Commit 122f0b4c authored by Andrei Paskevich's avatar Andrei Paskevich

whyml: introduce specialized ns_find_(its|ts|pv|ps|pl|xs) functions

parent 285d1ff3
...@@ -310,29 +310,15 @@ let ref_modules, ref_theories = ...@@ -310,29 +310,15 @@ let ref_modules, ref_theories =
let ref_module : Mlw_module.modul = Stdlib.Mstr.find "Ref" ref_modules let ref_module : Mlw_module.modul = Stdlib.Mstr.find "Ref" ref_modules
let ref_type : Mlw_ty.T.itysymbol = let ref_type : Mlw_ty.T.itysymbol =
match Mlw_module.ns_find_its ref_module.Mlw_module.mod_export ["ref"]
Mlw_module.ns_find_ts ref_module.Mlw_module.mod_export ["ref"]
with
| Mlw_module.PT itys -> itys
| Mlw_module.TS _ -> assert false
(* the "ref" function *) (* the "ref" function *)
let ref_fun : Mlw_expr.psymbol = let ref_fun : Mlw_expr.psymbol =
match Mlw_module.ns_find_ps ref_module.Mlw_module.mod_export ["ref"]
Mlw_module.ns_find_ps ref_module.Mlw_module.mod_export ["ref"]
with
| Mlw_module.PS p -> p
| _ -> assert false
(* the "!" function *) (* the "!" function *)
let get_fun : Mlw_expr.psymbol = let get_fun : Mlw_expr.psymbol =
match Mlw_module.ns_find_ps ref_module.Mlw_module.mod_export ["prefix !"]
Mlw_module.ns_find_ps ref_module.Mlw_module.mod_export ["prefix !"]
with
| Mlw_module.PS p -> p
| _ -> assert false
let d2 = let d2 =
let args = let args =
......
...@@ -92,35 +92,19 @@ let ref_modules, ref_theories = ...@@ -92,35 +92,19 @@ let ref_modules, ref_theories =
let ref_module : Mlw_module.modul = Stdlib.Mstr.find "Ref" ref_modules let ref_module : Mlw_module.modul = Stdlib.Mstr.find "Ref" ref_modules
let ref_type : Mlw_ty.T.itysymbol = let ref_type : Mlw_ty.T.itysymbol =
match Mlw_module.ns_find_its ref_module.Mlw_module.mod_export ["ref"]
Mlw_module.ns_find_ts ref_module.Mlw_module.mod_export ["ref"]
with
| Mlw_module.PT itys -> itys
| Mlw_module.TS _ -> assert false
let ref_fun : Mlw_expr.psymbol = let ref_fun : Mlw_expr.psymbol =
match Mlw_module.ns_find_ps ref_module.Mlw_module.mod_export ["ref"]
Mlw_module.ns_find_ps ref_module.Mlw_module.mod_export ["ref"]
with
| Mlw_module.PS p -> p
| _ -> assert false
let get_logic_fun : Term.lsymbol = let get_logic_fun : Term.lsymbol =
find ref_module.Mlw_module.mod_theory "prefix !" find ref_module.Mlw_module.mod_theory "prefix !"
let get_fun : Mlw_expr.psymbol = let get_fun : Mlw_expr.psymbol =
match Mlw_module.ns_find_ps ref_module.Mlw_module.mod_export ["prefix !"]
Mlw_module.ns_find_ps ref_module.Mlw_module.mod_export ["prefix !"]
with
| Mlw_module.PS p -> p
| _ -> assert false
let set_fun : Mlw_expr.psymbol = let set_fun : Mlw_expr.psymbol =
match Mlw_module.ns_find_ps ref_module.Mlw_module.mod_export ["infix :="]
Mlw_module.ns_find_ps ref_module.Mlw_module.mod_export ["infix :="]
with
| Mlw_module.PS p -> p
| _ -> assert false
(*********) (*********)
......
...@@ -141,16 +141,14 @@ let load_driver lib file extra_files = ...@@ -141,16 +141,14 @@ let load_driver lib file extra_files =
try add_local th rule with e -> raise (Loc.Located (loc,e)) try add_local th rule with e -> raise (Loc.Located (loc,e))
in in
let find_val m (loc,q) = let find_val m (loc,q) =
try match ns_find_ps m.mod_export q with try match ns_find_prog_symbol m.mod_export q with
| PV pv -> pv.pv_vs.vs_name | PV pv -> pv.pv_vs.vs_name
| PS ps -> ps.ps_name | PS ps -> ps.ps_name
| PL _ | XS _ | LS _ -> raise Not_found | PL _ | XS _ | LS _ -> raise Not_found
with Not_found -> raise (Loc.Located (loc, UnknownVal (!qualid,q))) with Not_found -> raise (Loc.Located (loc, UnknownVal (!qualid,q)))
in in
let find_xs m (loc,q) = let find_xs m (loc,q) =
try match ns_find_ps m.mod_export q with try ns_find_xs m.mod_export q
| XS xs -> xs
| PV _ | PS _ | PL _ | LS _ -> raise Not_found
with Not_found -> raise (Loc.Located (loc, UnknownExn (!qualid,q))) with Not_found -> raise (Loc.Located (loc, UnknownExn (!qualid,q)))
in in
let add_local_module loc m = function let add_local_module loc m = function
......
...@@ -105,9 +105,30 @@ let rec ns_find get_map ns = function ...@@ -105,9 +105,30 @@ let rec ns_find get_map ns = function
| [a] -> Mstr.find a (get_map ns) | [a] -> Mstr.find a (get_map ns)
| a::l -> ns_find get_map (Mstr.find a ns.ns_ns) l | a::l -> ns_find get_map (Mstr.find a ns.ns_ns) l
let ns_find_ts = ns_find (fun ns -> ns.ns_ts) let ns_find_type_symbol = ns_find (fun ns -> ns.ns_ts)
let ns_find_ps = ns_find (fun ns -> ns.ns_ps) let ns_find_prog_symbol = ns_find (fun ns -> ns.ns_ps)
let ns_find_ns = ns_find (fun ns -> ns.ns_ns) let ns_find_ns = ns_find (fun ns -> ns.ns_ns)
let ns_find_its ns s = match ns_find_type_symbol ns s with
| PT its -> its | _ -> raise Not_found
let ns_find_ts ns s = match ns_find_type_symbol ns s with
| TS ts -> ts | _ -> raise Not_found
let ns_find_pv ns s = match ns_find_prog_symbol ns s with
| PV pv -> pv | _ -> raise Not_found
let ns_find_ps ns s = match ns_find_prog_symbol ns s with
| PS ps -> ps | _ -> raise Not_found
let ns_find_pl ns s = match ns_find_prog_symbol ns s with
| PL pl -> pl | _ -> raise Not_found
let ns_find_xs ns s = match ns_find_prog_symbol ns s with
| XS xs -> xs | _ -> raise Not_found
let ns_find_ls ns s = match ns_find_prog_symbol ns s with
| LS ls -> ls | _ -> raise Not_found
(** Module *) (** Module *)
......
...@@ -37,9 +37,18 @@ type namespace = { ...@@ -37,9 +37,18 @@ type namespace = {
ns_ns : namespace Mstr.t; (* inner namespaces *) ns_ns : namespace Mstr.t; (* inner namespaces *)
} }
val ns_find_ts : namespace -> string list -> type_symbol val ns_find_type_symbol : namespace -> string list -> type_symbol
val ns_find_ps : namespace -> string list -> prog_symbol val ns_find_prog_symbol : namespace -> string list -> prog_symbol
val ns_find_ns : namespace -> string list -> namespace
val ns_find_its : namespace -> string list -> itysymbol
val ns_find_ts : namespace -> string list -> tysymbol
val ns_find_pv : namespace -> string list -> pvsymbol
val ns_find_ps : namespace -> string list -> psymbol
val ns_find_pl : namespace -> string list -> plsymbol
val ns_find_xs : namespace -> string list -> xsymbol
val ns_find_ls : namespace -> string list -> lsymbol
val ns_find_ns : namespace -> string list -> namespace
(** Module *) (** Module *)
......
...@@ -150,7 +150,7 @@ let get_id_ts = function ...@@ -150,7 +150,7 @@ let get_id_ts = function
| TS ts -> ts.ts_name | TS ts -> ts.ts_name
let uc_find_ts uc p = let uc_find_ts uc p =
Typing.find_ns get_id_ts ns_find_ts p (get_namespace uc) Typing.find_ns get_id_ts ns_find_type_symbol p (get_namespace uc)
let get_id_ps = function let get_id_ps = function
| PV pv -> pv.pv_vs.vs_name | PV pv -> pv.pv_vs.vs_name
...@@ -160,7 +160,7 @@ let get_id_ps = function ...@@ -160,7 +160,7 @@ let get_id_ps = function
| LS ls -> ls.ls_name | LS ls -> ls.ls_name
let uc_find_ps uc p = let uc_find_ps uc p =
Typing.find_ns get_id_ps ns_find_ps p (get_namespace uc) Typing.find_ns get_id_ps ns_find_prog_symbol p (get_namespace uc)
(** Typing type expressions *) (** Typing type expressions *)
......
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