Commit 347c33eb authored by Andrei Paskevich's avatar Andrei Paskevich

get rid of de Bruijn indexes (alpha comparison broken so far)

parent bfb7529f
...@@ -215,8 +215,6 @@ and print_app pri ls fmt tl = match extract_op ls, tl with ...@@ -215,8 +215,6 @@ and print_app pri ls fmt tl = match extract_op ls, tl with
print_ls ls (print_list space (print_lterm 6)) tl print_ls ls (print_list space (print_lterm 6)) tl
and print_tnode pri fmt t = match t.t_node with and print_tnode pri fmt t = match t.t_node with
| Tbvar _ ->
assert false
| Tvar v -> | Tvar v ->
print_vs fmt v print_vs fmt v
| Tconst c -> | Tconst c ->
......
This diff is collapsed.
...@@ -28,7 +28,7 @@ open Ty ...@@ -28,7 +28,7 @@ open Ty
type vsymbol = private { type vsymbol = private {
vs_name : ident; vs_name : ident;
vs_ty : ty; vs_ty : ty;
} }
module Mvs : Map.S with type key = vsymbol module Mvs : Map.S with type key = vsymbol
...@@ -127,20 +127,21 @@ type constant = ...@@ -127,20 +127,21 @@ type constant =
| ConstReal of real_constant | ConstReal of real_constant
type term = private { type term = private {
t_node : term_node; t_node : term_node;
t_label : label list; t_label : label list;
t_ty : ty; t_vars : Svs.t;
t_tag : int; t_ty : ty;
t_tag : int;
} }
and fmla = private { and fmla = private {
f_node : fmla_node; f_node : fmla_node;
f_label : label list; f_label : label list;
f_tag : int; f_vars : Svs.t;
f_tag : int;
} }
and term_node = private and term_node = private
| Tbvar of int
| Tvar of vsymbol | Tvar of vsymbol
| Tconst of constant | Tconst of constant
| Tapp of lsymbol * term list | Tapp of lsymbol * term list
...@@ -354,7 +355,7 @@ val f_s_any : (tysymbol -> bool) -> (lsymbol -> bool) -> fmla -> bool ...@@ -354,7 +355,7 @@ val f_s_any : (tysymbol -> bool) -> (lsymbol -> bool) -> fmla -> bool
val t_ty_fold : ('a -> ty -> 'a) -> 'a -> term -> 'a val t_ty_fold : ('a -> ty -> 'a) -> 'a -> term -> 'a
val f_ty_fold : ('a -> ty -> 'a) -> 'a -> fmla -> 'a val f_ty_fold : ('a -> ty -> 'a) -> 'a -> fmla -> 'a
(* fold over applications in terms and formulas *) (* fold over applications in terms and formulas (but not in patterns!) *)
val t_app_fold : val t_app_fold :
('a -> lsymbol -> ty list -> ty option -> 'a) -> 'a -> term -> 'a ('a -> lsymbol -> ty list -> ty option -> 'a) -> 'a -> term -> 'a
......
...@@ -313,8 +313,6 @@ let rec specialize_term ~loc htv t = ...@@ -313,8 +313,6 @@ let rec specialize_term ~loc htv t =
List.fold_left (fun t l -> { t with dt_node = Tnamed (l, t) }) dt t.t_label List.fold_left (fun t l -> { t with dt_node = Tnamed (l, t) }) dt t.t_label
and specialize_term_node ~loc htv = function and specialize_term_node ~loc htv = function
| Term.Tbvar _ ->
assert false
| Term.Tvar v -> | Term.Tvar v ->
Tvar v.vs_name.id_string (* TODO: correct? is capture possible? *) Tvar v.vs_name.id_string (* TODO: correct? is capture possible? *)
| Term.Tconst c -> | Term.Tconst c ->
......
...@@ -72,8 +72,6 @@ and print_tyapp info fmt = function ...@@ -72,8 +72,6 @@ and print_tyapp info fmt = function
| tl -> fprintf fmt "(%a) " (print_list comma (print_type info)) tl | tl -> fprintf fmt "(%a) " (print_list comma (print_type info)) tl
let rec print_term info fmt t = match t.t_node with let rec print_term info fmt t = match t.t_node with
| Tbvar _ ->
assert false
| Tconst c -> | Tconst c ->
Pretty.print_const fmt c Pretty.print_const fmt c
| Tvar { vs_name = id } -> | Tvar { vs_name = id } ->
......
...@@ -202,8 +202,6 @@ and print_lrfmla opl opr info fmt f = match f.f_label with ...@@ -202,8 +202,6 @@ and print_lrfmla opl opr info fmt f = match f.f_label with
(print_list space print_label) ll (print_fnode false false info) f (print_list space print_label) ll (print_fnode false false info) f
and print_tnode opl opr info fmt t = match t.t_node with and print_tnode opl opr info fmt t = match t.t_node with
| Tbvar _ ->
assert false
| Tvar v -> | Tvar v ->
print_vs fmt v print_vs fmt v
| Tconst (ConstInt n) -> fprintf fmt "%s%%Z" n | Tconst (ConstInt n) -> fprintf fmt "%s%%Z" n
......
...@@ -173,8 +173,6 @@ let get_mode info m = ...@@ -173,8 +173,6 @@ let get_mode info m =
let rec print_term info fmt t = let rec print_term info fmt t =
let term = print_term info in let term = print_term info in
match t.t_node with match t.t_node with
| Tbvar _ ->
assert false
| Tconst c -> | Tconst c ->
Pretty.print_const fmt c Pretty.print_const fmt c
| Tvar { vs_name = id } | Tvar { vs_name = id }
......
...@@ -61,8 +61,6 @@ type info = { ...@@ -61,8 +61,6 @@ type info = {
} }
let rec print_term info fmt t = match t.t_node with let rec print_term info fmt t = match t.t_node with
| Tbvar _ ->
assert false
| Tconst (ConstInt n) -> | Tconst (ConstInt n) ->
begin try begin try
let n64 = Int64.of_string n in let n64 = Int64.of_string n in
......
...@@ -79,7 +79,6 @@ let rec print_type info fmt ty = match ty.ty_node with ...@@ -79,7 +79,6 @@ let rec print_type info fmt ty = match ty.ty_node with
let print_type info fmt = catch_unsupportedType (print_type info fmt) let print_type info fmt = catch_unsupportedType (print_type info fmt)
let rec print_term info fmt t = match t.t_node with let rec print_term info fmt t = match t.t_node with
| Tbvar _ -> assert false
| Tconst (ConstInt n) -> fprintf fmt "%s" n | Tconst (ConstInt n) -> fprintf fmt "%s" n
| Tconst (ConstReal c) -> | Tconst (ConstReal c) ->
Print_real.print_with_integers Print_real.print_with_integers
......
...@@ -55,7 +55,6 @@ type info = { ...@@ -55,7 +55,6 @@ type info = {
} }
let rec print_term info fmt t = match t.t_node with let rec print_term info fmt t = match t.t_node with
| Tbvar _ -> assert false
| Tconst c -> fprintf fmt "'%a'" | Tconst c -> fprintf fmt "'%a'"
Pretty.print_const c Pretty.print_const c
| Tvar v -> print_var fmt v | Tvar v -> print_var fmt v
......
...@@ -195,8 +195,6 @@ and print_tapp pri fs fmt tl = ...@@ -195,8 +195,6 @@ and print_tapp pri fs fmt tl =
end end
and print_tnode pri fmt t = match t.t_node with and print_tnode pri fmt t = match t.t_node with
| Tbvar _ ->
assert false
| Tvar v -> | Tvar v ->
print_vs fmt v print_vs fmt v
| Tconst c -> | Tconst c ->
......
...@@ -165,7 +165,7 @@ let rec rewrite_term menv tvar vsvar t = ...@@ -165,7 +165,7 @@ let rec rewrite_term menv tvar vsvar t =
let (vsvar',u) = conv_vs menv tvar vsvar u in let (vsvar',u) = conv_vs menv tvar vsvar u in
let t1 = fnT vsvar t1 in let t2 = fnT vsvar' t2 in let t1 = fnT vsvar t1 in let t2 = fnT vsvar' t2 in
t_let t1 (cb u t2) t_let t1 (cb u t2)
| Tcase _ | Teps _ | Tbvar _ -> | Tcase _ | Teps _ ->
Printer.unsupportedTerm t Printer.unsupportedTerm t
"Encoding instantiate : I can't encode this term" in "Encoding instantiate : I can't encode this term" in
(* Format.eprintf "@[<hov 2>Term : => %a : %a@\n@?" *) (* Format.eprintf "@[<hov 2>Term : => %a : %a@\n@?" *)
......
...@@ -162,7 +162,6 @@ let rec rewrite_term tenv vsvar t = ...@@ -162,7 +162,6 @@ let rec rewrite_term tenv vsvar t =
let fnT = rewrite_term tenv in let fnT = rewrite_term tenv in
let fnF = rewrite_fmla tenv in let fnF = rewrite_fmla tenv in
let t = match t.t_node with let t = match t.t_node with
| Tbvar _ -> assert false
| Tvar vs -> Mvs.find vs vsvar | Tvar vs -> Mvs.find vs vsvar
| Tconst _ -> t | Tconst _ -> t
| Tapp(p,tl) -> | Tapp(p,tl) ->
......
...@@ -153,7 +153,7 @@ let rec rewrite_term tenv tvar vsvar t = ...@@ -153,7 +153,7 @@ let rec rewrite_term tenv tvar vsvar t =
let (vsvar',u) = conv_vs_let tenv vsvar u in let (vsvar',u) = conv_vs_let tenv vsvar u in
let t1 = fnT vsvar t1 in let t2 = fnT vsvar' t2 in let t1 = fnT vsvar t1 in let t2 = fnT vsvar' t2 in
t_let t1 (close u t2) t_let t1 (close u t2)
| Tcase _ | Teps _ | Tbvar _ -> | Tcase _ | Teps _ ->
Printer.unsupportedTerm t Printer.unsupportedTerm t
"Encoding decorate : I can't encode this term" "Encoding decorate : I can't encode this term"
......
...@@ -290,7 +290,7 @@ let rec rewrite_term menv tvar vsvar t = ...@@ -290,7 +290,7 @@ let rec rewrite_term menv tvar vsvar t =
let (vsvar',u) = conv_vs menv tvar vsvar u in let (vsvar',u) = conv_vs menv tvar vsvar u in
let t1 = fnT vsvar t1 in let t2 = fnT vsvar' t2 in let t1 = fnT vsvar t1 in let t2 = fnT vsvar' t2 in
t_let t1 (cb u t2) t_let t1 (cb u t2)
| Tcase _ | Teps _ | Tbvar _ -> | Tcase _ | Teps _ ->
Printer.unsupportedTerm t Printer.unsupportedTerm t
"Encoding instantiate : I can't encode this term" in "Encoding instantiate : I can't encode this term" in
(* Format.eprintf "@[<hov 2>Term : => %a : %a@\n@?" *) (* Format.eprintf "@[<hov 2>Term : => %a : %a@\n@?" *)
......
...@@ -96,7 +96,7 @@ let rec rewrite_term tenv ud vm t = ...@@ -96,7 +96,7 @@ let rec rewrite_term tenv ud vm t =
let t1' = fnT vm t1 in let t1' = fnT vm t1 in
let t2' = fnT (Mvs.add u (t_var u') vm) t2 in let t2' = fnT (Mvs.add u (t_var u') vm) t2 in
t_let t1' (close u' t2') t_let t1' (close u' t2')
| Tcase _ | Teps _ | Tbvar _ -> | Tcase _ | Teps _ ->
Printer.unsupportedTerm t "unsupported term" Printer.unsupportedTerm t "unsupported term"
and rewrite_fmla tenv ud vm f = and rewrite_fmla tenv ud vm f =
......
...@@ -98,8 +98,6 @@ let rec t_monomorph ty_base kept lsmap consts vmap t = ...@@ -98,8 +98,6 @@ let rec t_monomorph ty_base kept lsmap consts vmap t =
let t_mono = t_monomorph ty_base kept lsmap consts in let t_mono = t_monomorph ty_base kept lsmap consts in
let f_mono = f_monomorph ty_base kept lsmap consts in let f_mono = f_monomorph ty_base kept lsmap consts in
t_label_copy t (match t.t_node with t_label_copy t (match t.t_node with
| Tbvar _ ->
assert false
| Tvar v -> | Tvar v ->
Mvs.find v vmap Mvs.find v vmap
| Tconst _ when Sty.mem t.t_ty kept -> | Tconst _ when Sty.mem t.t_ty kept ->
......
...@@ -221,8 +221,6 @@ and print_app pri ls fmt tl = match extract_op ls, tl with ...@@ -221,8 +221,6 @@ and print_app pri ls fmt tl = match extract_op ls, tl with
print_ls ls (print_list space (print_lterm 6)) tl print_ls ls (print_list space (print_lterm 6)) tl
and print_tnode pri fmt t = match t.t_node with and print_tnode pri fmt t = match t.t_node with
| Tbvar _ ->
assert false
| Tvar v -> | Tvar v ->
print_vs fmt v print_vs fmt v
| Tconst c -> | Tconst c ->
......
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