2 * Copyright 2012, INRIA
3 * Julia Lawall, Gilles Muller
4 * Copyright 2010-2011, INRIA, University of Copenhagen
5 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
6 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
7 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
8 * This file is part of Coccinelle.
10 * Coccinelle is free software: you can redistribute it and/or modify
11 * it under the terms of the GNU General Public License as published by
12 * the Free Software Foundation, according to version 2 of the License.
14 * Coccinelle is distributed in the hope that it will be useful,
15 * but WITHOUT ANY WARRANTY; without even the implied warranty of
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 * GNU General Public License for more details.
19 * You should have received a copy of the GNU General Public License
20 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
22 * The authors reserve the right to distribute this or future versions of
23 * Coccinelle under other licenses.
27 #
0 "./unparse_ast0.ml"
29 module Ast
= Ast_cocci
30 module Ast0
= Ast0_cocci
31 module U
= Pretty_print_cocci
33 let quiet = ref true (* true = no decoration on - context, etc *)
35 let full_ids = ref false (* true = print rule name as well *)
38 force_newline
(); print_string
" "; open_box
0
41 close_box
(); force_newline
()
43 let print_option = Common.do_option
44 let print_between = Common.print_between
46 (* --------------------------------------------------------------------- *)
52 let current_name = Ast0.meta_pos_name var
in
53 let (_
,name
) = Ast0.unwrap_mcode
current_name in
56 meta_pos (Ast0.get_pos
current_name))
59 (* --------------------------------------------------------------------- *)
62 let mcodekind brackets fn x info mc
=
64 Ast.Noindent s
| Ast.Indent s
| Ast.Space s
-> print_string s
in
65 List.iter
(function (s
,_
) -> print s
) info
.Ast0.strings_before
;
67 Ast0.MINUS
(plus_stream
) ->
73 Some x
-> ("[","]^"^
(string_of_int x
))
75 let (plus_stream
,_
) = !plus_stream
in
78 else (print_string
"-";
79 print_string lb
; fn x
; print_string rb
);
80 (match plus_stream
with
81 Ast.NOREPLACEMENT
-> ()
82 | Ast.REPLACEMENT
(plus_stream
,_
) -> U.print_anything
">>> " plus_stream
)
83 | Ast0.CONTEXT
(plus_streams
) ->
89 Some x
-> ("[",("]^"^
(string_of_int x
))) | None
-> ("","") in
90 let (plus_streams
,t1
,t2
) = !plus_streams
in
93 print_string lb
; fn x
; print_string rb
)
95 | Ast0.PLUS _
-> print_int
(info
.Ast0.pos_info
.Ast0.column
); fn x
96 | Ast0.MIXED
(plus_streams
) ->
102 match brackets
with Some x
-> "^"^
(string_of_int x
) | None
-> "" in
104 let (plus_streams
,_
,_
) = !plus_streams
in
105 U.print_around
(function x
-> print_string lb
; fn x
; print_string rb
)
107 List.iter
(function (s
,_
) -> print s
) info
.Ast0.strings_after
109 let mcode fn
(x
,_
,info
,mc
,pos
,adj
) =
110 let fn x
= fn x
; meta_pos !pos
in
111 mcodekind (Some info
.Ast0.pos_info
.Ast0.line_start
)(*None*) fn x info mc
113 let print_context x
fn =
114 mcodekind (Some
(Ast0.get_line x
)) fn () (Ast0.get_info x
)
115 (Ast0.get_mcodekind x
)
117 let print_meta (ctx
,name
) =
119 then (print_string ctx
; print_string
":"));
122 (* --------------------------------------------------------------------- *)
123 (* --------------------------------------------------------------------- *)
126 let dots between
fn d
=
129 match Ast0.unwrap d
with
130 Ast0.DOTS
(l
) -> print_between between
fn l
131 | Ast0.CIRCLES
(l
) -> print_between between
fn l
132 | Ast0.STARS
(l
) -> print_between between
fn l
)
134 (* --------------------------------------------------------------------- *)
137 let do_disj lst processor
=
138 print_string
"\n("; force_newline
();
139 print_between (function _
-> print_string
"\n|"; force_newline
())
143 (* --------------------------------------------------------------------- *)
145 let print_types = function
149 Format.print_flush
();
150 print_between (function _
-> print_string
", ") Type_cocci.typeC ty
;
151 Format.print_flush
();
154 (* --------------------------------------------------------------------- *)
160 match Ast0.unwrap i
with
161 Ast0.Id
(name
) -> mcode print_string name
162 | Ast0.MetaId
(name
,_
,_
,_
) -> mcode print_meta name
163 | Ast0.MetaFunc
(name
,_
,_
) -> mcode print_meta name
164 | Ast0.MetaLocalFunc
(name
,_
,_
) -> mcode print_meta name
165 | Ast0.DisjId
(_
,id_list
,_
,_
) -> do_disj id_list
ident
166 | Ast0.OptIdent
(id
) -> print_string
"?"; ident id
167 | Ast0.UniqueIdent
(id
) -> print_string
"!"; ident id
168 | Ast0.AsIdent
(id
,asid
) -> ident id
; print_string
"@"; ident asid
)
170 (* --------------------------------------------------------------------- *)
173 let print_string_box s
= print_string s
; open_box
0
175 let rec expression e
=
176 print_option Type_cocci.typeC
(Ast0.get_type e
);
179 match Ast0.unwrap e
with
180 Ast0.Ident
(id
) -> ident id
181 | Ast0.Constant
(const
) -> mcode U.constant const
182 | Ast0.FunCall
(fn,lp
,args
,rp
) ->
183 expression fn; mcode print_string_box lp
;
184 let _ = dots (function _ -> ()) expression args
in
185 close_box
(); mcode print_string rp
186 | Ast0.Assignment
(left
,op
,right
,_) ->
187 expression left
; print_string
" "; mcode U.assignOp op
;
188 print_string
" "; expression right
189 | Ast0.Sequence
(left
,op
,right
) ->
190 expression left
; mcode print_string op
;
191 print_string
" "; expression right
192 | Ast0.CondExpr
(exp1
,why
,exp2
,colon
,exp3
) ->
193 expression exp1
; print_string
" "; mcode print_string why
;
194 print_option (function e
-> print_string
" "; expression e
) exp2
;
195 print_string
" "; mcode print_string colon
; expression exp3
196 | Ast0.Postfix
(exp
,op
) -> expression exp
; mcode U.fixOp op
197 | Ast0.Infix
(exp
,op
) -> mcode U.fixOp op
; expression exp
198 | Ast0.Unary
(exp
,op
) -> mcode U.unaryOp op
; expression exp
199 | Ast0.Binary
(left
,op
,right
) ->
201 expression left
; print_string
" "; mcode U.binaryOp op
;
202 print_string
" "; expression right
;
204 | Ast0.Nested
(left
,op
,right
) ->
206 expression left
; print_string
" "; mcode U.binaryOp op
;
207 print_string
" "; expression right
;
209 | Ast0.Paren
(lp
,exp
,rp
) ->
210 mcode print_string_box lp
; expression exp
; close_box
();
211 mcode print_string rp
212 | Ast0.ArrayAccess
(exp1
,lb
,exp2
,rb
) ->
213 expression exp1
; mcode print_string_box lb
; expression exp2
;
214 close_box
(); mcode print_string rb
215 | Ast0.RecordAccess
(exp
,pt
,field
) ->
216 expression exp
; mcode print_string pt
; ident field
217 | Ast0.RecordPtAccess
(exp
,ar
,field
) ->
218 expression exp
; mcode print_string ar
; ident field
219 | Ast0.Cast
(lp
,ty
,rp
,exp
) ->
220 mcode print_string_box lp
; typeC ty
; close_box
();
221 mcode print_string rp
; expression exp
222 | Ast0.SizeOfExpr
(szf
,exp
) ->
223 mcode print_string szf
; expression exp
224 | Ast0.SizeOfType
(szf
,lp
,ty
,rp
) ->
225 mcode print_string szf
;
226 mcode print_string_box lp
; typeC ty
; close_box
();
227 mcode print_string rp
228 | Ast0.TypeExp
(ty
) -> typeC ty
229 | Ast0.Constructor
(lp
,ty
,rp
,init
) ->
230 mcode print_string_box lp
; typeC ty
; close_box
();
231 mcode print_string rp
; initialiser init
232 | Ast0.MetaErr
(name
,_,_) -> mcode print_meta name
233 | Ast0.MetaExpr
(name
,_,ty
,_,pure
) ->
234 mcode print_meta name
; print_types ty
(*;
237 Ast0.Pure -> print_string "pure"
238 | Ast0.Impure -> print_string "impure"
239 | Ast0.Context -> print_string "context"
240 | Ast0.PureContext -> print_string "pure_context")*)
241 | Ast0.MetaExprList
(name
,_,_) -> mcode print_meta name
242 | Ast0.EComma
(cm
) -> mcode print_string cm
; print_space
()
243 | Ast0.DisjExpr
(_,exp_list
,_,_) -> do_disj exp_list
expression
244 | Ast0.NestExpr
(starter
,expr_dots
,ender
,None
,multi
) ->
245 mcode print_string starter
;
246 start_block(); dots force_newline
expression expr_dots
; end_block();
247 mcode print_string ender
248 | Ast0.NestExpr
(starter
,expr_dots
,ender
,Some whencode
,multi
) ->
249 mcode print_string starter
; print_string
" WHEN != ";
251 start_block(); dots force_newline
expression expr_dots
; end_block();
252 mcode print_string ender
253 | Ast0.Edots
(dots,Some whencode
)
254 | Ast0.Ecircles
(dots,Some whencode
)
255 | Ast0.Estars
(dots,Some whencode
) ->
256 mcode print_string
dots; print_string
" WHEN != ";
258 | Ast0.Edots
(dots,None
)
259 | Ast0.Ecircles
(dots,None
)
260 | Ast0.Estars
(dots,None
) -> mcode print_string
dots
261 | Ast0.OptExp
(exp
) -> print_string
"?"; expression exp
262 | Ast0.UniqueExp
(exp
) -> print_string
"!"; expression exp
263 | Ast0.AsExpr
(exp
,asexp
) -> expression exp
; print_string
"@";
266 and expression_dots x
= dots (function _ -> ()) expression x
268 (* --------------------------------------------------------------------- *)
271 and print_function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) fn =
272 typeC ty
; mcode print_string lp1
; mcode print_string star
; fn();
273 mcode print_string rp1
; mcode print_string lp2
;
274 parameter_list params
; mcode print_string rp2
276 and print_function_type
(ty
,lp1
,params
,rp1
) fn =
277 print_option typeC ty
; fn(); mcode print_string lp1
;
278 parameter_list params
; mcode print_string rp1
283 match Ast0.unwrap t
with
284 Ast0.ConstVol
(cv
,ty
) ->
285 mcode U.const_vol cv
; print_string
" "; typeC ty
286 | Ast0.BaseType
(ty
,strings
) ->
287 List.iter
(function s
-> mcode print_string s
; print_string
" ")
289 | Ast0.Signed
(sgn
,ty
) -> mcode U.sign sgn
; print_option typeC ty
290 | Ast0.Pointer
(ty
,star
) -> typeC ty
; mcode print_string star
291 | Ast0.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
292 print_function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
)
294 | Ast0.FunctionType
(ty
,lp1
,params
,rp1
) ->
295 print_function_type
(ty
,lp1
,params
,rp1
) (function _ -> ())
296 | Ast0.Array
(ty
,lb
,size
,rb
) ->
297 typeC ty
; mcode print_string lb
; print_option expression size
;
298 mcode print_string rb
299 | Ast0.EnumName
(kind
,name
) ->
300 mcode print_string kind
;
301 print_option (function x
-> ident x
; print_string
" ") name
302 | Ast0.EnumDef
(ty
,lb
,ids
,rb
) ->
303 typeC ty
; mcode print_string lb
;
304 dots force_newline
expression ids
;
305 mcode print_string rb
306 | Ast0.StructUnionName
(kind
,name
) ->
307 mcode U.structUnion kind
;
308 print_option (function x
-> ident x
; print_string
" ") name
309 | Ast0.StructUnionDef
(ty
,lb
,decls
,rb
) ->
310 typeC ty
; mcode print_string lb
;
311 dots force_newline declaration decls
;
312 mcode print_string rb
313 | Ast0.TypeName
(name
)-> mcode print_string name
; print_string
" "
314 | Ast0.MetaType
(name
,_)-> mcode print_meta name
; print_string
" "
315 | Ast0.DisjType
(_,types
,_,_) -> do_disj types typeC
316 | Ast0.OptType
(ty
) -> print_string
"?"; typeC ty
317 | Ast0.UniqueType
(ty
) -> print_string
"!"; typeC ty
318 | Ast0.AsType
(ty
,asty
) -> typeC ty
; print_string
"@"; typeC asty
)
320 (* --------------------------------------------------------------------- *)
321 (* Variable declaration *)
322 (* Even if the Cocci program specifies a list of declarations, they are
323 split out into multiple declarations of a single variable each. *)
325 and print_named_type ty id
=
326 match Ast0.unwrap ty
with
327 Ast0.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
328 print_function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
)
329 (function _ -> print_string
" "; ident id
)
330 | Ast0.FunctionType
(ty
,lp1
,params
,rp1
) ->
331 print_function_type
(ty
,lp1
,params
,rp1
)
332 (function _ -> print_string
" "; ident id
)
333 | Ast0.Array
(ty
,lb
,size
,rb
) ->
335 match Ast0.unwrap ty
with
336 Ast0.Array
(ty
,lb
,size
,rb
) ->
340 mcode print_string lb
;
341 print_option expression size
;
342 mcode print_string rb
)
343 | _ -> typeC ty
; ident id
; k
() in
344 loop ty
(function _ -> ())
345 | _ -> typeC ty
; ident id
350 match Ast0.unwrap d
with
351 Ast0.MetaDecl
(name
,_) | Ast0.MetaField
(name
,_)
352 | Ast0.MetaFieldList
(name
,_,_) ->
353 mcode print_meta name
354 | Ast0.Init
(stg
,ty
,id
,eq
,ini
,sem
) ->
355 print_option (mcode U.storage
) stg
;
356 print_named_type ty id
;
358 mcode print_string eq
; print_string
" "; initialiser ini
;
359 mcode print_string sem
360 | Ast0.UnInit
(stg
,ty
,id
,sem
) ->
361 print_option (mcode U.storage
) stg
; print_named_type ty id
;
362 mcode print_string sem
363 | Ast0.MacroDecl
(name
,lp
,args
,rp
,sem
) ->
364 ident name
; mcode print_string_box lp
;
365 let _ = dots (function _ -> ()) expression args
in
366 close_box
(); mcode print_string rp
; mcode print_string sem
367 | Ast0.MacroDeclInit
(name
,lp
,args
,rp
,eq
,ini
,sem
) ->
368 ident name
; mcode print_string_box lp
;
369 let _ = dots (function _ -> ()) expression args
in
370 close_box
(); mcode print_string rp
;
372 mcode print_string eq
; print_string
" "; initialiser ini
;
373 mcode print_string sem
374 | Ast0.TyDecl
(ty
,sem
) -> typeC ty
; mcode print_string sem
375 | Ast0.Typedef
(stg
,ty
,id
,sem
) ->
376 mcode print_string stg
; typeC ty
; typeC id
;
377 mcode print_string sem
378 | Ast0.DisjDecl
(_,decls
,_,_) ->
379 print_string
"\n("; force_newline
();
381 (function _ -> print_string
"\n|"; force_newline
())
384 | Ast0.Ddots
(dots,Some whencode
) ->
385 mcode print_string
dots; print_string
" when != ";
387 | Ast0.Ddots
(dots,None
) -> mcode print_string
dots
388 | Ast0.OptDecl
(decl
) -> print_string
"?"; declaration decl
389 | Ast0.UniqueDecl
(decl
) -> print_string
"!"; declaration decl
390 | Ast0.AsDecl
(decl
,asdecl
) ->
391 declaration decl
; print_string
"@"; declaration asdecl
)
393 and declaration_dots l
= dots (function _ -> ()) declaration l
395 (* --------------------------------------------------------------------- *)
401 match Ast0.unwrap i
with
402 Ast0.MetaInit
(name
,_)-> mcode print_meta name
; print_string
" "
403 | Ast0.MetaInitList
(name
,_,_)-> mcode print_meta name
; print_string
" "
404 | Ast0.InitExpr
(exp
) -> expression exp
405 | Ast0.InitList
(lb
,initlist
,rb
,ordered
) ->
406 (*doesn't show commas dropped in unordered case*)
407 mcode print_string lb
; open_box
0;
408 let _ = dots (function _ -> ()) initialiser initlist
in
409 close_box
(); mcode print_string rb
410 | Ast0.InitGccExt
(designators
,eq
,ini
) ->
411 List.iter designator designators
; print_string
" ";
412 mcode print_string eq
; print_string
" "; initialiser ini
413 | Ast0.InitGccName
(name
,eq
,ini
) ->
414 ident name
; mcode print_string eq
; initialiser ini
415 | Ast0.IComma
(cm
) -> mcode print_string cm
; force_newline
()
416 | Ast0.Idots
(d
,Some whencode
) ->
417 mcode print_string d
; print_string
" WHEN != ";
419 | Ast0.Idots
(d
,None
) -> mcode print_string d
420 | Ast0.OptIni
(ini
) -> print_string
"?"; initialiser ini
421 | Ast0.UniqueIni
(ini
) -> print_string
"!"; initialiser ini
422 | Ast0.AsInit
(ini
,asini
) -> initialiser ini
; print_string
"@";
425 and designator
= function
426 Ast0.DesignatorField
(dot
,id
) -> mcode print_string dot
; ident id
427 | Ast0.DesignatorIndex
(lb
,exp
,rb
) ->
428 mcode print_string lb
; expression exp
; mcode print_string rb
429 | Ast0.DesignatorRange
(lb
,min
,dots,max
,rb
) ->
430 mcode print_string lb
; expression min
; mcode print_string
dots;
431 expression max
; mcode print_string rb
433 and initialiser_list l
= dots (function _ -> ()) initialiser l
435 (* --------------------------------------------------------------------- *)
438 and parameterTypeDef p
=
441 match Ast0.unwrap p
with
442 Ast0.VoidParam
(ty
) -> typeC ty
443 | Ast0.Param
(ty
,Some id
) -> print_named_type ty id
444 | Ast0.Param
(ty
,None
) -> typeC ty
445 | Ast0.MetaParam
(name
,_) -> mcode print_meta name
446 | Ast0.MetaParamList
(name
,_,_) -> mcode print_meta name
447 | Ast0.PComma
(cm
) -> mcode print_string cm
; print_space
()
448 | Ast0.Pdots
(dots) -> mcode print_string
dots
449 | Ast0.Pcircles
(dots) -> mcode print_string
dots
450 | Ast0.OptParam
(param
) -> print_string
"?"; parameterTypeDef param
451 | Ast0.UniqueParam
(param
) -> print_string
"!"; parameterTypeDef param
452 | Ast0.AsParam
(p
,asexp
) -> parameterTypeDef p
; print_string
"@";
455 and parameter_list l
= dots (function _ -> ()) parameterTypeDef l
457 (* --------------------------------------------------------------------- *)
460 and statement arity s
=
463 match Ast0.unwrap s
with
464 Ast0.FunDecl
(_,fninfo
,name
,lp
,params
,rp
,lbrace
,body
,rbrace
) ->
466 List.iter print_fninfo fninfo
;
467 ident name
; mcode print_string_box lp
;
468 parameter_list params
; close_box
(); mcode print_string rp
;
470 print_string arity
; mcode print_string lbrace
; start_block();
471 dots force_newline
(statement arity
) body
;
472 end_block(); print_string arity
; mcode print_string rbrace
473 | Ast0.Decl
(_,decl
) ->
474 print_string arity
; declaration decl
475 | Ast0.Seq
(lbrace
,body
,rbrace
) ->
476 print_string arity
; mcode print_string lbrace
; start_block();
477 dots force_newline
(statement arity
) body
;
478 end_block(); print_string arity
; mcode print_string rbrace
479 | Ast0.ExprStatement
(exp
,sem
) ->
480 print_string arity
; print_option expression exp
;
481 mcode print_string sem
482 | Ast0.IfThen
(iff
,lp
,exp
,rp
,branch1
,(info
,aft
,adj
)) ->
484 mcode print_string iff
; print_string
" "; mcode print_string_box lp
;
485 expression exp
; close_box
(); mcode print_string rp
; print_string
" ";
486 statement arity branch1
;
487 mcode (function _ -> ()) ((),(),info
,aft
,ref [],adj
)
488 | Ast0.IfThenElse
(iff
,lp
,exp
,rp
,branch1
,els
,branch2
,(info
,aft
,adj
)) ->
490 mcode print_string iff
; print_string
" "; mcode print_string_box lp
;
491 expression exp
; close_box
(); mcode print_string rp
; print_string
" ";
492 statement arity branch1
;
493 print_string arity
; mcode print_string els
; print_string
" ";
494 statement arity branch2
;
495 mcode (function _ -> ()) ((),(),info
,aft
,ref [],adj
)
496 | Ast0.While
(whl
,lp
,exp
,rp
,body
,(info
,aft
,adj
)) ->
498 mcode print_string whl
; print_string
" "; mcode print_string_box lp
;
499 expression exp
; close_box
(); mcode print_string rp
; print_string
" ";
500 statement arity body
;
501 mcode (function _ -> ()) ((),(),info
,aft
,ref [],adj
)
502 | Ast0.Do
(d
,body
,whl
,lp
,exp
,rp
,sem
) ->
503 print_string arity
; mcode print_string d
; print_string
" ";
504 statement arity body
;
506 mcode print_string whl
; print_string
" "; mcode print_string_box lp
;
507 expression exp
; close_box
(); mcode print_string rp
;
508 mcode print_string sem
509 | Ast0.For
(fr
,lp
,first
,e2
,sem2
,e3
,rp
,body
,(info
,aft
,adj
)) ->
511 mcode print_string fr
; mcode print_string_box lp
;
512 (match Ast0.unwrap first
with
513 Ast0.ForExp
(e1
,sem1
) ->
514 print_option expression e1
; mcode print_string sem1
515 | Ast0.ForDecl
(_,decl
) -> declaration decl
);
516 print_option expression e2
; mcode print_string sem2
;
517 print_option expression e3
; close_box
();
518 mcode print_string rp
; print_string
" "; statement arity body
;
519 mcode (function _ -> ()) ((),(),info
,aft
,ref [],adj
)
520 | Ast0.Iterator
(nm
,lp
,args
,rp
,body
,(info
,aft
,adj
)) ->
522 ident nm
; print_string
" "; mcode print_string_box lp
;
523 let _ = dots (function _ -> ()) expression args
in
524 close_box
(); mcode print_string rp
; print_string
" ";
525 statement arity body
;
526 mcode (function _ -> ()) ((),(),info
,aft
,ref [],adj
)
527 | Ast0.Switch
(switch
,lp
,exp
,rp
,lb
,decls
,cases
,rb
) ->
529 mcode print_string switch
; print_string
" ";
530 mcode print_string_box lp
; expression exp
; close_box
();
531 mcode print_string rp
; print_string
" "; mcode print_string lb
;
532 dots force_newline
(statement arity
) decls
;
533 dots force_newline
(case_line arity
) cases
;
534 mcode print_string rb
535 | Ast0.Break
(br
,sem
) ->
536 print_string arity
; mcode print_string br
; mcode print_string sem
537 | Ast0.Continue
(cont
,sem
) ->
538 print_string arity
; mcode print_string cont
; mcode print_string sem
539 | Ast0.Label
(l
,dd
) -> ident l
; print_string
":"
540 | Ast0.Goto
(goto
,l
,sem
) ->
541 mcode print_string goto
; ident l
; mcode print_string sem
542 | Ast0.Return
(ret
,sem
) ->
543 print_string arity
; mcode print_string ret
; mcode print_string sem
544 | Ast0.ReturnExpr
(ret
,exp
,sem
) ->
545 print_string arity
; mcode print_string ret
; print_string
" ";
546 expression exp
; mcode print_string sem
547 | Ast0.MetaStmt
(name
,pure
) ->
548 print_string arity
; mcode print_meta name
;(*
551 Ast0.Pure -> print_string "pure"
552 | Ast0.Impure -> print_string "impure"
553 | Ast0.Context -> print_string "context"
554 | Ast0.PureContext -> print_string "pure_context")*)
555 | Ast0.MetaStmtList
(name
,_) ->
556 print_string arity
; mcode print_meta name
557 | Ast0.Disj
(starter
,statement_dots_list
,_,ender
) ->
559 print_string
"\n"; mcode print_string starter
; force_newline
();
561 (function _ -> print_string
"\n|"; force_newline
())
562 (dots force_newline
(statement arity
))
564 print_string
"\n"; mcode print_string ender
565 | Ast0.Nest
(starter
,stmt_dots
,ender
,whn
,multi
) ->
567 mcode print_string starter
;
570 (whencode
(dots force_newline
(statement
"")) (statement
""))
574 dots force_newline
(statement arity
) stmt_dots
;
576 mcode print_string ender
577 | Ast0.Exp
(exp
) -> print_string arity
; expression exp
578 | Ast0.TopExp
(exp
) -> print_string arity
; expression exp
579 | Ast0.Ty
(ty
) -> print_string arity
; typeC ty
580 | Ast0.TopInit
(init
) -> initialiser init
581 | Ast0.Dots
(d
,whn
) | Ast0.Circles
(d
,whn
) | Ast0.Stars
(d
,whn
) ->
582 print_string arity
; mcode print_string d
;
584 (whencode
(dots force_newline
(statement
"")) (statement
""))
586 | Ast0.Include
(inc
,s
) ->
587 mcode print_string inc
; print_string
" "; mcode U.inc_file s
588 | Ast0.Undef
(def
,id
) ->
589 mcode print_string def
; print_string
" "; ident id
590 | Ast0.Define
(def
,id
,params
,body
) ->
591 mcode print_string def
; print_string
" "; ident id
;
592 print_define_parameters params
;
594 dots force_newline
(statement arity
) body
595 | Ast0.OptStm
(re
) -> statement
"?" re
596 | Ast0.UniqueStm
(re
) -> statement
"!" re
597 | Ast0.AsStmt
(stm
,asstm
) -> statement arity stm
; print_string
"@";
598 statement arity asstm
)
600 and print_define_parameters params
=
601 match Ast0.unwrap params
with
603 | Ast0.DParams
(lp
,params
,rp
) ->
604 mcode print_string lp
;
605 dots (function _ -> ()) print_define_param params
; mcode print_string rp
607 and print_define_param param
=
608 match Ast0.unwrap param
with
609 Ast0.DParam
(id
) -> ident id
610 | Ast0.DPComma
(comma
) -> mcode print_string comma
611 | Ast0.DPdots
(dots) -> mcode print_string
dots
612 | Ast0.DPcircles
(circles
) -> mcode print_string circles
613 | Ast0.OptDParam
(dp
) -> print_string
"?"; print_define_param dp
614 | Ast0.UniqueDParam
(dp
) -> print_string
"!"; print_define_param dp
616 and print_fninfo
= function
617 Ast0.FStorage
(stg
) -> mcode U.storage stg
618 | Ast0.FType
(ty
) -> typeC ty
619 | Ast0.FInline
(inline
) -> mcode print_string inline
620 | Ast0.FAttr
(attr
) -> mcode print_string attr
622 and whencode notfn alwaysfn
= function
624 print_string
" WHEN != "; open_box
0; notfn a
; close_box
()
625 | Ast0.WhenAlways a
->
626 print_string
" WHEN = "; open_box
0; alwaysfn a
; close_box
()
627 | Ast0.WhenModifier x
-> print_string
" WHEN "; U.print_when_modif x
628 | Ast0.WhenNotTrue a
->
629 print_string
" WHEN != TRUE "; open_box
0; expression a
; close_box
()
630 | Ast0.WhenNotFalse a
->
631 print_string
" WHEN != FALSE "; open_box
0; expression a
; close_box
()
633 and case_line arity c
=
636 match Ast0.unwrap c
with
637 Ast0.Default
(def
,colon
,code
) ->
639 mcode print_string def
; mcode print_string colon
; print_string
" ";
640 dots force_newline
(statement arity
) code
641 | Ast0.Case
(case
,exp
,colon
,code
) ->
643 mcode print_string case
; print_string
" "; expression exp
;
644 mcode print_string colon
; print_string
" ";
645 dots force_newline
(statement arity
) code
646 | Ast0.DisjCase
(starter
,case_lines
,mids
,ender
) ->
647 print_string
"\n("; force_newline
();
649 (function _ -> print_string
"\n|"; force_newline
())
650 (case_line arity
) case_lines
;
652 | Ast0.OptCase
(case
) -> case_line
"?" case
)
654 and statement_dots l
= dots (function _ -> ()) (statement
"") l
655 and case_dots l
= dots (function _ -> ()) (case_line
"") l
657 (* --------------------------------------------------------------------- *)
663 match Ast0.unwrap t
with
664 Ast0.FILEINFO
(old_file
,new_file
) ->
665 print_string
"--- "; mcode print_string old_file
; force_newline
();
666 print_string
"+++ "; mcode print_string new_file
667 | Ast0.NONDECL
(stmt
) -> statement
"" stmt
668 | Ast0.CODE
(stmt_dots
) | Ast0.TOPCODE
(stmt_dots
) ->
669 dots force_newline
(statement
"") stmt_dots
670 | Ast0.ERRORWORDS
(exps
) ->
671 print_string
"error words = [";
672 print_between (function _ -> print_string
", ") expression exps
;
675 print_string
"OTHER("; statement
"" s
; print_string
")")
678 print_between (function _ -> force_newline
(); force_newline
()) top_level
680 let unparse_anything x
=
684 Ast0.DotsExprTag
(d
) ->
685 print_string
"ExpDots:"; force_newline
();
687 | Ast0.DotsParamTag
(d
) ->
689 | Ast0.DotsInitTag
(d
) ->
691 | Ast0.DotsStmtTag
(d
) ->
692 print_string
"StmDots:"; force_newline
();
694 | Ast0.DotsDeclTag
(d
) -> declaration_dots d
695 | Ast0.DotsCaseTag
(d
) -> case_dots d
696 | Ast0.IdentTag
(d
) -> ident d
697 | Ast0.ExprTag
(d
) | Ast0.ArgExprTag
(d
) | Ast0.TestExprTag
(d
) ->
698 print_string
"Exp:"; force_newline
();
700 | Ast0.TypeCTag
(d
) -> typeC d
701 | Ast0.ParamTag
(d
) -> parameterTypeDef d
702 | Ast0.InitTag
(d
) -> initialiser d
703 | Ast0.DeclTag
(d
) -> declaration d
705 print_string
"Stm:"; force_newline
();
707 | Ast0.ForInfoTag
(fi
) ->
708 print_string
"ForInfo:"; force_newline
();
709 (match Ast0.unwrap fi
with
710 Ast0.ForExp
(e1
,sem1
) ->
711 print_option expression e1
; mcode print_string sem1
712 | Ast0.ForDecl
(_,decl
) -> declaration decl
)
713 | Ast0.CaseLineTag
(d
) -> case_line
"" d
714 | Ast0.TopTag
(d
) -> top_level d
715 | Ast0.IsoWhenTag
(x
) -> U.print_when_modif x
716 | Ast0.IsoWhenTTag
(e
) -> expression e
717 | Ast0.IsoWhenFTag
(e
) -> expression e
718 | Ast0.MetaPosTag
(var
) -> meta_pos [x
]
719 | Ast0.HiddenVarTag
(var
) -> failwith
"should not need to be printed");
724 print_string
"\n@@\n@@";
730 let unparse_to_string x
= Common.format_to_string
(function _ -> unparse x
)