Commit 61af0420 authored by Andrei Paskevich's avatar Andrei Paskevich

Merge branch 'find_program_symbols' into 'master'

Finding program symbols

See merge request !131
parents 4e212696 f01936d9
...@@ -35,6 +35,8 @@ Transformations ...@@ -35,6 +35,8 @@ Transformations
* `destruct` now destruct `not p` into `p -> false`. `destruct_rec` is * `destruct` now destruct `not p` into `p -> false`. `destruct_rec` is
allowed to further destruct afterwards. allowed to further destruct afterwards.
`destruct` can also destruct `true` and `false`. `destruct` can also destruct `true` and `false`.
* decision procedures used for reflection now must be declared explicitly using
`meta reflection val <function_name>` :x:
IDE IDE
* display of counterexamples in the Task view has been improved * display of counterexamples in the Task view has been improved
......
...@@ -654,6 +654,8 @@ let predicate eq0_int (x:int) = x = 0 ...@@ -654,6 +654,8 @@ let predicate eq0_int (x:int) = x = 0
clone export ringdecision.AssocAlgebraDecision with type r = int, type a = mat, val rzero = Int.zero, val rone = Int.one, val rplus = (+), val ropp = (-_), val rtimes = (*), val azero = mzero, val aone = id, val aplus = add, val aopp = opp, val atimes = mul, val asub = sub, val ($) = extp, goal AUnitary, goal ANonTrivial, goal ExtDistSumA, goal ExtDistSumR, goal AssocMulExt, goal UnitExt, goal CommMulExt, val eq0 = eq0_int, goal A.MulAssoc.Assoc, goal A.Unit_def_l, goal A.Unit_def_r, goal A.Comm, goal A.Assoc, goal A.Mul_distr_l, goal A.Mul_distr_r, goal asub_def, goal A.Inv_def_l, goal A.Inv_def_r, clone export ringdecision.AssocAlgebraDecision with type r = int, type a = mat, val rzero = Int.zero, val rone = Int.one, val rplus = (+), val ropp = (-_), val rtimes = (*), val azero = mzero, val aone = id, val aplus = add, val aopp = opp, val atimes = mul, val asub = sub, val ($) = extp, goal AUnitary, goal ANonTrivial, goal ExtDistSumA, goal ExtDistSumR, goal AssocMulExt, goal UnitExt, goal CommMulExt, val eq0 = eq0_int, goal A.MulAssoc.Assoc, goal A.Unit_def_l, goal A.Unit_def_r, goal A.Comm, goal A.Assoc, goal A.Mul_distr_l, goal A.Mul_distr_r, goal asub_def, goal A.Inv_def_l, goal A.Inv_def_r,
axiom . (* FIXME: replace with "goal" and prove *) axiom . (* FIXME: replace with "goal" and prove *)
meta reflection val norm_f
end end
module MatrixTests module MatrixTests
......
...@@ -328,7 +328,7 @@ ...@@ -328,7 +328,7 @@
<goal name="VC wmpn_add_n.12.0.0" expl="assertion" proved="true"> <goal name="VC wmpn_add_n.12.0.0" expl="assertion" proved="true">
<transf name="reflection_f" proved="true" arg1="mp_decision"> <transf name="reflection_f" proved="true" arg1="mp_decision">
<goal name="VC wmpn_add_n.12.0.0.0" expl="assertion" proved="true"> <goal name="VC wmpn_add_n.12.0.0.0" expl="assertion" proved="true">
<proof prover="0"><result status="valid" time="0.22"/></proof> <proof prover="0"><result status="valid" time="0.36"/></proof>
</goal> </goal>
<goal name="VC wmpn_add_n.12.0.0.1" proved="true"> <goal name="VC wmpn_add_n.12.0.0.1" proved="true">
<proof prover="3"><result status="valid" time="0.17"/></proof> <proof prover="3"><result status="valid" time="0.17"/></proof>
...@@ -428,7 +428,7 @@ ...@@ -428,7 +428,7 @@
<goal name="VC wmpn_add.12.0.0" expl="assertion" proved="true"> <goal name="VC wmpn_add.12.0.0" expl="assertion" proved="true">
<transf name="reflection_f" proved="true" arg1="mp_decision"> <transf name="reflection_f" proved="true" arg1="mp_decision">
<goal name="VC wmpn_add.12.0.0.0" expl="assertion" proved="true"> <goal name="VC wmpn_add.12.0.0.0" expl="assertion" proved="true">
<proof prover="0"><result status="valid" time="0.23"/></proof> <proof prover="0"><result status="valid" time="0.36"/></proof>
</goal> </goal>
<goal name="VC wmpn_add.12.0.0.1" proved="true"> <goal name="VC wmpn_add.12.0.0.1" proved="true">
<proof prover="3"><result status="valid" time="0.16"/></proof> <proof prover="3"><result status="valid" time="0.16"/></proof>
......
This diff is collapsed.
...@@ -988,6 +988,8 @@ use real.FromInt ...@@ -988,6 +988,8 @@ use real.FromInt
clone export LinearEquationsDecision with type C.a = real, function C.(+) = (+.), function C.( * ) = ( *. ), function C.(-_) = (-._), function C.(-) = (-.), type coeff = t, type C.cvars=int -> real, function C.interp=rinterp, exception C.Unknown = QError, constant C.azero = Real.zero, constant C.aone = Real.one, predicate C.ale = (<=.), val C.czero=rzero, val C.cone=rone, lemma C.sub_def, lemma C.zero_def, lemma C.one_def, val C.add=radd, val C.mul=rmul, val C.opp=ropp, val C.eq=req, val C.inv=rinv, goal . clone export LinearEquationsDecision with type C.a = real, function C.(+) = (+.), function C.( * ) = ( *. ), function C.(-_) = (-._), function C.(-) = (-.), type coeff = t, type C.cvars=int -> real, function C.interp=rinterp, exception C.Unknown = QError, constant C.azero = Real.zero, constant C.aone = Real.one, predicate C.ale = (<=.), val C.czero=rzero, val C.cone=rone, lemma C.sub_def, lemma C.zero_def, lemma C.one_def, val C.add=radd, val C.mul=rmul, val C.opp=ropp, val C.eq=req, val C.inv=rinv, goal .
meta reflection val decision
end end
module LinearDecisionInt module LinearDecisionInt
...@@ -1110,6 +1112,8 @@ let int_decision (l: context') (g: equality') : bool ...@@ -1110,6 +1112,8 @@ let int_decision (l: context') (g: equality') : bool
= let l',g' = m_ctx l g in = let l',g' = m_ctx l g in
R.decision l' g' R.decision l' g'
meta reflection val int_decision
end end
...@@ -1555,6 +1559,8 @@ let mp_decision (l: context') (g: equality') : bool ...@@ -1555,6 +1559,8 @@ let mp_decision (l: context') (g: equality') : bool
= =
R.decision (m_ctx l) (m_eq g) R.decision (m_ctx l) (m_eq g)
meta reflection val mp_decision
end end
module EqPropMP module EqPropMP
...@@ -1968,6 +1974,8 @@ let prop_ctx (l:context') (g:equality') : (context', equality') ...@@ -1968,6 +1974,8 @@ let prop_ctx (l:context') (g:equality') : (context', equality')
= let l', g' = prop_ctx l g in = let l', g' = prop_ctx l g in
mp_decision l' g' mp_decision l' g'
meta reflection val prop_mp_decision
end end
module TestMP module TestMP
...@@ -2048,6 +2056,9 @@ function interp (f:fmla) (b: int -> value) : bool = ...@@ -2048,6 +2056,9 @@ function interp (f:fmla) (b: int -> value) : bool =
let f (f:fmla) : bool let f (f:fmla) : bool
ensures { result -> forall b. interp f b } ensures { result -> forall b. interp f b }
= false = false
meta reflection val f
end end
(* (*
module TestFmla module TestFmla
......
This diff is collapsed.
...@@ -496,7 +496,7 @@ ...@@ -496,7 +496,7 @@
<proof prover="5" timelimit="5" memlimit="2000"><result status="valid" time="0.44" steps="59"/></proof> <proof prover="5" timelimit="5" memlimit="2000"><result status="valid" time="0.44" steps="59"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub.36" expl="loop invariant init" proved="true"> <goal name="VC wmpn_sub.36" expl="loop invariant init" proved="true">
<proof prover="2"><result status="valid" time="0.09"/></proof> <proof prover="2"><result status="valid" time="0.20"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub.37" expl="assertion" proved="true"> <goal name="VC wmpn_sub.37" expl="assertion" proved="true">
<proof prover="2"><result status="valid" time="0.05"/></proof> <proof prover="2"><result status="valid" time="0.05"/></proof>
...@@ -505,7 +505,7 @@ ...@@ -505,7 +505,7 @@
<proof prover="5"><result status="valid" time="0.47" steps="82"/></proof> <proof prover="5"><result status="valid" time="0.47" steps="82"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub.39" expl="precondition" proved="true"> <goal name="VC wmpn_sub.39" expl="precondition" proved="true">
<proof prover="2"><result status="valid" time="0.12"/></proof> <proof prover="2"><result status="valid" time="0.24"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub.40" expl="precondition" proved="true"> <goal name="VC wmpn_sub.40" expl="precondition" proved="true">
<proof prover="3"><result status="valid" time="0.04"/></proof> <proof prover="3"><result status="valid" time="0.04"/></proof>
...@@ -520,7 +520,7 @@ ...@@ -520,7 +520,7 @@
<proof prover="5" timelimit="5" memlimit="2000"><result status="valid" time="0.30" steps="78"/></proof> <proof prover="5" timelimit="5" memlimit="2000"><result status="valid" time="0.30" steps="78"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub.44" expl="integer overflow" proved="true"> <goal name="VC wmpn_sub.44" expl="integer overflow" proved="true">
<proof prover="5" timelimit="5" memlimit="2000"><result status="valid" time="0.52" steps="96"/></proof> <proof prover="5" timelimit="5" memlimit="2000"><result status="valid" time="0.34" steps="96"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub.45" expl="loop variant decrease" proved="true"> <goal name="VC wmpn_sub.45" expl="loop variant decrease" proved="true">
<proof prover="3"><result status="valid" time="0.03"/></proof> <proof prover="3"><result status="valid" time="0.03"/></proof>
...@@ -544,7 +544,7 @@ ...@@ -544,7 +544,7 @@
<proof prover="2"><result status="valid" time="0.25"/></proof> <proof prover="2"><result status="valid" time="0.25"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub.52" expl="postcondition" proved="true"> <goal name="VC wmpn_sub.52" expl="postcondition" proved="true">
<proof prover="5" timelimit="5"><result status="valid" time="0.48" steps="67"/></proof> <proof prover="5" timelimit="5"><result status="valid" time="0.27" steps="67"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub.53" expl="assertion" proved="true"> <goal name="VC wmpn_sub.53" expl="assertion" proved="true">
<proof prover="5" timelimit="5" memlimit="2000"><result status="valid" time="0.19" steps="54"/></proof> <proof prover="5" timelimit="5" memlimit="2000"><result status="valid" time="0.19" steps="54"/></proof>
...@@ -782,7 +782,7 @@ ...@@ -782,7 +782,7 @@
<goal name="VC wmpn_sub_in_place.15.0.0" expl="assertion" proved="true"> <goal name="VC wmpn_sub_in_place.15.0.0" expl="assertion" proved="true">
<transf name="reflection_f" proved="true" arg1="mp_decision"> <transf name="reflection_f" proved="true" arg1="mp_decision">
<goal name="VC wmpn_sub_in_place.15.0.0.0" expl="assertion" proved="true"> <goal name="VC wmpn_sub_in_place.15.0.0.0" expl="assertion" proved="true">
<proof prover="0"><result status="valid" time="4.32"/></proof> <proof prover="0"><result status="valid" time="3.70"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub_in_place.15.0.0.1" proved="true"> <goal name="VC wmpn_sub_in_place.15.0.0.1" proved="true">
<proof prover="3"><result status="valid" time="0.30"/></proof> <proof prover="3"><result status="valid" time="0.30"/></proof>
...@@ -861,7 +861,7 @@ ...@@ -861,7 +861,7 @@
<proof prover="5" timelimit="5" memlimit="2000"><result status="valid" time="0.05" steps="52"/></proof> <proof prover="5" timelimit="5" memlimit="2000"><result status="valid" time="0.05" steps="52"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub_in_place.35" expl="assertion" proved="true"> <goal name="VC wmpn_sub_in_place.35" expl="assertion" proved="true">
<proof prover="0"><result status="valid" time="0.61"/></proof> <proof prover="0"><result status="valid" time="0.43"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub_in_place.36" expl="assertion" proved="true"> <goal name="VC wmpn_sub_in_place.36" expl="assertion" proved="true">
<transf name="split_vc" proved="true" > <transf name="split_vc" proved="true" >
...@@ -1083,10 +1083,10 @@ ...@@ -1083,10 +1083,10 @@
<proof prover="3"><result status="valid" time="0.13"/></proof> <proof prover="3"><result status="valid" time="0.13"/></proof>
</goal> </goal>
<goal name="VC wmpn_decr.20" expl="assertion" proved="true"> <goal name="VC wmpn_decr.20" expl="assertion" proved="true">
<proof prover="2"><result status="valid" time="0.23"/></proof> <proof prover="2"><result status="valid" time="0.36"/></proof>
</goal> </goal>
<goal name="VC wmpn_decr.21" expl="assertion" proved="true"> <goal name="VC wmpn_decr.21" expl="assertion" proved="true">
<proof prover="5"><result status="valid" time="0.53" steps="55"/></proof> <proof prover="5"><result status="valid" time="0.86" steps="55"/></proof>
</goal> </goal>
<goal name="VC wmpn_decr.22" expl="precondition" proved="true"> <goal name="VC wmpn_decr.22" expl="precondition" proved="true">
<proof prover="2"><result status="valid" time="0.07"/></proof> <proof prover="2"><result status="valid" time="0.07"/></proof>
...@@ -1163,7 +1163,7 @@ ...@@ -1163,7 +1163,7 @@
<proof prover="0"><result status="valid" time="0.02"/></proof> <proof prover="0"><result status="valid" time="0.02"/></proof>
</goal> </goal>
<goal name="VC wmpn_decr.36" expl="loop invariant preservation" proved="true"> <goal name="VC wmpn_decr.36" expl="loop invariant preservation" proved="true">
<proof prover="0"><result status="valid" time="0.60"/></proof> <proof prover="0"><result status="valid" time="0.44"/></proof>
</goal> </goal>
<goal name="VC wmpn_decr.37" expl="loop invariant preservation" proved="true"> <goal name="VC wmpn_decr.37" expl="loop invariant preservation" proved="true">
<proof prover="2" timelimit="5"><result status="valid" time="0.06"/></proof> <proof prover="2" timelimit="5"><result status="valid" time="0.06"/></proof>
...@@ -1463,7 +1463,7 @@ ...@@ -1463,7 +1463,7 @@
<proof prover="2"><result status="valid" time="0.15"/></proof> <proof prover="2"><result status="valid" time="0.15"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub_1_in_place.15" expl="assertion" proved="true"> <goal name="VC wmpn_sub_1_in_place.15" expl="assertion" proved="true">
<proof prover="2"><result status="valid" time="0.76"/></proof> <proof prover="2"><result status="valid" time="0.99"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub_1_in_place.16" expl="precondition" proved="true"> <goal name="VC wmpn_sub_1_in_place.16" expl="precondition" proved="true">
<proof prover="2"><result status="valid" time="0.05"/></proof> <proof prover="2"><result status="valid" time="0.05"/></proof>
...@@ -1475,10 +1475,10 @@ ...@@ -1475,10 +1475,10 @@
<proof prover="2"><result status="valid" time="0.16"/></proof> <proof prover="2"><result status="valid" time="0.16"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub_1_in_place.19" expl="assertion" proved="true"> <goal name="VC wmpn_sub_1_in_place.19" expl="assertion" proved="true">
<proof prover="2"><result status="valid" time="0.41"/></proof> <proof prover="2"><result status="valid" time="0.26"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub_1_in_place.20" expl="assertion" proved="true"> <goal name="VC wmpn_sub_1_in_place.20" expl="assertion" proved="true">
<proof prover="5"><result status="valid" time="1.10" steps="52"/></proof> <proof prover="5"><result status="valid" time="0.73" steps="52"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub_1_in_place.21" expl="precondition" proved="true"> <goal name="VC wmpn_sub_1_in_place.21" expl="precondition" proved="true">
<proof prover="2"><result status="valid" time="0.05"/></proof> <proof prover="2"><result status="valid" time="0.05"/></proof>
...@@ -1505,7 +1505,7 @@ ...@@ -1505,7 +1505,7 @@
<proof prover="2"><result status="valid" time="0.06"/></proof> <proof prover="2"><result status="valid" time="0.06"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub_1_in_place.29" expl="assertion" proved="true"> <goal name="VC wmpn_sub_1_in_place.29" expl="assertion" proved="true">
<proof prover="5" timelimit="5" memlimit="2000"><result status="valid" time="1.22" steps="66"/></proof> <proof prover="5" timelimit="5" memlimit="2000"><result status="valid" time="1.49" steps="66"/></proof>
</goal> </goal>
<goal name="VC wmpn_sub_1_in_place.30" expl="loop variant decrease" proved="true"> <goal name="VC wmpn_sub_1_in_place.30" expl="loop variant decrease" proved="true">
<proof prover="2"><result status="valid" time="0.10"/></proof> <proof prover="2"><result status="valid" time="0.10"/></proof>
......
...@@ -33,7 +33,7 @@ module type Printer = sig ...@@ -33,7 +33,7 @@ module type Printer = sig
val tprinter : ident_printer (* type symbols *) val tprinter : ident_printer (* type symbols *)
val aprinter : ident_printer (* type variables *) val aprinter : ident_printer (* type variables *)
val sprinter : ident_printer (* variables and functions *) val sprinter : ident_printer (* variables and functions *)
val pprinter : ident_printer (* propoition names *) val pprinter : ident_printer (* proposition names *)
val forget_all : unit -> unit (* flush id_unique *) val forget_all : unit -> unit (* flush id_unique *)
val forget_tvs : unit -> unit (* flush id_unique for type vars *) val forget_tvs : unit -> unit (* flush id_unique for type vars *)
...@@ -556,6 +556,7 @@ let print_meta_arg_type fmt = function ...@@ -556,6 +556,7 @@ let print_meta_arg_type fmt = function
| MTprsymbol -> fprintf fmt "[proposition]" | MTprsymbol -> fprintf fmt "[proposition]"
| MTstring -> fprintf fmt "[string]" | MTstring -> fprintf fmt "[string]"
| MTint -> fprintf fmt "[integer]" | MTint -> fprintf fmt "[integer]"
| MTid -> fprintf fmt "[identifier]"
let print_meta_arg fmt = function let print_meta_arg fmt = function
| MAty ty -> fprintf fmt "type %a" print_ty ty; forget_tvs () | MAty ty -> fprintf fmt "type %a" print_ty ty; forget_tvs ()
...@@ -564,6 +565,7 @@ let print_meta_arg fmt = function ...@@ -564,6 +565,7 @@ let print_meta_arg fmt = function
| MApr pr -> fprintf fmt "prop %a" print_pr pr | MApr pr -> fprintf fmt "prop %a" print_pr pr
| MAstr s -> fprintf fmt "\"%s\"" s | MAstr s -> fprintf fmt "\"%s\"" s
| MAint i -> fprintf fmt "%d" i | MAint i -> fprintf fmt "%d" i
| MAid i -> fprintf fmt "%a" Ident.print_decoded (id_unique sprinter i)
let print_qt fmt th = let print_qt fmt th =
if th.th_path = [] then print_th fmt th else if th.th_path = [] then print_th fmt th else
......
...@@ -83,6 +83,7 @@ type meta_arg_type = ...@@ -83,6 +83,7 @@ type meta_arg_type =
| MTprsymbol | MTprsymbol
| MTstring | MTstring
| MTint | MTint
| MTid
type meta_arg = type meta_arg =
| MAty of ty | MAty of ty
...@@ -91,6 +92,7 @@ type meta_arg = ...@@ -91,6 +92,7 @@ type meta_arg =
| MApr of prsymbol | MApr of prsymbol
| MAstr of string | MAstr of string
| MAint of int | MAint of int
| MAid of ident
type meta = { type meta = {
meta_name : string; meta_name : string;
...@@ -235,6 +237,7 @@ module Hstdecl = Hashcons.Make (struct ...@@ -235,6 +237,7 @@ module Hstdecl = Hashcons.Make (struct
| MApr pr -> pr_hash pr | MApr pr -> pr_hash pr
| MAstr s -> Hashtbl.hash s | MAstr s -> Hashtbl.hash s
| MAint i -> Hashtbl.hash i | MAint i -> Hashtbl.hash i
| MAid i -> Ident.id_hash i
let hs_smap sm h = let hs_smap sm h =
Mts.fold hs_cl_ty sm.sm_ty Mts.fold hs_cl_ty sm.sm_ty
...@@ -409,8 +412,9 @@ let add_tdecl uc td = match td.td_node with ...@@ -409,8 +412,9 @@ let add_tdecl uc td = match td.td_node with
(** Declarations *) (** Declarations *)
let store_path, store_theory, restore_path = let store_path, store_theory, restore_path, restore_theory =
let id_to_path = Wid.create 17 in let id_to_path = Wid.create 17 in
let id_to_th = Wid.create 17 in
let store_path uc path id = let store_path uc path id =
(* this symbol already belongs to some theory *) (* this symbol already belongs to some theory *)
if Wid.mem id_to_path id then () else if Wid.mem id_to_path id then () else
...@@ -420,10 +424,15 @@ let store_path, store_theory, restore_path = ...@@ -420,10 +424,15 @@ let store_path, store_theory, restore_path =
let store_theory th = let store_theory th =
let id = th.th_name in let id = th.th_name in
(* this symbol is already a theory *) (* this symbol is already a theory *)
if Wid.mem id_to_path id then () else if Wid.mem id_to_path id then () else begin
Wid.set id_to_path id (th.th_path, id.id_string, []) in Wid.set id_to_path id (th.th_path, id.id_string, []);
Sid.iter (fun id -> Wid.set id_to_th id th) th.th_local;
Wid.set id_to_th id th;
end
in
let restore_path id = Wid.find id_to_path id in let restore_path id = Wid.find id_to_path id in
store_path, store_theory, restore_path let restore_theory id = Wid.find id_to_th id in
store_path, store_theory, restore_path, restore_theory
let close_theory uc = let close_theory uc =
let th = close_theory uc in let th = close_theory uc in
...@@ -862,6 +871,7 @@ let get_meta_arg_type = function ...@@ -862,6 +871,7 @@ let get_meta_arg_type = function
| MApr _ -> MTprsymbol | MApr _ -> MTprsymbol
| MAstr _ -> MTstring | MAstr _ -> MTstring
| MAint _ -> MTint | MAint _ -> MTint
| MAid _ -> MTid
let create_meta m al = let create_meta m al =
let get_meta_arg at a = let get_meta_arg at a =
...@@ -960,6 +970,7 @@ let print_meta_arg_type fmt = function ...@@ -960,6 +970,7 @@ let print_meta_arg_type fmt = function
| MTprsymbol -> fprintf fmt "proposition" | MTprsymbol -> fprintf fmt "proposition"
| MTstring -> fprintf fmt "string" | MTstring -> fprintf fmt "string"
| MTint -> fprintf fmt "int" | MTint -> fprintf fmt "int"
| MTid -> fprintf fmt "identifier"
let () = Exn_printer.register let () = Exn_printer.register
begin fun fmt exn -> match exn with begin fun fmt exn -> match exn with
......
...@@ -43,6 +43,7 @@ type meta_arg_type = ...@@ -43,6 +43,7 @@ type meta_arg_type =
| MTprsymbol | MTprsymbol
| MTstring | MTstring
| MTint | MTint
| MTid
type meta_arg = type meta_arg =
| MAty of ty | MAty of ty
...@@ -51,6 +52,7 @@ type meta_arg = ...@@ -51,6 +52,7 @@ type meta_arg =
| MApr of prsymbol | MApr of prsymbol
| MAstr of string | MAstr of string
| MAint of int | MAint of int
| MAid of ident
type meta = private { type meta = private {
meta_name : string; meta_name : string;
...@@ -160,6 +162,8 @@ val restore_path : ident -> string list * string * string list ...@@ -160,6 +162,8 @@ val restore_path : ident -> string list * string * string list
If [id] is a theory name, the third component is an empty list. If [id] is a theory name, the third component is an empty list.
Raises [Not_found] if the ident was never declared in/as a theory. *) Raises [Not_found] if the ident was never declared in/as a theory. *)
val restore_theory : ident -> theory
(** {2 Declaration constructors} *) (** {2 Declaration constructors} *)
val create_decl : decl -> tdecl val create_decl : decl -> tdecl
......
...@@ -414,6 +414,7 @@ type naming_table = { ...@@ -414,6 +414,7 @@ type naming_table = {
coercion : Coercion.t; coercion : Coercion.t;
printer : Ident.ident_printer; printer : Ident.ident_printer;
aprinter : Ident.ident_printer; aprinter : Ident.ident_printer;
meta_id_args : Ident.ident Mstr.t;
} }
exception Bad_name_table of string exception Bad_name_table of string
......
...@@ -220,6 +220,7 @@ type naming_table = { ...@@ -220,6 +220,7 @@ type naming_table = {
coercion : Coercion.t; coercion : Coercion.t;
printer : Ident.ident_printer; printer : Ident.ident_printer;
aprinter : Ident.ident_printer; aprinter : Ident.ident_printer;
meta_id_args : Ident.ident Mstr.t;
} }
(** In order to interpret, that is type, string arguments as symbols or (** In order to interpret, that is type, string arguments as symbols or
terms, a transformation may need a [naming_table]. Typing arguments terms, a transformation may need a [naming_table]. Typing arguments
......
...@@ -287,19 +287,27 @@ let add_meta uc m al = { uc with ...@@ -287,19 +287,27 @@ let add_meta uc m al = { uc with
muc_theory = Theory.add_meta uc.muc_theory m al; muc_theory = Theory.add_meta uc.muc_theory m al;
muc_units = Umeta (m,al) :: uc.muc_units; } muc_units = Umeta (m,al) :: uc.muc_units; }
let store_path, store_module, restore_path = let store_path, store_module, restore_path, restore_module_id =
let id_to_path = Wid.create 17 in let id_to_path = Wid.create 17 in
let id_to_pmod = Wid.create 17 in
let store_path {muc_theory = uc} path id = let store_path {muc_theory = uc} path id =
(* this symbol already belongs to some theory *) (* this symbol already belongs to some theory *)
if Wid.mem id_to_path id then () else if Wid.mem id_to_path id then () else
let prefix = List.rev (id.id_string :: path @ uc.uc_prefix) in let prefix = List.rev (id.id_string :: path @ uc.uc_prefix) in
Wid.set id_to_path id (uc.uc_path, uc.uc_name.id_string, prefix) in Wid.set id_to_path id (uc.uc_path, uc.uc_name.id_string, prefix) in
let store_module {mod_theory = {th_name = id} as th} = let store_module pmod =
let th = pmod.mod_theory in
let id = th.th_name in
(* this symbol is already a module *) (* this symbol is already a module *)
if Wid.mem id_to_path id then () else if Wid.mem id_to_path id then () else begin
Wid.set id_to_path id (th.th_path, id.id_string, []) in Wid.set id_to_path id (th.th_path, id.id_string, []);
Sid.iter (fun id -> Wid.set id_to_pmod id pmod) pmod.mod_local;
Wid.set id_to_pmod id pmod;
end
in
let restore_path id = Wid.find id_to_path id in let restore_path id = Wid.find id_to_path id in
store_path, store_module, restore_path let restore_module_id id = Wid.find id_to_pmod id in
store_path, store_module, restore_path, restore_module_id
let close_module uc = let close_module uc =
let m = close_module uc in let m = close_module uc in
......
...@@ -37,10 +37,12 @@ val ns_find_prog_symbol : namespace -> string list -> prog_symbol ...@@ -37,10 +37,12 @@ val ns_find_prog_symbol : namespace -> string list -> prog_symbol
val ns_find_its : namespace -> string list -> itysymbol val ns_find_its : namespace -> string list -> itysymbol
val ns_find_pv : namespace -> string list -> pvsymbol 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_xs : namespace -> string list -> xsymbol
val ns_find_ns : namespace -> string list -> namespace val ns_find_ns : namespace -> string list -> namespace
(* use this only on an export namespace, which cannot have overloaded symbols *)
val ns_find_rs : namespace -> string list -> rsymbol
type overload = type overload =
| FixedRes of ity (* t -> t -> ... -> T *) | FixedRes of ity (* t -> t -> ... -> T *)
| SameType (* t -> t -> ... -> t *) | SameType (* t -> t -> ... -> t *)
...@@ -113,6 +115,10 @@ val restore_path : ident -> string list * string * string list ...@@ -113,6 +115,10 @@ val restore_path : ident -> string list * string * string list
If [id] is a module name, the third component is an empty list. 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. *) Raises Not_found if the ident was never declared in/as a module. *)
val restore_module_id : ident -> pmodule
(** retrieves a module from a program symbol defined in it
Raises Not_found if the ident was never declared in/as a module. *)
val restore_module : theory -> pmodule val restore_module : theory -> pmodule
(** retrieves a module from its underlying theory (** retrieves a module from its underlying theory
raises [Not_found] if no such module exists *) raises [Not_found] if no such module exists *)
......
...@@ -388,6 +388,7 @@ meta_arg: ...@@ -388,6 +388,7 @@ meta_arg:
| AXIOM qualid { Max $2 } | AXIOM qualid { Max $2 }
| LEMMA qualid { Mlm $2 } | LEMMA qualid { Mlm $2 }
| GOAL qualid { Mgl $2 } | GOAL qualid { Mgl $2 }
| VAL qualid { Mval $2 }
| STRING { Mstr $1 } | STRING { Mstr $1 }
| INTEGER { Mint (Number.to_small_integer $1) } | INTEGER { Mint (Number.to_small_integer $1) }
......
...@@ -223,6 +223,7 @@ type metarg = ...@@ -223,6 +223,7 @@ type metarg =
| Max of qualid | Max of qualid
| Mlm of qualid | Mlm of qualid
| Mgl of qualid | Mgl of qualid
| Mval of qualid
| Mstr of string | Mstr of string
| Mint of int | Mint of int
......
...@@ -53,7 +53,7 @@ let string_list_of_qualid q = ...@@ -53,7 +53,7 @@ let string_list_of_qualid q =
| Qident id -> id.id_str :: acc in | Qident id -> id.id_str :: acc in
sloq [] q