(*
+ * Copyright (C) 2012, INRIA.
* Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
* Copyright (C) 2006, 2007 Julia Lawall
*
let rec do_all
(env, pr, pr_celem, pr_cspace, pr_space, pr_arity, pr_barrier,
- indent, unindent)
+ indent, unindent, eatspace)
generating xxs before =
(* Just to be able to copy paste the code from pretty_print_cocci.ml. *)
let print_string_box s = print_string s in
let print_option = Common.do_option in
-let print_option_prespace fn = function
- None -> ()
- | Some x -> pr_space(); fn x in
let print_option_space fn = function
None -> ()
| Some x -> fn x; pr_space() in
+let print_option_prespace fn = function
+ None -> ()
+ | Some x -> pr_space(); fn x in
let print_between = Common.print_between in
+let rec param_print_between between fn = function
+ | [] -> ()
+ | [x] -> fn x
+ | x::xs -> fn x; between x; param_print_between between fn xs in
+
+
let outdent _ = () (* should go to leftmost col, does nothing now *) in
let pretty_print_c =
(* --------------------------------------------------------------------- *)
-let handle_metavar name fn =
+let lookup_metavar name =
let ((_,b) as s,info,mc,pos) = name in
let line = info.Ast.line in
let lcol = info.Ast.column in
- match Common.optionise (fun () -> List.assoc s env) with
+ let rcol = if lcol = unknown then unknown else lcol + (String.length b) in
+ let res = Common.optionise (fun () -> List.assoc s env) in
+ (res,b,line,lcol,rcol) in
+
+let handle_metavar name fn =
+ let (res,name_string,line,lcol,rcol) = lookup_metavar name in
+ match res with
None ->
- let name_string (_,s) = s in
if generating
- then
- mcode (function _ -> print_string (name_string s)) name
+ then mcode (function _ -> print_string name_string) name
else
failwith
(Printf.sprintf "SP line %d: Not found a value in env for: %s"
- line (name_string s))
+ line name_string)
| Some e ->
pr_barrier line lcol;
(if generating
(* call mcode to preserve the -+ annotation *)
mcode (fun _ _ _ -> fn e) name
else fn e);
- let rcol =
- if lcol = unknown then unknown else lcol + (String.length b) in
pr_barrier line rcol
in
(* --------------------------------------------------------------------- *)
let dots between fn d =
match Ast.unwrap d with
- Ast.DOTS(l) -> print_between between fn l
- | Ast.CIRCLES(l) -> print_between between fn l
- | Ast.STARS(l) -> print_between between fn l
+ Ast.DOTS(l) -> param_print_between between fn l
+ | Ast.CIRCLES(l) -> param_print_between between fn l
+ | Ast.STARS(l) -> param_print_between between fn l
in
let nest_dots starter ender fn f d =
| Ast.MetaId(name,_,_,_) ->
handle_metavar name (function
| (Ast_c.MetaIdVal (id,_)) -> print_text id
- | _ -> raise Impossible
+ | _ -> raise (Impossible 142)
)
| Ast.MetaFunc(name,_,_,_) ->
handle_metavar name (function
| (Ast_c.MetaFuncVal id) -> print_text id
- | _ -> raise Impossible
+ | _ -> raise (Impossible 143)
)
| Ast.MetaLocalFunc(name,_,_,_) ->
handle_metavar name (function
| (Ast_c.MetaLocalFuncVal id) -> print_text id
- | _ -> raise Impossible
+ | _ -> raise (Impossible 144)
)
+ | Ast.AsIdent(id,asid) -> ident id
+
| Ast.DisjId(id_list) ->
if generating
then print_disj_list ident id_list
else raise CantBeInPlus
| Ast.OptIdent(_) | Ast.UniqueIdent(_) ->
raise CantBeInPlus
-
in
+
(* --------------------------------------------------------------------- *)
(* Expression *)
let rec expression e =
+ let top = 0 in
+ let assign = 1 in
+ let cond = 2 in
+ let log_or = 3 in
+ let log_and = 4 in
+ let bit_or = 5 in
+ let bit_xor = 6 in
+ let bit_and = 7 in
+ let equal = 8 in
+ let relat = 9 in
+ let shift = 10 in
+ let addit = 11 in
+ let mulit = 12 in
+ let cast = 13 in
+ let unary = 14 in
+ let postfix = 15 in
+ let primary = 16 in
+ let left_prec_of (op, _, _, _) =
+ match op with
+ | Ast.Arith Ast.Plus -> addit
+ | Ast.Arith Ast.Minus -> addit
+ | Ast.Arith Ast.Mul -> mulit
+ | Ast.Arith Ast.Div -> mulit
+ | Ast.Arith Ast.Min -> relat
+ | Ast.Arith Ast.Max -> relat
+ | Ast.Arith Ast.Mod -> mulit
+ | Ast.Arith Ast.DecLeft -> shift
+ | Ast.Arith Ast.DecRight -> shift
+ | Ast.Arith Ast.And -> bit_and
+ | Ast.Arith Ast.Or -> bit_or
+ | Ast.Arith Ast.Xor -> bit_xor
+
+ | Ast.Logical Ast.Inf -> relat
+ | Ast.Logical Ast.Sup -> relat
+ | Ast.Logical Ast.InfEq -> relat
+ | Ast.Logical Ast.SupEq -> relat
+ | Ast.Logical Ast.Eq -> equal
+ | Ast.Logical Ast.NotEq -> equal
+ | Ast.Logical Ast.AndLog -> log_and
+ | Ast.Logical Ast.OrLog -> log_or
+ in
+ let right_prec_of (op, _, _, _) =
+ match op with
+ | Ast.Arith Ast.Plus -> mulit
+ | Ast.Arith Ast.Minus -> mulit
+ | Ast.Arith Ast.Mul -> cast
+ | Ast.Arith Ast.Div -> cast
+ | Ast.Arith Ast.Min -> shift
+ | Ast.Arith Ast.Max -> shift
+ | Ast.Arith Ast.Mod -> cast
+ | Ast.Arith Ast.DecLeft -> addit
+ | Ast.Arith Ast.DecRight -> addit
+ | Ast.Arith Ast.And -> equal
+ | Ast.Arith Ast.Or -> bit_xor
+ | Ast.Arith Ast.Xor -> bit_and
+
+ | Ast.Logical Ast.Inf -> shift
+ | Ast.Logical Ast.Sup -> shift
+ | Ast.Logical Ast.InfEq -> shift
+ | Ast.Logical Ast.SupEq -> shift
+ | Ast.Logical Ast.Eq -> relat
+ | Ast.Logical Ast.NotEq -> relat
+ | Ast.Logical Ast.AndLog -> bit_or
+ | Ast.Logical Ast.OrLog -> log_and
+ in
+ let prec_of_c = function
+ | Ast_c.Ident (ident) -> primary
+ | Ast_c.Constant (c) -> primary
+ | Ast_c.FunCall (e, es) -> postfix
+ | Ast_c.CondExpr (e1, e2, e3) -> cond
+ | Ast_c.Sequence (e1, e2) -> top
+ | Ast_c.Assignment (e1, op, e2) -> assign
+ | Ast_c.Postfix(e, op) -> postfix
+ | Ast_c.Infix (e, op) -> unary
+ | Ast_c.Unary (e, op) -> unary
+ | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Plus, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Minus, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Mul, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Div, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Min, e2) -> relat
+ | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Max, e2) -> relat
+ | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Mod, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Arith Ast_c.DecLeft, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Arith Ast_c.DecRight, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Arith Ast_c.And, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Or, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Xor, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Logical Ast_c.AndLog, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Logical Ast_c.OrLog, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Logical Ast_c.Eq, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Logical Ast_c.NotEq, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Logical Ast_c.Sup, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Logical Ast_c.Inf, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Logical Ast_c.SupEq, e2) -> addit
+ | Ast_c.Binary (e1, Ast_c.Logical Ast_c.InfEq, e2) -> addit
+ | Ast_c.ArrayAccess (e1, e2) -> postfix
+ | Ast_c.RecordAccess (e, name) -> postfix
+ | Ast_c.RecordPtAccess (e, name) -> postfix
+ | Ast_c.SizeOfExpr (e) -> unary
+ | Ast_c.SizeOfType (t) -> unary
+ | Ast_c.Cast (t, e) -> cast
+ | Ast_c.StatementExpr (statxs, _) -> top
+ | Ast_c.Constructor (t, init) -> unary
+ | Ast_c.ParenExpr (e) -> primary
+ | Ast_c.New (_, t) -> unary
+ | Ast_c.Delete(t) -> unary
+ in
+
+ let rec loop e prec =
match Ast.unwrap e with
Ast.Ident(id) -> ident id
| Ast.Constant(const) -> mcode constant const
| Ast.FunCall(fn,lp,args,rp) ->
- expression fn; mcode (print_string_with_hint StartBox) lp;
+ loop fn postfix; mcode (print_string_with_hint StartBox) lp;
dots (function _ -> ()) arg_expression args;
mcode (print_string_with_hint EndBox) rp
| Ast.Assignment(left,op,right,_) ->
- expression left; pr_space(); mcode assignOp op;
- pr_space(); expression right
+ loop left unary; pr_space(); mcode assignOp op;
+ pr_space(); loop right assign
+ | Ast.Sequence(left,op,right) ->
+ loop left top; mcode print_string op;
+ pr_space(); loop right assign
| Ast.CondExpr(exp1,why,exp2,colon,exp3) ->
- expression exp1; pr_space(); mcode print_string why;
- print_option (function e -> pr_space(); expression e) exp2;
- pr_space(); mcode print_string colon; pr_space(); expression exp3
- | Ast.Postfix(exp,op) -> expression exp; mcode fixOp op
- | Ast.Infix(exp,op) -> mcode fixOp op; expression exp
- | Ast.Unary(exp,op) -> mcode unaryOp op; expression exp
+ loop exp1 log_or; pr_space(); mcode print_string why;
+ print_option (function e -> pr_space(); loop e top) exp2;
+ pr_space(); mcode print_string colon; pr_space(); loop exp3 cond
+ | Ast.Postfix(exp,op) -> loop exp postfix; mcode fixOp op
+ | Ast.Infix(exp,op) -> mcode fixOp op; loop exp unary
+ | Ast.Unary(exp,op) -> mcode unaryOp op; loop exp unary
| Ast.Binary(left,op,right) ->
- expression left; pr_space(); mcode binaryOp op; pr_space();
- expression right
+ loop left (left_prec_of op); pr_space(); mcode binaryOp op; pr_space();
+ loop right (right_prec_of op)
| Ast.Nested(left,op,right) -> failwith "nested only in minus code"
| Ast.Paren(lp,exp,rp) ->
- mcode print_string_box lp; expression exp; close_box();
+ mcode print_string_box lp; loop exp top; close_box();
mcode print_string rp
| Ast.ArrayAccess(exp1,lb,exp2,rb) ->
- expression exp1; mcode print_string_box lb; expression exp2; close_box();
+ loop exp1 postfix; mcode print_string_box lb; loop exp2 top; close_box();
mcode print_string rb
| Ast.RecordAccess(exp,pt,field) ->
- expression exp; mcode print_string pt; ident field
+ loop exp postfix; mcode print_string pt; ident field
| Ast.RecordPtAccess(exp,ar,field) ->
- expression exp; mcode print_string ar; ident field
+ loop exp postfix; mcode print_string ar; ident field
| Ast.Cast(lp,ty,rp,exp) ->
mcode print_string_box lp; fullType ty; close_box();
- mcode print_string rp; expression exp
+ mcode print_string rp; loop exp cast
| Ast.SizeOfExpr(sizeof,exp) ->
- mcode print_string sizeof; expression exp
+ mcode print_string sizeof; loop exp unary
| Ast.SizeOfType(sizeof,lp,ty,rp) ->
mcode print_string sizeof;
mcode print_string_box lp; fullType ty; close_box();
mcode print_string rp
| Ast.TypeExp(ty) -> fullType ty
+ | Ast.Constructor(lp,ty,rp,init) ->
+ mcode print_string_box lp; fullType ty; close_box();
+ mcode print_string rp; initialiser true init
| Ast.MetaErr(name,_,_,_) ->
failwith "metaErr not handled"
| Ast.MetaExpr (name,_,_,_typedontcare,_formdontcare,_) ->
- handle_metavar name (function
- | Ast_c.MetaExprVal (exp,_) ->
- pretty_print_c.Pretty_print_c.expression exp
- | _ -> raise Impossible
+ handle_metavar name (function
+ | Ast_c.MetaExprVal ((((e, _), _) as exp),_) ->
+ if prec_of_c e < prec then
+ begin
+ print_text "(";
+ pretty_print_c.Pretty_print_c.expression exp;
+ print_text ")"
+ end
+ else
+ pretty_print_c.Pretty_print_c.expression exp
+ | _ -> raise (Impossible 145)
)
| Ast.MetaExprList (name,_,_,_) ->
- handle_metavar name (function
+ handle_metavar name (function
| Ast_c.MetaExprListVal args ->
pretty_print_c.Pretty_print_c.arg_list args
| Ast_c.MetaParamListVal _ ->
failwith "have meta param list matching meta exp list\n";
- | _ -> raise Impossible
+ | _ -> raise (Impossible 146)
)
+ | Ast.AsExpr(expr,asexpr) -> loop expr prec
+
| Ast.EComma(cm) -> mcode print_string cm
| Ast.DisjExpr(exp_list) ->
| Ast.OptExp(exp) | Ast.UniqueExp(exp) ->
raise CantBeInPlus
+ in
+ loop e top
and arg_expression e =
match Ast.unwrap e with
| Ast.Logical(lop) -> logicalOp lop
and arithOp = function
- Ast.Plus -> print_string "+"
+ Ast.Plus -> print_string "+"
| Ast.Minus -> print_string "-"
| Ast.Mul -> print_string "*"
| Ast.Div -> print_string "/"
+ | Ast.Max -> print_string ">?"
+ | Ast.Min -> print_string "<?"
| Ast.Mod -> print_string "%"
| Ast.DecLeft -> print_string "<<"
| Ast.DecRight -> print_string ">>"
and fullType ft =
match Ast.unwrap ft with
- Ast.Type(cv,ty) -> print_option_space (mcode const_vol) cv; typeC ty
+ Ast.Type(_,cv,ty) ->
+ (match Ast.unwrap ty with
+ Ast.Pointer(_,_) ->
+ typeC ty; print_option_prespace (mcode const_vol) cv
+ | _ -> print_option_space (mcode const_vol) cv; typeC ty)
+
+ | Ast.AsType(ty, asty) -> fullType ty
| Ast.DisjType _ -> failwith "can't be in plus"
| Ast.OptType(_) | Ast.UniqueType(_) ->
raise CantBeInPlus
Ast.BaseType(ty,strings) ->
print_between pr_space (mcode print_string) strings
| Ast.SignedT(sgn,ty) -> mcode sign sgn; print_option_prespace typeC ty
- | Ast.Pointer(ty,star) -> fullType ty; ft_space ty; mcode print_string star
+ | Ast.Pointer(ty,star) ->
+ fullType ty; ft_space ty; mcode print_string star; eatspace()
| Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
(function _ -> ())
handle_metavar name (function
Ast_c.MetaTypeVal exp ->
pretty_print_c.Pretty_print_c.ty exp
- | _ -> raise Impossible)
+ | _ -> raise (Impossible 147))
and baseType = function
Ast.VoidType -> print_string "void"
| Ast.CharType -> print_string "char"
| Ast.ShortType -> print_string "short"
+ | Ast.ShortIntType -> print_string "short int"
| Ast.IntType -> print_string "int"
| Ast.DoubleType -> print_string "double"
+ | Ast.LongDoubleType -> print_string "long double"
| Ast.FloatType -> print_string "float"
| Ast.LongType -> print_string "long"
+ | Ast.LongIntType -> print_string "long int"
| Ast.LongLongType -> print_string "long long"
+ | Ast.LongLongIntType -> print_string "long long int"
| Ast.SizeType -> print_string "size_t "
| Ast.SSizeType -> print_string "ssize_t "
| Ast.PtrDiffType -> print_string "ptrdiff_t "
and print_named_type ty id =
match Ast.unwrap ty with
- Ast.Type(None,ty1) ->
+ Ast.Type(_,None,ty1) ->
(match Ast.unwrap ty1 with
Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2)
match Ast.unwrap ty with
Ast.Array(ty,lb,size,rb) ->
(match Ast.unwrap ty with
- Ast.Type(None,ty) ->
+ Ast.Type(_,cv,ty) ->
+ print_option_space (mcode const_vol) cv;
loop ty
(function _ ->
k ();
and ft_space ty =
match Ast.unwrap ty with
- Ast.Type(cv,ty) ->
- (match Ast.unwrap ty with
- Ast.Pointer(_,_) -> ()
- | Ast.MetaType(name,_,_) ->
- (match List.assoc (Ast.unwrap_mcode name) env with
- Ast_c.MetaTypeVal (tq,ty) ->
- (match Ast_c.unwrap ty with
- Ast_c.Pointer(_,_) -> ()
- | _ -> pr_space())
- | _ -> pr_space())
- | _ -> pr_space())
+ Ast.Type(_,cv,ty) ->
+ let isptr =
+ match Ast.unwrap ty with
+ Ast.Pointer(_,_) -> true
+ | Ast.MetaType(name,_,_) ->
+ let (res,name_string,line,lcol,rcol) = lookup_metavar name in
+ (match res with
+ None ->
+ failwith
+ (Printf.sprintf "variable %s not known on SP line %d\n"
+ name_string line)
+ | Some (Ast_c.MetaTypeVal (tq,ty)) ->
+ (match Ast_c.unwrap ty with
+ Ast_c.Pointer(_,_) -> true
+ | _ -> false)
+ | _ -> false)
+ | _ -> false in
+ if isptr then () else pr_space()
| _ -> pr_space()
-
+
and declaration d =
match Ast.unwrap d with
Ast.MetaDecl(name,_,_) ->
(function
Ast_c.MetaDeclVal d ->
pretty_print_c.Pretty_print_c.decl d
- | _ -> raise Impossible)
+ | _ -> raise (Impossible 148))
| Ast.MetaField(name,_,_) ->
handle_metavar name
(function
Ast_c.MetaFieldVal f ->
pretty_print_c.Pretty_print_c.field f
- | _ -> raise Impossible)
+ | _ -> raise (Impossible 149))
| Ast.MetaFieldList(name,_,_,_) ->
handle_metavar name
(function
Ast_c.MetaFieldListVal f ->
print_between force_newline pretty_print_c.Pretty_print_c.field f
- | _ -> raise Impossible)
+ | _ -> raise (Impossible 150))
+
+ | Ast.AsDecl(decl,asdecl) -> declaration decl
| Ast.Init(stg,ty,id,eq,ini,sem) ->
print_option (mcode storage) stg;
mcode print_string sem
| Ast.MacroDecl(name,lp,args,rp,sem) ->
ident name; mcode print_string_box lp;
- dots (function _ -> ()) expression args;
+ dots (function _ -> ()) arg_expression args;
close_box(); mcode print_string rp; mcode print_string sem
+ | Ast.MacroDeclInit(name,lp,args,rp,eq,ini,sem) ->
+ ident name; mcode print_string_box lp;
+ dots (function _ -> ()) arg_expression args;
+ close_box(); mcode print_string rp;
+ pr_space(); mcode print_string eq;
+ pr_space(); initialiser true ini; mcode print_string sem
| Ast.TyDecl(ty,sem) -> fullType ty; mcode print_string sem
| Ast.Typedef(stg,ty,id,sem) ->
mcode print_string stg;
handle_metavar name (function
Ast_c.MetaInitVal ini ->
pretty_print_c.Pretty_print_c.init ini
- | _ -> raise Impossible)
+ | _ -> raise (Impossible 151))
| Ast.MetaInitList(name,_,_,_) ->
handle_metavar name (function
Ast_c.MetaInitListVal ini ->
pretty_print_c.Pretty_print_c.init_list ini
- | _ -> raise Impossible)
+ | _ -> raise (Impossible 152))
+ | Ast.AsInit(init,asinit) -> initialiser nlcomma init
| Ast.InitExpr(exp) -> expression exp
| Ast.ArInitList(lb,initlist,rb) ->
(match Ast.undots initlist with
(function
Ast_c.MetaParamVal p ->
pretty_print_c.Pretty_print_c.param p
- | _ -> raise Impossible)
+ | _ -> raise (Impossible 153))
| Ast.MetaParamList(name,_,_,_) ->
handle_metavar name
(function
Ast_c.MetaParamListVal p ->
pretty_print_c.Pretty_print_c.paramlist p
- | _ -> raise Impossible)
+ | _ -> raise (Impossible 154))
+
+ | Ast.AsParam(p,e) -> raise CantBeInPlus
| Ast.PComma(cm) -> mcode print_string cm
| Ast.Pdots(dots) | Ast.Pcircles(dots) when generating ->
mcode print_string whl; pr_space(); mcode print_string_box lp;
expression exp; close_box(); mcode print_string rp;
mcode print_string sem
- | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
+ | Ast.ForHeader(fr,lp,first,e2,sem2,e3,rp) ->
pr_arity arity;
- mcode print_string fr; mcode print_string_box lp;
- print_option expression e1; mcode print_string sem1;
+ mcode print_string fr; mcode print_string_box lp; forinfo first;
print_option expression e2; mcode print_string sem2;
print_option expression e3; close_box();
mcode print_string rp
| Ast.IteratorHeader(nm,lp,args,rp) ->
pr_arity arity;
ident nm; pr_space(); mcode print_string_box lp;
- dots (function _ -> ()) expression args; close_box();
+ dots (function _ -> ()) arg_expression args; close_box();
mcode print_string rp
| Ast.SwitchHeader(switch,lp,exp,rp) ->
else raise CantBeInPlus
| Ast.MetaRuleElem(name,_,_) ->
- raise Impossible
+ raise (Impossible 155)
| Ast.MetaStmt(name,_,_,_) ->
handle_metavar name (function
| Ast_c.MetaStmtVal stm ->
pretty_print_c.Pretty_print_c.statement stm
- | _ -> raise Impossible
+ | _ -> raise (Impossible 156)
)
| Ast.MetaStmtList(name,_,_) ->
failwith
"MetaStmtList not supported (not even in ast_c metavars binding)"
+and forinfo = function
+ Ast.ForExp(e1,sem1) ->
+ print_option expression e1; mcode print_string sem1
+ | Ast.ForDecl (_,_,decl) -> declaration decl
+
and print_define_parameters params =
match Ast.unwrap params with
Ast.NoParams -> ()
| Ast.FAttr(attr) -> mcode print_string attr; pr_space() in
let indent_if_needed s f =
- match Ast.unwrap s with
- Ast.Seq(lbrace,body,rbrace) -> pr_space(); f()
- | _ ->
+ let isseq =
+ match Ast.unwrap s with
+ Ast.Seq(lbrace,body,rbrace) -> true
+ | Ast.Atomic s ->
+ (match Ast.unwrap s with
+ | Ast.MetaStmt(name,_,_,_) ->
+ let (res,name_string,line,lcol,rcol) = lookup_metavar name in
+ (match res with
+ None ->
+ failwith
+ (Printf.sprintf "variable %s not known on SP line %d\n"
+ name_string line)
+ | Some (Ast_c.MetaStmtVal stm) ->
+ (match Ast_c.unwrap stm with
+ Ast_c.Compound _ -> true
+ | _ -> false)
+ | _ -> failwith "bad metavariable value")
+ | _ -> false)
+ | _ -> false in
+ if isseq
+ then begin pr_space(); f() end
+ else
+ begin
(*no newline at the end - someone else will do that*)
- start_block(); f(); unindent true in
+ start_block(); f(); unindent true
+ end in
let rec statement arity s =
match Ast.unwrap s with
rule_elem arity header; pr_space();
dots force_newline (statement arity) body
+ | Ast.AsStmt(stmt,asstmt) -> statement arity stmt
+
| Ast.Disj([stmt_dots]) ->
if generating
then
| Ast.Rule_elemTag(x) -> rule_elem "" x; false
| Ast.StatementTag(x) -> statement "" x; false
+ | Ast.ForInfoTag(x) -> forinfo x; false
| Ast.CaseLineTag(x) -> case_line "" x; false
| Ast.ConstVolTag(x) -> const_vol x unknown unknown; false
(* this is not '...', but a list of expr/statement/params, and
normally there should be no '...' inside them *)
- | Ast.ExprDotsTag(x) -> dots (function _ -> ()) expression x; false
+ | Ast.ExprDotsTag(x) ->
+ let check_comma cm =
+ match Ast.unwrap cm with
+ Ast.EComma(cm) -> pr_space()
+ | _ -> () in
+ dots check_comma expression x; false
| Ast.ParamDotsTag(x) -> parameter_list x; false
| Ast.StmtDotsTag(x) -> dots force_newline (statement "") x; false
| Ast.DeclDotsTag(x) -> dots force_newline declaration x; false
newline_after()
let rec pp_list_list_any (envs, pr, pr_celem, pr_cspace, pr_space, pr_arity,
- pr_barrier, indent, unindent)
+ pr_barrier, indent, unindent, eatspace)
generating xxs before =
List.iter
(function env ->
do_all (env, pr, pr_celem, pr_cspace, pr_space, pr_arity, pr_barrier,
- indent, unindent)
+ indent, unindent, eatspace)
generating xxs before)
envs
HCoop / bpt / coccinelle.git / blobdiff