1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167
|
(*
* This file is part of Coccinelle, licensed under the terms of the GPL v2.
* See copyright.txt in the Coccinelle source code for more information.
* The Coccinelle source code can be obtained at http://coccinelle.lip6.fr
*)
open Common
open Format
open Ast_ctl
(* todo?: a txt_to_latex, that use Format to compute the good space but
* then generate latex to better output.
*)
let char_and = "&"
let char_and_any = "&+"
let char_hack = "&h+"
let char_or = "v"
let char_seqor = "|"
let char_not = "!"
let char_back = "^"
(*
let char_and = "/\\"
let char_or = "\\/"
let char_not = "-|"
*)
(* need introduce the Val constructor, or use -rectype. *)
type ('a,'b,'c) environment = (string, ('a,'b,'c) binding_val) Common.assoc
and ('a, 'b, 'c) binding_val =
Val of ('a,'b,'c) generic_ctl * ('a,'b,'c) environment
let (pp_ctl:
('pred -> unit) * ('mvar -> unit) -> bool ->
('pred, 'mvar, 'info) generic_ctl ->
unit) =
fun (pp_pred, pp_mvar) inline_let_def ctl ->
let rec pp_aux env = function
False -> pp "False"
| True -> pp "True"
| Pred(p) -> pp_pred p
| Not(phi) ->
pp char_not; Common.pp_do_in_box (fun () -> pp_aux env phi)
| Exists(keep,v,phi) ->
pp "(";
if keep then pp ("Ex ") else pp ("Ex_ ");
pp_mvar v;
pp " . ";
print_cut();
Common.pp_do_in_box (fun () -> pp_aux env phi);
pp ")";
| AndAny(dir,s,phi1,phi2) ->
pp_2args env (char_and_any^(pp_dirc dir)^(pp_sc s)) phi1 phi2;
| HackForStmt(dir,s,phi1,phi2) ->
pp_2args env (char_hack^(pp_dirc dir)^(pp_sc s)) phi1 phi2;
| And(s,phi1,phi2) -> pp_2args env (char_and^(pp_sc s)) phi1 phi2;
| Or(phi1,phi2) -> pp_2args env char_or phi1 phi2;
| SeqOr(phi1,phi2) -> pp_2args env char_seqor phi1 phi2;
| Implies(phi1,phi2) -> pp_2args env "=>" phi1 phi2;
| AF(dir,s,phi1) -> pp "AF"; pp_dir dir; pp_s s; pp_arg_paren env phi1;
| AX(dir,s,phi1) -> pp "AX"; pp_dir dir; pp_s s; pp_arg_paren env phi1;
| AG(dir,s,phi1) -> pp "AG"; pp_dir dir; pp_s s; pp_arg_paren env phi1;
| EF(dir,phi1) -> pp "EF"; pp_dir dir; pp_arg_paren env phi1;
| EX(dir,phi1) -> pp "EX"; pp_dir dir; pp_arg_paren env phi1;
| EG(dir,phi1) -> pp "EG"; pp_dir dir; pp_arg_paren env phi1;
| AW(dir,s,phi1,phi2) ->
pp "A"; pp_dir dir; pp_s s; pp "[";
pp_2args_bis env "W" phi1 phi2;
pp "]"
| AU(dir,s,phi1,phi2) ->
pp "A"; pp_dir dir; pp_s s; pp "[";
pp_2args_bis env "U" phi1 phi2;
pp "]"
| EU(dir,phi1,phi2) ->
pp "E"; pp_dir dir; pp "[";
pp_2args_bis env "U" phi1 phi2;
pp "]"
| Let (x,phi1,phi2) ->
let env' = (x, (Val (phi1,env)))::env in
if not inline_let_def
then
begin
pp ("Let"^" "^x);
pp " = ";
print_cut();
Common.pp_do_in_box (fun () -> pp_aux env phi1);
print_space ();
pp "in";
print_space ();
end;
pp_do_in_zero_box (fun () -> pp_aux env' phi2);
| LetR (dir,x,phi1,phi2) ->
let env' = (x, (Val (phi1,env)))::env in
if not inline_let_def
then
begin
pp ("LetR"^" "^x); pp_dir dir;
pp " = ";
print_cut();
Common.pp_do_in_box (fun () -> pp_aux env phi1);
print_space ();
pp "in";
print_space ();
end;
pp_do_in_zero_box (fun () -> pp_aux env' phi2);
| Ref(s) ->
if inline_let_def
then
let Val (phi1,env') = List.assoc s env in
pp_aux env' phi1
else
(* pp "Ref("; *)
pp s
(* pp ")" *)
| Uncheck(phi1) ->
pp "Uncheck"; pp_arg_paren env phi1
| InnerAnd(phi1) ->
pp "InnerAnd"; pp_arg_paren env phi1
| XX phi1 -> pp "XX"; pp_arg_paren env phi1
and pp_dir = function
FORWARD -> ()
| BACKWARD -> pp char_back
and pp_dirc = function
FORWARD -> ""
| BACKWARD -> char_back
and pp_s = function
STRICT -> if !Flag_ctl.partial_match then pp "," else ()
| NONSTRICT -> ()
and pp_sc = function
STRICT -> ","
| NONSTRICT -> ""
and pp_2args env sym phi1 phi2 =
begin
pp "(";
Common.pp_do_in_box (fun () -> pp_aux env phi1);
print_space();
pp sym;
print_space ();
Common.pp_do_in_box (fun () -> pp_aux env phi2);
pp ")";
end
and pp_2args_bis env sym phi1 phi2 =
begin
Common.pp_do_in_box (fun () -> pp_aux env phi1);
print_space();
pp sym;
print_space();
Common.pp_do_in_box (fun () -> pp_aux env phi2);
end
and pp_arg_paren env phi = Common.pp_do_in_box (fun () ->
pp "(";
pp_aux env phi;
pp ")";
)
in
Common.pp_do_in_box (fun () -> pp_aux [] ctl;)
|