civicaml/phases/load.ml

open Types
open Util

(* Unix command to call for C preprocessor:
 * -nostdinc        : Don't include from C stdlib
 * -C               : Don't remove comments
 * -traditional-cpp : Don't remove excessive whitespaces, so that error
 *                    messages preserve correct character locations
 * -I               : Add working dir and executable dir to include dirs *)
let cpp_cmd = "cpp -nostdinc -C -traditional-cpp \
               -I" ^ Sys.getcwd () ^ " \
               -I" ^ (Filename.dirname Sys.executable_name)

let input_all ic =
  let n = in_channel_length ic in
  let buf = String.create n in
  really_input ic buf 0 n;
  close_in ic;
  buf

let input_buffered ic chunksize =
  let rec read_all buf bufsize pos =
    match input ic buf pos (bufsize - pos) with
    | 0 -> (close_in ic; buf)
    | nread when nread = bufsize - pos ->
      let bufsize = bufsize + chunksize in
      let pos = pos + nread in
      read_all (buf ^ String.create chunksize) bufsize pos
    | nread ->
      read_all buf bufsize (pos + nread)
  in
  read_all (String.create chunksize) chunksize 0

let phase = function
  | Empty ->
    let display_name =
      match Globals.args.infile with
      | Some filename -> filename
      | None -> "<stdin>"
    in
    let bufsize = 512 in

    if Globals.args.cpp then
      let cpp_out =
        match Globals.args.infile with
        | Some filename ->
          Unix.open_process_in (cpp_cmd ^ " " ^ filename)
        | None ->
          let content = input_buffered stdin bufsize in
          let cpp_out, cpp_in = Unix.open_process cpp_cmd in
          output_string cpp_in content;
          close_out cpp_in;
          cpp_out
      in
      log_line 2 "Run C preprocessor";

      (* Read preprocessed code from cpp's stdout *)
      let preprocessed = input_buffered cpp_out bufsize in
      FileContent (display_name, preprocessed)

    else
      let content =
        match Globals.args.infile with
        | Some filename -> input_all (open_in filename)
        | None -> input_buffered stdin bufsize
      in
      FileContent (display_name, content)

  | _ -> raise InvalidInput