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 *)
let cpp_cmd = "cpp -nostdinc -C -traditional-cpp"

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 args.infile with
            | Some filename -> filename
            | None -> "<stdin>"
        in
        let bufsize = 512 in

        if args.cpp then
            let cpp_out = match 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

            let _ = log_line 2 "Run C preprocessor" in

            (* Read preprocessed code from cpp's stdout *)
            let preprocessed = input_buffered cpp_out bufsize in
            FileContent (display_name, preprocessed)
        else
            let content = match args.infile with
                | Some filename -> input_all (open_in filename)
                | None -> input_buffered stdin bufsize
            in
            FileContent (display_name, content)
    | _ -> raise (InvalidInput "load")