Commit 8ffbc88c authored by MARCHE Claude's avatar MARCHE Claude

shape of goals stored in database

parent 68b48a25
This diff is collapsed.
......@@ -32,43 +32,52 @@ example:
*)
let const_shape ~push acc c =
let b = Buffer.create 17 in
Format.bprintf b "%a" Pretty.print_const c;
push (Buffer.contents b) acc
let var_shape _v : string = assert false
let vs_rename_alpha c h vs = incr c; Mvs.add vs !c h
let vl_rename_alpha c h vl = List.fold_left (vs_rename_alpha c) h vl
let pat_shape _c _m _acc _p = assert false
let rec pat_rename_alpha c h p = match p.pat_node with
| Pvar v -> vs_rename_alpha c h v
| Pas (p, v) -> pat_rename_alpha c (vs_rename_alpha c h v) p
| Por (p, _) -> pat_rename_alpha c h p
| _ -> Term.pat_fold (pat_rename_alpha c) h p
let tag_and = "A"
let tag_if = "B"
let tag_const = "C"
let tag_eps = "E"
let tag_false = "F"
let tag_app = "a"
let tag_case = "C"
let tag_const = "c"
let tag_exists = "E"
let tag_eps = "e"
let tag_forall = "F"
let tag_false = "f"
let tag_impl = "I"
let tag_if = "i"
let tag_let = "L"
let tag_not = "N"
let tag_or = "O"
let tag_iff = "Q"
let tag_case = "S"
let tag_true = "T"
let tag_iff = "q"
let tag_true = "t"
let tag_var = "V"
let tag_forall = "W"
let tag_exists = "X"
let tag_app = "Y"
(*
let tag_wild = "w"
let tag_as = "z"
[t_shape t] provides a traversal of the term structure, generally
in the order root-left-right, except for nodes Tquant and Tbin
which are traversed in the order right-root-left, so that in "A ->
B" we see B first, and if "Forall x,A" we see A first
let const_shape ~push acc c =
let b = Buffer.create 17 in
Format.bprintf b "%a" Pretty.print_const c;
push (Buffer.contents b) acc
*)
let rec pat_shape ~(push:string->'a->'a) c m (acc:'a) p : 'a =
match p.pat_node with
| Pwild -> push tag_wild acc
| Pvar _ -> push tag_var acc
| Papp (f, l) ->
List.fold_left (pat_shape ~push c m)
(push (f.ls_name.Ident.id_string) (push tag_app acc))
l
| Pas (p, _) -> push tag_as (pat_shape ~push c m acc p)
| Por (p, q) ->
pat_shape ~push c m (push tag_or (pat_shape ~push c m acc q)) p
let rec t_shape ~(push:string->'a->'a) c m (acc:'a) t : 'a =
let fn = t_shape ~push c m in
......@@ -76,9 +85,8 @@ let rec t_shape ~(push:string->'a->'a) c m (acc:'a) t : 'a =
| Tconst c -> const_shape ~push (push tag_const acc) c
| Tvar v ->
let x =
try
string_of_int (Mvs.find v m)
with Not_found -> var_shape v
try string_of_int (Mvs.find v m)
with Not_found -> v.vs_name.Ident.id_string
in
push x (push tag_var acc)
| Tapp (s,l) ->
......@@ -93,7 +101,8 @@ let rec t_shape ~(push:string->'a->'a) c m (acc:'a) t : 'a =
| Tcase (t1,bl) ->
let br_shape acc b =
let p,t2 = t_open_branch b in
let m = pat_shape c m acc p in
let acc = pat_shape ~push c m acc p in
let m = pat_rename_alpha c m p in
t_shape ~push c m acc t2
in
List.fold_left br_shape (fn (push tag_case acc) t1) bl
......@@ -108,18 +117,18 @@ let rec t_shape ~(push:string->'a->'a) c m (acc:'a) t : 'a =
push hq (t_shape ~push c m acc f1)
(* argument first, intentionally, to give more weight on A in
forall x,A *)
| Tbinop (o,f,g) ->
let tag = match o with
| Tand -> tag_and
| Tor -> tag_or
| Timplies -> tag_impl
| Tiff -> tag_iff
in
fn (push tag (fn acc g)) f
(* g first, intentionally, to give more weight on B in A->B *)
| Tnot f -> push tag_not (fn acc f)
| Ttrue -> push tag_true acc
| Tfalse -> push tag_false acc
| Tbinop (o,f,g) ->
let tag = match o with
| Tand -> tag_and
| Tor -> tag_or
| Timplies -> tag_impl
| Tiff -> tag_iff
in
fn (push tag (fn acc g)) f
(* g first, intentionally, to give more weight on B in A->B *)
| Tnot f -> push tag_not (fn acc f)
| Ttrue -> push tag_true acc
| Tfalse -> push tag_false acc
let t_shape_buf t =
let b = Buffer.create 17 in
......
......@@ -26,6 +26,17 @@ val t_dist : term -> term -> float
the result is 0.0 then the terms are equal modulo alpha *)
*)
(*
[t_shape t] provides a traversal of the term structure, generally
in the order root-left-right, except for nodes Tquant and Tbin
which are traversed in the order right-root-left, so that in "A ->
B" we see B first, and if "Forall x,A" we see A first
*)
val t_shape_buf : Term.term -> string
(** returns a shape of the given term *)
......
......@@ -17,7 +17,7 @@ theory TestInt
use import int.Int
goal Test1: 2+2 = 4
goal Test2: forall x:int. x*x >= 0
goal Test3: 1<>0
......@@ -44,7 +44,7 @@ theory TestSplit
predicate bb int
goal G1 : (aa 5) /\ ("stop_split" aa 0 /\ bb 6) /\ ("stop_split" aa 1 /\ bb 2)
goal G1 : (aa 5) /\ ("stop_split" aa 0 /\ bb 6) /\ ("stop_split" aa 1 /\ bb 2)
goal G2 : ("stop_split" aa 0 && bb 1) && ("stop_split" aa 1 && bb 2)
......@@ -87,16 +87,14 @@ theory TestList
function x : list int
(*
goal Test1:
match x with
goal Test1:
match x with
| Nil -> 1 = 0 /\ 2 = 3
| Cons _ Nil -> 4 = 5 /\ 6 = 7
| Cons _ _ -> 8 = 9 /\ 10 = 11
end
*)
end
end
end
theory TestReal
......@@ -153,13 +151,13 @@ theory TestRealizeUse
function q t : t
axiom C : forall x:t. p (q x) x
axiom C : forall x:t. p (q x) x
end
theory TestInline
theory TestInline
use import int.Int
use import int.Int
goal T : 1 = 2
......@@ -167,4 +165,4 @@ theory TestInline
goal G : p 4 4
end
end
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