source: driver/clightPrinter.ml @ 2758

Last change on this file since 2758 was 2758, checked in by campbell, 7 years ago

Adapt prototype's Clight printer.
Doesn't use cost map yet.

File size: 19.6 KB
Line 
1(* *********************************************************************)
2(*                                                                     *)
3(*              The Compcert verified compiler                         *)
4(*                                                                     *)
5(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
6(*                                                                     *)
7(*  Copyright Institut National de Recherche en Informatique et en     *)
8(*  Automatique.  All rights reserved.  This file is distributed       *)
9(*  under the terms of the GNU General Public License as published by  *)
10(*  the Free Software Foundation, either version 2 of the License, or  *)
11(*  (at your option) any later version.  This file is also distributed *)
12(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
13(*                                                                     *)
14(* *********************************************************************)
15
16(** Pretty-printer for Csyntax *)
17
18open Format
19open Extracted.AST
20open Extracted.Csyntax
21open Extracted.Glue
22
23let freshNameCounter = ref 0
24let nameof id =
25  try
26    Hashtbl.find ClightFromC.symTable id
27  with Not_found ->
28    freshNameCounter := !freshNameCounter + 1;
29    let name = "_cerco" ^ string_of_int (!freshNameCounter) in
30    Hashtbl.add ClightFromC.symTable id name;
31    name
32
33let rec mListIter f l =
34match l with
35| Extracted.List.Nil -> ()
36| Extracted.List.Cons (h,t) -> f h; mListIter f t
37
38let rec mlist l =
39match l with
40| Extracted.List.Nil -> []
41| Extracted.List.Cons (h,t) -> h::(mlist t)
42
43
44let rec flist l =
45match l with
46| Fnil -> []
47| Fcons (id, ty, tl) -> (nameof id,ty)::(flist tl)
48
49let namecost l =
50  "_cost" ^ string_of_int (int_of_matitapos l)
51
52let name_unop = function
53  | Onotbool -> "!"
54  | Onotint  -> "~"
55  | Oneg     -> "-"
56
57
58let name_binop = function
59  | Oadd -> "+"
60  | Osub -> "-"
61  | Omul -> "*"
62  | Odiv -> "/"
63  | Omod -> "%"
64  | Oand -> "&"
65  | Oor  -> "|"
66  | Oxor -> "^"
67  | Oshl -> "<<"
68  | Oshr -> ">>"
69  | Oeq  -> "=="
70  | One0  -> "!="
71  | Olt  -> "<"
72  | Ogt  -> ">"
73  | Ole  -> "<="
74  | Oge  -> ">="
75
76let name_inttype sz sg =
77  match sz, sg with
78  | I8, Signed -> "signed char"
79  | I8, Unsigned -> "unsigned char"
80  | I16, Signed -> "short"
81  | I16, Unsigned -> "unsigned short"
82  | I32, Signed -> "int"
83  | I32, Unsigned -> "unsigned int"
84
85(*
86let name_floattype sz =
87  match sz with
88  | F32 -> "float"
89  | F64 -> "double"
90*)
91
92(* Collecting the names and fields of structs and unions *)
93
94module StructUnionSet = Set.Make(struct
95  type t = string * fieldlist
96  let compare (n1, _ : t) (n2, _ : t) = compare n1 n2
97end)
98
99let struct_unions = ref StructUnionSet.empty
100
101let register_struct_union id fld =
102  struct_unions := StructUnionSet.add (id, fld) !struct_unions
103
104(* Declarator (identifier + type) *)
105
106let name_optid id =
107  if id = "" then "" else " " ^ id
108
109let parenthesize_if_pointer id =
110  if String.length id > 0 && id.[0] = '*' then "(" ^ id ^ ")" else id
111
112let rec name_cdecl id ty =
113  match ty with
114  | Tvoid ->
115      "void" ^ name_optid id
116  | Tint(sz, sg) ->
117      name_inttype sz sg ^ name_optid id
118  (*| Tfloat sz ->
119      name_floattype sz ^ name_optid id*)
120  | Tpointer t ->
121      name_cdecl ("*" ^ id) t
122  | Tarray(t, n) ->
123      name_cdecl
124        (sprintf "%s[%ld]" (parenthesize_if_pointer id) (Int32.of_int (int_of_matitanat n)))
125        t
126  | Tfunction(args, res) ->
127      let b = Buffer.create 20 in
128      if id = ""
129      then Buffer.add_string b "(*)"
130      else Buffer.add_string b (parenthesize_if_pointer id);
131      Buffer.add_char b '(';
132      begin match args with
133      | Tnil ->
134          Buffer.add_string b "void"
135      | _ ->
136          let rec add_args first = function
137          | Tnil -> ()
138          | Tcons (t1, tl) ->
139              if not first then Buffer.add_string b ", ";
140              Buffer.add_string b (name_cdecl "" t1);
141              add_args false tl in
142          add_args true args
143      end;
144      Buffer.add_char b ')';
145      name_cdecl (Buffer.contents b) res
146  | Tstruct(name, fld) ->
147      (nameof name) ^ name_optid id
148  | Tunion(name, fld) ->
149      (nameof name) ^ name_optid id
150  | Tcomp_ptr name ->
151      (nameof name) ^ " *" ^ id
152
153(* Type *)
154
155let name_type ty = name_cdecl "" ty
156
157(* Expressions *)
158
159let parenthesis_level (Expr (e, ty)) =
160  match e with
161  | Econst_int _ -> 0
162  (*| Econst_float _ -> 0*)
163  | Evar _ -> 0
164  | Eunop(_, _) -> 30
165  | Ederef _ -> 20
166  | Eaddrof _ -> 30
167  | Ebinop(op, _, _) ->
168      begin match op with
169      | Oand | Oor | Oxor -> 75
170      | Oeq | One0 | Olt | Ogt | Ole | Oge -> 70
171      | Oadd | Osub | Oshl | Oshr -> 60
172      | Omul | Odiv | Omod -> 40
173      end
174  | Ecast _ -> 30
175  | Econdition(_, _, _) -> 80
176  | Eandbool(_, _) -> 80
177  | Eorbool(_, _) -> 80
178  | Esizeof _ -> 20
179  | Efield _ -> 20
180  | Ecost (_,_) -> 20 
181  (*| Ecall (_,_,_) -> 20*)
182
183let rec print_expr p (Expr (eb, ty) as e) =
184  let level = parenthesis_level e in
185  match eb with
186  | Econst_int (_,n) ->
187      fprintf p "%ld" (Int32.of_int (int_of_bitvector n))
188  (*| Econst_float f ->
189      fprintf p "%F" f*)
190  | Evar id ->
191      fprintf p "%s" (nameof id)
192  | Eunop(op, e1) ->
193      fprintf p "%s%a" (name_unop op) print_expr_prec (level, e1)
194  | Ederef (Expr (Ebinop(Oadd, e1, e2), _)) ->
195      fprintf p "@[<hov 2>%a@,[%a]@]"
196                print_expr_prec (level, e1)
197                print_expr_prec (level, e2)
198  | Ederef (Expr (Efield(e1, id), _)) ->
199      fprintf p "%a->%s" print_expr_prec (level, e1) (nameof id)
200  | Ederef e ->
201      fprintf p "*%a" print_expr_prec (level, e)
202  | Eaddrof e ->
203      fprintf p "&%a" print_expr_prec (level, e)
204  | Ebinop(op, e1, e2) ->
205      fprintf p "@[<hov 0>%a@ %s %a@]"
206                print_expr_prec (level, e1)
207                (name_binop op)
208                print_expr_prec (level, e2)
209  | Ecast(ty, e1) ->
210      fprintf p "@[<hov 2>(%s)@,%a@]"
211                (name_type ty)
212                print_expr_prec (level, e1)
213  | Econdition(e1, e2, e3) ->
214      fprintf p "@[<hov 0>%a@ ? %a@ : %a@]"
215                print_expr_prec (level, e1)
216                print_expr_prec (level, e2)
217                print_expr_prec (level, e3)
218  | Eandbool(e1, e2) ->
219      fprintf p "@[<hov 0>%a@ && %a@]"
220                print_expr_prec (level, e1)
221                print_expr_prec (level, e2)
222  | Eorbool(e1, e2) ->
223      fprintf p "@[<hov 0>%a@ || %a@]"
224                print_expr_prec (level, e1)
225                print_expr_prec (level, e2)
226  | Esizeof ty ->
227      fprintf p "sizeof(%s)" (name_type ty)
228  | Efield(e1, id) ->
229      fprintf p "%a.%s" print_expr_prec (level, e1) (nameof id)
230  | Ecost (lbl,e1) ->
231      fprintf p "(/* %s */ %a)" (namecost lbl) print_expr e1
232  (*| Ecall (f, arg, e) ->
233      fprintf p "(%s(%a), %a)" f print_expr arg print_expr e*)
234
235and print_expr_prec p (context_prec, e) =
236  let this_prec = parenthesis_level e in
237  if this_prec >= context_prec
238  then fprintf p "(%a)" print_expr e
239  else print_expr p e
240
241let rec print_expr_list p (first, el) =
242  match el with
243  | Extracted.List.Nil -> ()
244  | Extracted.List.Cons (e1, et) ->
245      if not first then fprintf p ",@ ";
246      print_expr p e1;
247      print_expr_list p (false, et)
248
249let rec print_stmt p s =
250  match s with
251  | Sskip ->
252      fprintf p "/*skip*/;"
253  | Sassign(e1, e2) ->
254      fprintf p "@[<hv 2>%a =@ %a;@]" print_expr e1 print_expr e2
255  | Scall(Extracted.Types.None, e1, el) ->
256      fprintf p "@[<hv 2>%a@,(@[<hov 0>%a@]);@]"
257                print_expr e1
258                print_expr_list (true, el)
259  | Scall(Extracted.Types.Some lhs, e1, el) ->
260      fprintf p "@[<hv 2>%a =@ %a@,(@[<hov 0>%a@]);@]"
261                print_expr lhs
262                print_expr e1
263                print_expr_list (true, el)
264  | Ssequence(s1, s2) ->
265      fprintf p "%a@ %a" print_stmt s1 print_stmt s2
266  | Sifthenelse(e, s1, Sskip) ->
267      fprintf p "@[<v 2>if (%a) {@ %a@;<0 -2>}@]"
268              print_expr e
269              print_stmt s1
270  | Sifthenelse(e, s1, s2) ->
271      fprintf p "@[<v 2>if (%a) {@ %a@;<0 -2>} else {@ %a@;<0 -2>}@]"
272              print_expr e
273              print_stmt s1
274              print_stmt s2
275  | Swhile(e, s) ->
276      fprintf p "@[<v 2>while (%a) {@ %a@;<0 -2>}@]"
277              print_expr e
278              print_stmt s
279  | Sdowhile(e, s) ->
280      fprintf p "@[<v 2>do {@ %a@;<0 -2>} while(%a);@]"
281              print_stmt s
282              print_expr e
283  | Sfor(s_init, e, s_iter, s_body) ->
284      fprintf p "@[<v 2>for (@[<hv 0>%a;@ %a;@ %a) {@]@ %a@;<0 -2>}@]"
285              print_stmt_for s_init
286              print_expr e
287              print_stmt_for s_iter
288              print_stmt s_body
289  | Sbreak ->
290      fprintf p "break;"
291  | Scontinue ->
292      fprintf p "continue;"
293  | Sswitch(e, cases) ->
294      fprintf p "@[<v 2>switch (%a) {@ %a@;<0 -2>}@]"
295              print_expr e
296              print_cases cases
297  | Sreturn Extracted.Types.None ->
298      fprintf p "return;"
299  | Sreturn (Extracted.Types.Some e) ->
300      fprintf p "return %a;" print_expr e
301  | Slabel(lbl, s1) ->
302      fprintf p "%s:@ %a" (nameof lbl) print_stmt s1
303  | Sgoto lbl ->
304      fprintf p "goto %s;" (nameof lbl)
305 | Scost (lbl,s1) ->
306     fprintf p "%s:@ %a" (namecost lbl) print_stmt s1
307
308and print_cases p cases =
309  match cases with
310  | LSdefault Sskip ->
311      ()
312  | LSdefault s ->
313      fprintf p "@[<v 2>default:@ %a@]" print_stmt s
314  | LScase(_, lbl, Sskip, rem) ->
315      fprintf p "case %ld:@ %a"
316        (Int32.of_int (int_of_bitvector lbl))
317        print_cases rem
318  | LScase(_, lbl, s, rem) ->
319      fprintf p "@[<v 2>case %ld:@ %a@]@ %a"
320              (Int32.of_int (int_of_bitvector lbl))
321              print_stmt s
322              print_cases rem
323
324and print_stmt_for p s =
325  match s with
326  | Sskip ->
327      fprintf p "/*nothing*/"
328  | Sassign(e1, e2) ->
329      fprintf p "%a = %a" print_expr e1 print_expr e2
330  | Ssequence(s1, s2) ->
331      fprintf p "%a, %a" print_stmt_for s1 print_stmt_for s2
332  | Scall(Extracted.Types.None, e1, el) ->
333      fprintf p "@[<hv 2>%a@,(@[<hov 0>%a@])@]"
334                print_expr e1
335                print_expr_list (true, el)
336  | Scall(Extracted.Types.Some lhs, e1, el) ->
337      fprintf p "@[<hv 2>%a =@ %a@,(@[<hov 0>%a@])@]"
338                print_expr lhs
339                print_expr e1
340                print_expr_list (true, el)
341  | _ ->
342      fprintf p "({ %a })" print_stmt s
343
344let name_function_parameters fun_name params =
345  let b = Buffer.create 20 in
346  Buffer.add_string b fun_name;
347  Buffer.add_char b '(';
348  begin match params with
349  | Extracted.List.Nil ->
350      Buffer.add_string b "void"
351  | _ ->
352      let rec add_params first = function
353      | Extracted.List.Nil -> ()
354      | Extracted.List.Cons ({Extracted.Types.fst = id; Extracted.Types.snd = ty}, rem) ->
355          if not first then Buffer.add_string b ", ";
356          Buffer.add_string b (name_cdecl (nameof id) ty);
357          add_params false rem in
358      add_params true params
359  end;
360  Buffer.add_char b ')';
361  Buffer.contents b
362
363let print_function p id f =
364  fprintf p "%s@ "
365            (name_cdecl (name_function_parameters id f.fn_params)
366                        f.fn_return);
367  fprintf p "@[<v 2>{@ ";
368  mListIter
369    (fun ({Extracted.Types.fst = id; Extracted.Types.snd = ty}) ->
370      fprintf p "%s;@ " (name_cdecl (nameof id) ty))
371    f.fn_vars;
372  print_stmt p f.fn_body;
373  fprintf p "@;<0 -2>}@]@ @ "
374
375let print_fundef p {Extracted.Types.fst = id; Extracted.Types.snd = fd} =
376  let id = nameof id in
377  match fd with
378  | CL_External(_, args, res) ->
379      fprintf p "extern %s;@ @ "
380                (name_cdecl id (Tfunction(args, res)))
381  | CL_Internal f ->
382      print_function p id f
383
384let string_of_init id =
385  let b = Buffer.create (List.length id) in
386  let add_init = function
387  | Init_int8 n ->
388      let n = int_of_bitvector n in
389      if n >= 32 && n <= 126 && n <> Char.code '\"' && n <> Char.code '\\'
390      then Buffer.add_char b (Char.chr n)
391      else Buffer.add_string b (Printf.sprintf "\\%03o" n)
392  | _ ->
393      assert false
394  in List.iter add_init id; Buffer.contents b
395
396let eight = matitanat_of_int 8
397let zero8 = Extracted.BitVector.zero eight
398
399let chop_last_nul id =
400  match List.rev id with
401  | Init_int8 n :: tl when Extracted.BitVector.eq_bv eight n zero8 = Extracted.Bool.True -> List.rev tl
402  | _ -> id
403
404let print_init p = function
405  | Init_int8 n -> fprintf p "%ld,@ " (Int32.of_int (int_of_bitvector n))
406  | Init_int16 n -> fprintf p "%ld,@ " (Int32.of_int (int_of_bitvector n))
407  | Init_int32 n -> fprintf p "%ld,@ " (Int32.of_int (int_of_bitvector n))
408  (*| Init_float32 n -> fprintf p "%F,@ " n
409  | Init_float64 n -> fprintf p "%F,@ " n*)
410  | Init_space n -> fprintf p "/* skip %ld, */@ " (Int32.of_int (int_of_matitanat n))
411  | Init_null _ -> fprintf p "0,@ "
412  | Init_addrof(symb, ofs) ->
413      let symb = nameof symb in
414      let ofs = Int32.of_int (int_of_matitanat ofs) in
415      if ofs = Int32.zero
416      then fprintf p "&%s,@ " symb
417      else fprintf p "(void *)((char *)&%s + %ld),@ " symb ofs
418
419let print_init1 p = function
420  | Init_int8 n -> fprintf p "%ld" (Int32.of_int (int_of_bitvector n))
421  | Init_int16 n -> fprintf p "%ld" (Int32.of_int (int_of_bitvector n))
422  | Init_int32 n -> fprintf p "%ld" (Int32.of_int (int_of_bitvector n))
423  (*| Init_float32 n -> fprintf p "%F" n
424  | Init_float64 n -> fprintf p "%F" n*)
425  | Init_space n -> fprintf p "/* skip %ld */" (Int32.of_int (int_of_matitanat n))
426  | Init_null _ -> fprintf p "0"
427  | Init_addrof(symb, ofs) ->
428      let symb = nameof symb in
429      let ofs = Int32.of_int (int_of_matitanat ofs) in
430      if ofs = Int32.zero
431      then fprintf p "&%s" symb
432      else fprintf p "(void *)((char *)&%s + %ld)" symb ofs
433
434(* XXX From Misc.LexingExt *)
435  let lex_num s pos =
436    let rec num i = 
437        if s.[i] >= '0' && s.[i] <= '9' then
438          num (i + 1)
439        else 
440          i
441    in
442    let pos' = num pos in
443    if pos = pos' then 
444      None
445    else 
446      Some (pos, pos', int_of_string (String.sub s pos (pos' - pos)))
447
448
449let match_string_literal s pos =
450  let s_len = String.length s - 1 in
451  let prefix = "__stringlit_" in
452  let len_prefix = String.length prefix in
453  s_len >= len_prefix
454  && String.sub s 0 len_prefix = prefix  && 
455      match lex_num s len_prefix with
456        | None -> false
457        | Some (pos, pos', v) -> pos' = String.length s - 1
458
459let print_globvar p ({Extracted.Types.fst = 
460                       {Extracted.Types.fst = id; Extracted.Types.snd = region};
461                      Extracted.Types.snd =
462                       {Extracted.Types.fst = init; Extracted.Types.snd = ty};
463                     }) =
464  let id = nameof id in
465  let init = mlist init in
466  match init with
467  | [] ->
468      fprintf p "extern %s;@ @ "
469              (name_cdecl id ty)
470  | [Init_space _] ->
471      fprintf p "%s;@ @ "
472              (name_cdecl id ty)
473  | [init] ->
474      fprintf p "@[<hov 2>%s = %a;@]@ @ "
475              (name_cdecl id ty) print_init1 init
476  | _ ->
477      fprintf p "@[<hov 2>%s = "
478              (name_cdecl id ty);
479      if match_string_literal id 0 
480      && List.for_all (function Init_int8 _ -> true | _ -> false) init
481      then
482        fprintf p "\"%s\"" (string_of_init (chop_last_nul init))
483      else begin
484        fprintf p "{@ ";
485        List.iter (print_init p) init;
486        fprintf p "}"
487      end;
488      fprintf p ";@]@ @ "
489
490(* Collect struct and union types *)
491
492let rec collect_type = function
493  | Tvoid -> ()
494  | Tint(sz, sg) -> ()
495  (*| Tfloat sz -> ()*)
496  | Tpointer t -> collect_type t
497  | Tarray(t, n) -> collect_type t
498  | Tfunction(args, res) -> collect_type_list args; collect_type res
499  | Tstruct(id, fld) -> register_struct_union (nameof id) fld; collect_fields fld
500  | Tunion(id, fld) -> register_struct_union (nameof id) fld; collect_fields fld
501  | Tcomp_ptr _ -> ()
502
503and collect_type_list = function
504  | Tnil -> ()
505  | Tcons (hd,tl) -> collect_type hd; collect_type_list tl
506
507and collect_fields = function
508  | Fnil -> ()
509  | Fcons (id, hd, tl) -> collect_type hd; collect_fields tl
510
511let rec collect_expr (Expr(ed, ty)) =
512  match ed with
513  | Econst_int _ -> ()
514  (*| Econst_float f -> ()*)
515  | Evar id -> ()
516  | Eunop(op, e1) -> collect_expr e1
517  | Ederef e -> collect_expr e
518  | Eaddrof e -> collect_expr e
519  | Ebinop(op, e1, e2) -> collect_expr e1; collect_expr e2
520  | Ecast(ty, e1) -> collect_type ty; collect_expr e1
521  | Econdition(e1, e2, e3) -> collect_expr e1; collect_expr e2; collect_expr e3
522  | Eandbool(e1, e2) -> collect_expr e1; collect_expr e2
523  | Eorbool(e1, e2) -> collect_expr e1; collect_expr e2
524  | Esizeof ty -> collect_type ty
525  | Efield(e1, id) -> collect_expr e1
526  | Ecost(_, e) -> collect_expr e
527  (*| Ecall(_, arg, e) -> collect_expr arg; collect_expr e*)
528
529let rec collect_expr_list = function
530  | Extracted.List.Nil -> ()
531  | Extracted.List.Cons (hd, tl) -> collect_expr hd; collect_expr_list tl
532
533let rec collect_stmt = function
534  | Sskip -> ()
535  | Sassign(e1, e2) -> collect_expr e1; collect_expr e2
536  | Scall(Extracted.Types.None, e1, el) -> collect_expr e1; collect_expr_list el
537  | Scall(Extracted.Types.Some lhs, e1, el) -> collect_expr lhs; collect_expr e1; collect_expr_list el
538  | Ssequence(s1, s2) -> collect_stmt s1; collect_stmt s2
539  | Sifthenelse(e, s1, s2) -> collect_expr e; collect_stmt s1; collect_stmt s2
540  | Swhile(e, s) -> collect_expr e; collect_stmt s
541  | Sdowhile(e, s) -> collect_stmt s; collect_expr e
542  | Sfor(s_init, e, s_iter, s_body) ->
543      collect_stmt s_init; collect_expr e;
544      collect_stmt s_iter; collect_stmt s_body
545  | Sbreak -> ()
546  | Scontinue -> ()
547  | Sswitch(e, cases) -> collect_expr e; collect_cases cases
548  | Sreturn Extracted.Types.None -> ()
549  | Sreturn (Extracted.Types.Some e) -> collect_expr e
550  | Slabel(lbl, s) -> collect_stmt s
551  | Sgoto lbl -> ()
552  | Scost (_,s1) -> collect_stmt s1
553
554and collect_cases = function
555  | LSdefault s -> collect_stmt s
556  | LScase(_, lbl, s, rem) -> collect_stmt s; collect_cases rem
557
558let collect_function f =
559  collect_type f.fn_return;
560  mListIter (fun ({Extracted.Types.fst = id; Extracted.Types.snd = ty}) -> collect_type ty) f.fn_params;
561  mListIter (fun ({Extracted.Types.fst = id; Extracted.Types.snd = ty}) -> collect_type ty) f.fn_vars;
562  collect_stmt f.fn_body
563
564let collect_fundef ({Extracted.Types.fst = id; Extracted.Types.snd = fd}) =
565  match fd with
566  | CL_External(_, args, res) -> collect_type_list args; collect_type res
567  | CL_Internal f -> collect_function f
568
569let collect_globvar v =
570  collect_type (Extracted.Types.snd (Extracted.Types.snd v))
571
572let collect_program p =
573  mListIter collect_globvar p.prog_vars;
574  mListIter collect_fundef p.prog_funct
575
576let declare_struct_or_union p (name, fld) =
577  fprintf p "%s;@ @ " name
578
579let print_struct_or_union p (name, fld) =
580  fprintf p "@[<v 2>%s {" name;
581  let rec print_fields = function
582  | Fnil -> ()
583  | Fcons (id, ty, rem) ->
584      fprintf p "@ %s;" (name_cdecl (nameof id) ty);
585      print_fields rem in
586  print_fields fld;
587  fprintf p "@;<0 -2>};@]@ "
588
589let print_program_2 p prog =
590  struct_unions := StructUnionSet.empty;
591  collect_program prog;
592  fprintf p "@[<v 0>";
593  StructUnionSet.iter (declare_struct_or_union p) !struct_unions;
594  StructUnionSet.iter (print_struct_or_union p) !struct_unions;
595  mListIter (print_globvar p) prog.prog_vars;
596  mListIter (print_fundef p) prog.prog_funct;
597  fprintf p "@]@."
598
599let print_program prog =
600  print_program_2 str_formatter prog;
601  flush_str_formatter ()
602
603let string_of_ctype = name_type
604
605let print_expression e = 
606  print_expr str_formatter e;
607  flush_str_formatter ()
608
609let print_statement s = 
610  print_stmt str_formatter s;
611  flush_str_formatter ()
612
613let print_ctype_prot = name_type
614
615let print_ctype_def = function
616  | Tstruct (name, fld) | Tunion (name, fld) ->
617    let f_fld s (id, t) = s ^ "  " ^ (print_ctype_prot t) ^ " " ^ id ^ ";\n" in
618    let s_fld = List.fold_left f_fld "" in
619    nameof name ^ " {\n" ^ (s_fld (flist fld)) ^ "};\n"
620  | _ -> "" (* no definition associated to the other types *)
621
622let string_of_unop = name_unop
623
624let string_of_binop = name_binop
Note: See TracBrowser for help on using the repository browser.