Skip to content

GitLab

Commit 937c08a1 authored by Andrei Paskevich's avatar Andrei Paskevich
Browse files

a bit of renaming (Declaration -> Decl, Expression -> Expr, etc)

parent e12dddfd
Hide whitespace changes
Inline Side-by-side
src/driver/register.ml
View file @ 937c08a1
......@@ -164,41 +164,39 @@ let list_printers () = Hashtbl.fold (fun k _ acc -> k::acc) printers []
let list_transforms () = Hashtbl.fold (fun k _ acc -> k::acc) transforms []
let list_transforms_l () = Hashtbl.fold (fun k _ acc -> k::acc) transforms_l []
(** exception to use in a printer and transformation *)
open Ty
open Term
open Decl
open Ty
type error =
| UnsupportedType of ty * string
| UnsupportedExpression of expr * string
| UnsupportedDeclaration of decl * string
| NotImplemented of string
| UnsupportedType of ty * string
| UnsupportedExpr of expr * string
| UnsupportedDecl of decl * string
| NotImplemented of string
exception Error of error
let error e = raise (Error e)
let unsupportedType e s = error (UnsupportedType (e,s))
let unsupportedExpression e s = error (UnsupportedExpression (e,s))
let unsupportedDeclaration e s = error (UnsupportedDeclaration (e,s))
let notImplemented s = error (NotImplemented s)
let unsupportedTerm e s = error (UnsupportedExpr (Term e,s))
let unsupportedFmla e s = error (UnsupportedExpr (Fmla e,s))
let unsupportedExpr e s = error (UnsupportedExpr (e,s))
let unsupportedDecl e s = error (UnsupportedDecl (e,s))
let notImplemented s = error (NotImplemented s)
let report fmt = function
| UnsupportedType (e,s) ->
let msg = "This type isn't supported" in
Format.fprintf fmt
"@[<hov 3> %s:@\n%a@\n%s@]@\n" msg Pretty.print_ty e s
| UnsupportedExpression (e,s) ->
| UnsupportedExpr (e,s) ->
let msg = "This expression isn't supported" in
Format.fprintf fmt
"@[<hov 3> %s:@\n%a@\n%s@]@\n" msg Pretty.print_expr e s
| UnsupportedDeclaration (d,s) ->
| UnsupportedDecl (d,s) ->
let msg = "This declaration isn't supproted" in
Format.fprintf fmt
"@[<hov 3> %s:@\n%a@\n%s@]@\n" msg Pretty.print_decl d s
......@@ -210,14 +208,18 @@ exception Unsupported of string
let unsupported s = raise (Unsupported s)
let catch_unsupportedtype f ty =
try f ty with Unsupported s -> unsupportedType ty s
let catch_unsupportedType f e =
try f e with Unsupported s -> unsupportedType e s
let catch_unsupportedTerm f e =
try f e with Unsupported s -> unsupportedTerm e s
let catch_unsupportedFmla f e =
try f e with Unsupported s -> unsupportedFmla e s
let catch_unsupportedterm f t =
try f t with Unsupported s -> unsupportedExpression (Term t) s
let catch_unsupportedExpr f e =
try f e with Unsupported s -> unsupportedExpr e s
let catch_unsupportedfmla f t =
try f t with Unsupported s -> unsupportedExpression (Fmla t) s
let catch_unsupportedDecl f e =
try f e with Unsupported s -> unsupportedDecl e s
let catch_unsupportedDeclaration f d =
try f d with Unsupported s -> unsupportedDeclaration d s
src/driver/register.mli
View file @ 937c08a1
......@@ -82,25 +82,25 @@ val list_transforms_l : unit -> string list
(** {2 exceptions to use in transformations and printers } *)
type error =
| UnsupportedType of Ty.ty * string
| UnsupportedExpression of Term.expr * string
| UnsupportedDeclaration of Decl.decl * string
| NotImplemented of string
| UnsupportedType of Ty.ty * string
| UnsupportedExpr of Term.expr * string
| UnsupportedDecl of Decl.decl * string
| NotImplemented of string
exception Error of error
val unsupportedType : Ty.ty -> string -> 'a
(** [unsupportedType ty s]
- [ty] is the problematic formula
val unsupportedType : Ty.ty -> string -> 'a
(** [unsupportedType ty s]
- [ty] is the problematic type
- [s] explain the problem and
possibly a way to solve it (such as applying another
transforamtion) *)
val unsupportedExpression : Term.expr -> string -> 'a
val unsupportedDeclaration : Decl.decl -> string -> 'a
val notImplemented : string -> 'a
val unsupportedTerm : Term.term -> string -> 'a
val unsupportedFmla : Term.fmla -> string -> 'a
val unsupportedExpr : Term.expr -> string -> 'a
val unsupportedDecl : Decl.decl -> string -> 'a
val notImplemented : string -> 'a
(** [notImplemented s]. [s] explains what is not implemented *)
val report : Format.formatter -> error -> unit
......@@ -109,27 +109,31 @@ val report : Format.formatter -> error -> unit
(** {3 functions which catch inner error} *)
exception Unsupported of string
(** This exception must be raised only in a inside call of one of the above
catch_* function *)
(** This exception must be raised only inside a call
of one of the catch_* functions below *)
val unsupported : string -> 'a
(** convenient function to raise the {! Unsupported} exception *)
val catch_unsupportedtype : (Ty.ty -> 'a) -> (Ty.ty -> 'a)
(** [catch_unsupportedtype f] return a function which applied on [arg] :
- return [f arg] if [f arg] doesn't raise the {!
Unsupported} exception.
- raise [Error (unsupportedType (arg,s))] if [f arg]
val catch_unsupportedType : (Ty.ty -> 'a) -> (Ty.ty -> 'a)
(** [catch_unsupportedType f] return a function which applied on [arg]:
- return [f arg] if [f arg] does not raise {!Unsupported} exception
- raise [Error (unsupportedType (arg,s))] if [f arg]
raises [Unsupported s]*)
val catch_unsupportedterm : (Term.term -> 'a) -> (Term.term -> 'a)
(** same as {! catch_unsupportedtype} but use [UnsupportedExpression]
instead of [UnsupportedType]*)
val catch_unsupportedTerm : (Term.term -> 'a) -> (Term.term -> 'a)
(** same as {! catch_unsupportedType} but use [UnsupportedExpr]
instead of [UnsupportedType]*)
val catch_unsupportedFmla : (Term.fmla -> 'a) -> (Term.fmla -> 'a)
(** same as {! catch_unsupportedType} but use [UnsupportedExpr]
instead of [UnsupportedType]*)
val catch_unsupportedExpr : (Term.expr -> 'a) -> (Term.expr -> 'a)
(** same as {! catch_unsupportedType} but use [UnsupportedExpr]
instead of [UnsupportedType]*)
val catch_unsupportedfmla : (Term.fmla -> 'a) -> (Term.fmla -> 'a)
(** same as {! catch_unsupportedtype} but use [UnsupportedExpression]
instead of [UnsupportedType]*)
val catch_unsupportedDecl : (Decl.decl -> 'a) -> (Decl.decl -> 'a)
(** same as {! catch_unsupportedType} but use [UnsupportedDecl]
instead of [UnsupportedType] *)
val catch_unsupportedDeclaration : (Decl.decl -> 'a) -> (Decl.decl -> 'a)
(** same as {! catch_unsupportedtype} but use
[UnsupportedDeclaration] instead of [UnsupportedType] *)
src/printer/alt_ergo.ml
View file @ 937c08a1
......@@ -70,13 +70,13 @@ let rec print_term drv fmt t = match t.t_node with
| Some s -> Driver.syntax_arguments s (print_term drv) fmt tl
| None -> fprintf fmt "%a%a" print_ident ls.ls_name (print_tapp drv) tl
end
| Tlet _ -> unsupportedExpression (Term t)
| Tlet _ -> unsupportedTerm t
"alt-ergo : you must eliminate let in term"
| Tif _ -> unsupportedExpression (Term t)
| Tif _ -> unsupportedTerm t
"alt-ergo : you must eliminate if_then_else"
| Tcase _ -> unsupportedExpression (Term t)
| Tcase _ -> unsupportedTerm t
"alt-ergo : you must eliminate match"
| Teps _ -> unsupportedExpression (Term t)
| Teps _ -> unsupportedTerm t
"alt-ergo : you must eliminate epsilon"
and print_tapp drv fmt = function
......@@ -118,9 +118,9 @@ let rec print_fmla drv fmt f = match f.f_node with
fprintf fmt "((%a and %a) or (not %a and %a))"
(print_fmla drv) f1 (print_fmla drv) f2 (print_fmla drv)
f1 (print_fmla drv) f3
| Flet _ -> unsupportedExpression (Fmla f)
| Flet _ -> unsupportedFmla f
"alt-ergo : you must eliminate let in formula"
| Fcase _ -> unsupportedExpression (Fmla f)
| Fcase _ -> unsupportedFmla f
"alt-ergo : you must eliminate match"
......@@ -186,7 +186,7 @@ let print_decl drv fmt d = match d.d_node with
print_list_opt newline (print_type_decl drv) fmt dl
| Dlogic dl ->
print_list_opt newline (print_logic_decl drv) fmt dl
| Dind _ -> unsupportedDeclaration d
| Dind _ -> unsupportedDecl d
"alt-ergo : inductive definition are not supported"
| Dprop (Paxiom, pr, _) when Driver.query_remove drv pr.pr_name -> false
| Dprop (Paxiom, pr, f) ->
......@@ -198,7 +198,7 @@ let print_decl drv fmt d = match d.d_node with
| Dprop (Plemma, _, _) ->
assert false
let print_decl drv fmt = catch_unsupportedDeclaration (print_decl drv fmt)
let print_decl drv fmt = catch_unsupportedDecl (print_decl drv fmt)
let print_task drv fmt task =
Driver.print_full_prelude drv task fmt;
......
src/printer/smt.ml
View file @ 937c08a1
......@@ -59,7 +59,7 @@ and print_tyapp drv fmt = function
| [ty] -> fprintf fmt "%a " (print_type drv) ty
| tl -> fprintf fmt "(%a) " (print_list comma (print_type drv)) tl
let print_type drv fmt = catch_unsupportedtype (print_type drv fmt)
let print_type drv fmt = catch_unsupportedType (print_type drv fmt)
let rec print_term drv fmt t = match t.t_node with
| Tbvar _ -> assert false
......@@ -81,9 +81,9 @@ let rec print_term drv fmt t = match t.t_node with
| Tif (f1,t1,t2) ->
fprintf fmt "@[(ite %a@ %a@ %a)@]"
(print_fmla drv) f1 (print_term drv) t1 (print_term drv) t2
| Tcase _ -> unsupportedExpression (Term t)
| Tcase _ -> unsupportedTerm t
"smtv1 : you must eliminate match"
| Teps _ -> unsupportedExpression (Term t)
| Teps _ -> unsupportedTerm t
"smtv1 : you must eliminate epsilon"
and print_fmla drv fmt f = match f.f_node with
......@@ -131,7 +131,7 @@ and print_fmla drv fmt f = match f.f_node with
fprintf fmt "@[(let (%a %a)@ %a)@]" print_var v
(print_term drv) t1 (print_fmla drv) f2;
forget_var v
| Fcase _ -> unsupportedExpression (Fmla f)
| Fcase _ -> unsupportedFmla f
"smtv1 : you must eliminate match"
and print_expr drv fmt = e_apply (print_term drv fmt) (print_fmla drv fmt)
......@@ -173,7 +173,7 @@ let print_decl drv fmt d = match d.d_node with
print_list_opt newline (print_type_decl drv) fmt dl
| Dlogic dl ->
print_list_opt newline (print_logic_decl drv) fmt dl
| Dind _ -> unsupportedDeclaration d
| Dind _ -> unsupportedDecl d
"smt : inductive definition are not supported"
| Dprop (Paxiom, pr, _) when Driver.query_remove drv pr.pr_name -> false
| Dprop (Paxiom, _pr, f) ->
......@@ -189,7 +189,7 @@ let print_decl drv fmt d = match d.d_node with
fprintf fmt " @[(not@ %a)@]" (print_fmla drv) f;true
| Dprop (Plemma, _, _) -> assert false
let print_decl drv fmt = catch_unsupportedDeclaration (print_decl drv fmt)
let print_decl drv fmt = catch_unsupportedDecl (print_decl drv fmt)
let print_task drv fmt task =
fprintf fmt "(benchmark toto@\n"
......
src/transform/eliminate_algebraic.ml
View file @ 937c08a1
......@@ -46,24 +46,24 @@ let rec rewriteT kn state t = match t.t_node with
| [{ pat_node = Papp (cs,pl) }] ->
let add_var e p pj = match p.pat_node with
| Pvar v -> t_let v (t_app pj [t1] v.vs_ty) e
| _ -> Register.unsupportedExpression (Term t) uncompiled
| _ -> Register.unsupportedTerm t uncompiled
in
let pjl = Mls.find cs state.pj_map in
let e = List.fold_left2 add_var e pl pjl in
w, Mls.add cs e m
| [{ pat_node = Pwild }] ->
Some e, m
| _ -> Register.unsupportedExpression (Term t) uncompiled
| _ -> Register.unsupportedTerm t uncompiled
in
let w,m = List.fold_left mk_br (None,Mls.empty) bl in
let find cs = try Mls.find cs m with Not_found -> of_option w in
let ts = match t1.t_ty.ty_node with
| Tyapp (ts,_) -> ts
| _ -> Register.unsupportedExpression (Term t) uncompiled
| _ -> Register.unsupportedTerm t uncompiled
in
let tl = List.map find (find_constructors kn ts) in
t_app (Mts.find ts state.mt_map) (t1::tl) t.t_ty
| Tcase _ -> Register.unsupportedExpression (Term t) uncompiled
| Tcase _ -> Register.unsupportedTerm t uncompiled
| _ -> t_map (rewriteT kn state) (rewriteF kn state Svs.empty true) t
and rewriteF kn state av sign f = match f.f_node with
......@@ -77,12 +77,12 @@ and rewriteF kn state av sign f = match f.f_node with
| [{ pat_node = Papp (cs,pl) }] ->
let get_var p = match p.pat_node with
| Pvar v -> v
| _ -> Register.unsupportedExpression (Fmla f) uncompiled
| _ -> Register.unsupportedFmla f uncompiled
in
w, Mls.add cs (List.map get_var pl, e) m
| [{ pat_node = Pwild }] ->
Some e, m
| _ -> Register.unsupportedExpression (Fmla f) uncompiled
| _ -> Register.unsupportedFmla f uncompiled
in
let w,m = List.fold_left mk_br (None,Mls.empty) bl in
let find cs =
......@@ -105,11 +105,11 @@ and rewriteF kn state av sign f = match f.f_node with
in
let ts = match t1.t_ty.ty_node with
| Tyapp (ts,_) -> ts
| _ -> Register.unsupportedExpression (Fmla f) uncompiled
| _ -> Register.unsupportedFmla f uncompiled
in
let op = if sign then f_and_simp else f_or_simp in
map_join_left find op (find_constructors kn ts)
| Fcase _ -> Register.unsupportedExpression (Fmla f) uncompiled
| Fcase _ -> Register.unsupportedFmla f uncompiled
| Fquant (q, bf) when (q = Fforall && sign) || (q = Fexists && not sign) ->
let vl, tr, f1 = f_open_quant bf in
let tr' = tr_map (rewriteT kn state)
......
src/transform/eliminate_if.ml
View file @ 937c08a1
......@@ -38,7 +38,7 @@ let rec elim_t letl contT t = match t.t_node with
let f = List.fold_left (fun f (v,t) -> f_let v t f) f letl in
f_if f (elim_t letl contT t1) (elim_t letl contT t2)
| Tcase _ ->
Register.unsupportedExpression (Term t)
Register.unsupportedTerm t
"cannot eliminate 'if-then-else' under 'match' in terms"
| _ ->
t_map_cont (elim_t letl) elim_f contT t
......@@ -51,7 +51,7 @@ and elim_f contF f = match f.f_node with
(* the only terms we can still meet are the terms in triggers *)
and elim_tr contT t = match t.t_node with
| Tif _ ->
Register.unsupportedExpression (Term t)
Register.unsupportedTerm t
"cannot eliminate 'if-then-else' in trigger terms"
| _ -> t_map_cont elim_tr elim_f contT t
......
src/transform/encoding_decorate.ml
View file @ 937c08a1
......@@ -241,8 +241,8 @@ let rec rewrite_term tenv tvar vsvar t =
let t1' = fnT vsvar t1 in let t2' = fnT vsvar t2 in
if t1' == t1 && t2' == t2 then t else t_let u t1' t2'
| Tcase _ | Teps _ | Tbvar _ ->
Register.unsupportedExpression
(Term t) "Encoding decorate : I can't encode this term"
Register.unsupportedTerm t
"Encoding decorate : I can't encode this term"
and rewrite_fmla tenv tvar vsvar f =
let fnT = rewrite_term tenv tvar vsvar in
......@@ -296,13 +296,13 @@ let decl (tenv:tenv) d =
Hts.add tenv.trans_tsymbol ts tty;
tty in
[create_decl (create_logic_decl [(tty,None)])]
| Dtype _ -> Register.unsupportedDeclaration
| Dtype _ -> Register.unsupportedDecl
d "encoding_decorate : I can work only on abstract\
type which are not in recursive bloc."
| Dlogic l ->
let fn = function
| _ls, Some _ ->
Register.unsupportedDeclaration
Register.unsupportedDecl
d "encoding_decorate : I can't encode definition. \
Perhaps you could use eliminate_definition"
| ls, None ->
......@@ -314,7 +314,7 @@ Perhaps you could use eliminate_definition"
Hls.add tenv.trans_lsymbol ls ls_conv;
ls_conv,None in
[create_decl (create_logic_decl (List.map fn l))]
| Dind _ -> Register.unsupportedDeclaration
| Dind _ -> Register.unsupportedDecl
d "encoding_decorate : I can't work on inductive"
(* let fn (pr,f) = pr, fnF f in *)
(* let fn (ps,l) = ps, List.map fn l in *)
......
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