l4/pkg/ocaml/contrib/otherlibs/labltk/compiler/ppexec.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                 MLTk, Tcl/Tk interface of Objective Caml            *)
   4 (*                                                                     *)
   5 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
   6 (*               projet Cristal, INRIA Rocquencourt                    *)
   7 (*            Jacques Garrigue, Kyoto University RIMS                  *)
   8 (*                                                                     *)
   9 (*  Copyright 2002 Institut National de Recherche en Informatique et   *)
  10 (*  en Automatique and Kyoto University.  All rights reserved.         *)
  11 (*  This file is distributed under the terms of the GNU Library        *)
  12 (*  General Public License, with the special exception on linking      *)
  13 (*  described in file LICENSE found in the Objective Caml source tree. *)
  14 (*                                                                     *)
  15 (***********************************************************************)
  16
  17 open Code
  18
  19 let debug = ref false
  20 let defined = ref []
  21 let linenum = ref 1
  22
  23 let rec nop = function
  24   | Line _ -> incr linenum
  25   | Ifdef (_, _, c1, c2o) ->
  26       List.iter nop c1;
  27       begin match c2o with
  28       | Some c2 -> List.iter nop c2
  29       | None -> ()
  30       end
  31   | _ -> ()
  32 ;;
  33
  34 let rec exec lp f = function
  35   | Line line ->
  36       if !debug then
  37         prerr_endline (Printf.sprintf "%03d: %s" !linenum
  38                          (String.sub line 0 ((String.length line) - 1)));
  39       f line; incr linenum
  40   | Ifdef (sw, k, c1, c2o) ->
  41       if List.mem k !defined = sw then begin
  42         List.iter (exec lp f) c1;
  43         begin match c2o with
  44         | Some c2 -> List.iter nop c2
  45         | None -> ()
  46         end;
  47         lp !linenum
  48       end else begin
  49         List.iter nop c1;
  50         match c2o with
  51         | Some c2 ->
  52             lp !linenum;
  53             List.iter (exec lp f) c2
  54         | None -> ()
  55       end
  56   | Define k -> defined := k :: !defined
  57   | Undef k ->
  58       defined := List.fold_right (fun k' s ->
  59         if k = k' then s else k' :: s) [] !defined
  60 ;;