let rec pp_print_typespec ppf = function
PtypespecBuiltin p -> pp_print_builtin_typespec ppf p
| PtypespecStruct(union_p, id_opt, sbody_opt) ->
fprintf ppf "%a %a%a"
pp_print_struct_or_union union_p
(pp_print_option_with_sep ~f:pp_print_identifier ~sep:pp_print_sep_space) id_opt
(pp_print_option ~f:pp_print_struct_declaration_list) sbody_opt
| PtypespecEnumByName id ->
fprintf ppf "enum %a" pp_print_identifier id
| PtypespecEnumByDef(Some id, e) ->
fprintf ppf "enum %a %a"
pp_print_identifier id
pp_print_enum_list e
| PtypespecEnumByDef(None, e) ->
fprintf ppf "enum %a"
pp_print_enum_list e
| PtypespecAlias id ->
pp_print_identifier ppf id
and pp_print_struct_declarator ppf = function
PstructDeclNormal dc ->
fprintf ppf "@[<hv>%a@]"
pp_print_declarator dc
| PstructDeclBitfield(None,ex) ->
fprintf ppf "@[<hv>int : %a@]"
pp_print_constant_expression ex
| PstructDeclBitfield(Some dc, ex) ->
fprintf ppf "@[<hv>%a : %a@]"
pp_print_declarator dc
pp_print_constant_expression ex
and pp_print_struct_declaration ppf (PstructDecl(sq,dc)) =
fprintf ppf "@[<hv>%a @[<hv>%a@]@];"
pp_print_sqlist sq
(pp_print_list ~elem_pp:pp_print_struct_declarator ~sep_pp:pp_print_sep_comma)
dc
and pp_print_struct_declaration_list ppf s =
fprintf ppf "{@\n @[%a@]}"
(pp_print_list ~elem_pp:pp_print_struct_declaration ~sep_pp:pp_print_sep_newline) s
and pp_print_sq ppf = function
TypeSpec s -> pp_print_typespec ppf s
| TypeQualifier q -> pp_print_typequal ppf q
| StorageClass sc -> pp_print_storageclass ppf sc
and pp_print_sqlist ppf l =
fprintf ppf "@[<hv 2>%a@]"
(pp_print_list ~elem_pp:pp_print_sq ~sep_pp:pp_print_sep_space) l
and pp_print_enum_entry ppf = function
(id, None) -> pp_print_identifier ppf id
| (id, Some expr) ->
fprintf ppf "@[%a = @,%a@]"
pp_print_identifier id
pp_print_expression expr
and pp_print_enum_list ppf s =
fprintf ppf "{@\n @[<hv 2>%a@] }"
(pp_print_list ~elem_pp:pp_print_enum_entry ~sep_pp:pp_print_sep_comma)
s
and pp_print_declarator ppf dc =
let rec loop lv ppf dc =
match dc with
PdeclPointer(q,d) ->
if lv > 0 then
fprintf ppf "(%a)"
(loop 0) dc
else
fprintf ppf "*%a %a"
(pp_print_list ~elem_pp:pp_print_typequal ~sep_pp:pp_print_sep_space)
q
(loop 0) d
|
PdeclIdent x ->
pp_print_identifier ppf x
| PdeclAnonymous ->
()
| PdeclArray(x,e) ->
fprintf ppf "%a[%a]"
(loop 10) x
(pp_print_option ~f:pp_print_expression) e
| PdeclFuncType(x,argtypes) ->
fprintf ppf "%a(%a)"
(loop 10) x
(pp_print_list ~elem_pp:pp_print_paramdecl ~sep_pp:pp_print_sep_comma) argtypes
| PdeclFuncIdent(x,arglist) ->
fprintf ppf "%a(%a)"
(loop 10) x
(pp_print_list ~elem_pp:pp_print_identifier ~sep_pp:pp_print_sep_comma)
arglist
in
fprintf ppf "@[<hov 2>%a@]" (loop 0) dc
and pp_print_typename ppf (Ptypename(sq,dc)) =
fprintf ppf "%a @;%a" pp_print_sqlist sq pp_print_declarator dc
and pp_print_paramdecl ppf = function
PpdeclConcrete(sq, dc)
| PpdeclAbstract(sq, dc) ->
fprintf ppf "%a @;%a" pp_print_sqlist sq pp_print_declarator dc
| PpdeclVariant ->
fprintf ppf "..."
and pp_print_expression_iter lv ppf e : unit =
let print_with_paren e =
fprintf ppf "@[<hov 1>(%a)@]" (pp_print_expression_iter 0 : formatter -> expr -> unit) e
in
match e.pexp_t with
PexpComma(l,r) ->
if lv > 0 then print_with_paren e
else
fprintf ppf "%a, @,%a"
(pp_print_expression_iter 0) l (pp_print_expression_iter 10) r
|
PexpAssign(l,r) ->
if lv > 10 then print_with_paren e
else
fprintf ppf "%a@;<2> = @[<hov>%a@]"
(pp_print_expression_iter 20) l (pp_print_expression_iter 10) r
| PexpBinAssign(binop,l,r) ->
if lv > 10 then print_with_paren e
else
fprintf ppf "%a@;<2> %a= @[<hov>%a@]"
(pp_print_expression_iter 20) l pp_print_binop binop (pp_print_expression_iter 10) r
|
PexpConditional (e1, e2, e3) ->
if lv > 20 then print_with_paren e
else
fprintf ppf "%a @,? %a @,: %a"
(pp_print_expression_iter 30) e1 (pp_print_expression_iter 30) e2 (pp_print_expression_iter 30) e3
|
PexpBinExpr(PbinLogOr,l,r) ->
if lv > 30 then print_with_paren e
else
fprintf ppf "%a @,|| %a"
(pp_print_expression_iter 30) l (pp_print_expression_iter 40) r
|
PexpBinExpr(PbinLogAnd,l,r) ->
if lv > 40 then print_with_paren e
else
fprintf ppf "%a @,&& %a"
(pp_print_expression_iter 40) l (pp_print_expression_iter 50) r
|
PexpBinExpr(PbinIntOr,l,r) ->
if lv > 50 then print_with_paren e
else
fprintf ppf "%a @,| %a"
(pp_print_expression_iter 50) l (pp_print_expression_iter 60) r
|
PexpBinExpr(PbinIntXor,l,r) ->
if lv > 60 then print_with_paren e
else
fprintf ppf "%a @,^ %a"
(pp_print_expression_iter 60) l (pp_print_expression_iter 70) r
|
PexpBinExpr(PbinIntAnd,l,r) ->
if lv > 70 then print_with_paren e
else
fprintf ppf "%a @,& %a"
(pp_print_expression_iter 70) l (pp_print_expression_iter 80) r
|
PexpBinExpr((PbinEqual | PbinNotEqual) as b,l,r) ->
if lv > 80 then print_with_paren e
else
fprintf ppf "%a @,%a %a"
(pp_print_expression_iter 90) l pp_print_binop b (pp_print_expression_iter 90) r
|
PexpBinExpr
((PbinLessEqual | PbinLessThan | PbinGtrEqual | PbinGtrThan) as b,
l,r
) ->
if lv > 90 then print_with_paren e
else
fprintf ppf "%a @,%a %a"
(pp_print_expression_iter 100) l pp_print_binop b (pp_print_expression_iter 100) r
|
PexpBinExpr((PbinLshift | PbinRshift) as b,l,r) ->
if lv > 100 then print_with_paren e
else
fprintf ppf "%a @,%a %a"
(pp_print_expression_iter 110) l pp_print_binop b (pp_print_expression_iter 110) r
|
PexpBinExpr((PbinPlus | PbinMinus) as b,l,r) ->
if lv > 110 then print_with_paren e
else
fprintf ppf "%a @,%a %a"
(pp_print_expression_iter 110) l pp_print_binop b (pp_print_expression_iter 120) r
|
PexpBinExpr((PbinTimes | PbinDiv | PbinModulo) as b,l,r) ->
if lv > 120 then print_with_paren e
else
fprintf ppf "%a @,%a %a"
(pp_print_expression_iter 120) l pp_print_binop b (pp_print_expression_iter 130) r
|
PexpCast(t,c) ->
if lv > 130 then print_with_paren e
else
fprintf ppf "(%a)@;<0 2>%a"
pp_print_typename t (pp_print_expression_iter 130) c
|
PexpPreInc e ->
if lv > 140 then print_with_paren e
else
fprintf ppf "++%a" (pp_print_expression_iter 140) e
| PexpPreDec e ->
if lv > 140 then print_with_paren e
else
fprintf ppf "--%a" (pp_print_expression_iter 140) e
| PexpAddress e ->
if lv > 140 then print_with_paren e
else
fprintf ppf "&%a" (pp_print_expression_iter 140) e
| PexpPtrDeref e ->
if lv > 140 then print_with_paren e
else
fprintf ppf "*%a" (pp_print_expression_iter 140) e
| PexpUnaryExpr(uop,e) ->
if lv > 140 then print_with_paren e
else
fprintf ppf "%a%a"
(pp_print_unaryop) uop (pp_print_expression_iter 140) e
| PexpSizeOfExpr e ->
if lv > 140 then print_with_paren e
else
fprintf ppf "sizeof %a"
(pp_print_expression_iter 140) e
| PexpSizeOfType t ->
if lv > 140 then print_with_paren e
else
fprintf ppf "sizeof(%a)"
(pp_print_typename) t
|
PexpArrayRef(l,i) ->
if lv > 150 then print_with_paren e
else
fprintf ppf "%a@;<0 2>[%a]"
(pp_print_expression_iter 150) l (pp_print_expression_iter 0) i
| PexpInvoke(l,args) ->
if lv > 150 then print_with_paren e
else
fprintf ppf "%a@;<0 2>@,@[(%a)@]"
(pp_print_expression_iter 150) l (pp_print_argument_list) args
| PexpField(l,id) ->
if lv > 150 then print_with_paren e
else
fprintf ppf "%a.@;<0 2>%a"
(pp_print_expression_iter 150) l pp_print_identifier id
| PexpPtrField(l,id) ->
if lv > 150 then print_with_paren e
else
fprintf ppf "%a->@;<0 2>%a"
(pp_print_expression_iter 150) l pp_print_identifier id
| PexpPostInc(l) ->
if lv > 150 then print_with_paren e
else
fprintf ppf "%a++"
(pp_print_expression_iter 150) l
| PexpPostDec(l) ->
if lv > 150 then print_with_paren e
else
fprintf ppf "%a--"
(pp_print_expression_iter 150) l
|
PexpVar id ->
pp_print_identifier ppf id
| PexpConstant con ->
pp_print_constant ppf con
and pp_print_argument_list ppf args =
pp_print_list ~elem_pp:(pp_print_expression_iter 10) ~sep_pp:(pp_print_sep_comma) ppf args
and pp_print_expression ppf e =
fprintf ppf "@[<hv>%a@]" (pp_print_expression_iter 0) e
and pp_print_constant_expression ppf e =
fprintf ppf "@[<hv>%a@]" (pp_print_expression_iter 10) e