summaryrefslogtreecommitdiff
path: root/binary-compat/driver/pparse.ml
blob: 1d2b3a5441b011699da51d77cf522d648112978b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*        Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt     *)
(*                                                                     *)
(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
(*  en Automatique.  All rights reserved.  This file is distributed    *)
(*  under the terms of the Q Public License version 1.0.               *)
(*                                                                     *)
(***********************************************************************)

(* $Id$ *)

open Format

exception Error

(* Optionally preprocess a source file *)

let preprocess sourcefile =
  match !Clflags.preprocessor with
    None -> sourcefile
  | Some pp ->
      let tmpfile = Filename.temp_file "camlpp" "" in
      let comm = Printf.sprintf "%s %s > %s"
                                pp (Filename.quote sourcefile) tmpfile
      in
      if Ccomp.command comm <> 0 then begin
        Misc.remove_file tmpfile;
        raise Error;
      end;
      tmpfile

let remove_preprocessed inputfile =
  match !Clflags.preprocessor with
    None -> ()
  | Some _ -> Misc.remove_file inputfile

let remove_preprocessed_if_ast inputfile =
  match !Clflags.preprocessor with
    None -> ()
  | Some _ ->
      if inputfile <> !Location.input_name then Misc.remove_file inputfile

(* Parse a file or get a dumped syntax tree in it *)

exception Outdated_version

let input_intf_file ic magic =
  if magic = Config.ast_intf_magic_number then
    (input_value ic : Parsetree.signature)
  else
    raise Cmi_format.No_such_magic

let input_impl_file ic magic =
  if magic = Config.ast_impl_magic_number then
    (input_value ic : Parsetree.structure)
  else
    raise Cmi_format.No_such_magic

let file ppf inputfile parse_fun input_fun ast_magic =
  let ic = open_in_bin inputfile in
  let is_ast_file =
    try
      let buffer = String.create (String.length ast_magic) in
	really_input ic buffer 0 (String.length ast_magic);
	if String.sub buffer 0 9 = String.sub ast_magic 0 9 then
	  Some buffer
	else None
    with
    | _ -> None
  in
  let ast =
    try
      match is_ast_file with
	  Some magic ->
            if !Clflags.fast then
              fprintf ppf "@[Warning: %s@]@."
		"option -unsafe used with a preprocessor returning a syntax tree";
            Location.input_name := input_value ic;
            input_fun ic magic
	| None ->
            seek_in ic 0;
            Location.input_name := inputfile;
            let lexbuf = Lexing.from_channel ic in
              Location.init lexbuf inputfile;
              parse_fun lexbuf
    with
      | Cmi_format.No_such_magic -> (* replace Outdated_version *)
	  close_in ic;
          Misc.fatal_error "Ocaml and preprocessor have incompatible versions"
      | x -> close_in ic; raise x
  in
  close_in ic;
  ast