civicaml/main.ml

open Lexing
open Printf
open Ast

(* Compile CVC file to assembly code
 * in_channel -> int -> repr *)
let compile args =
    let rec run_phases input = function
        | [] -> ()
        | h::t -> run_phases (h input) t
    in
    run_phases (Args args) [
        Load.phase;
        Print.phase;
        Parse.phase;
        Print.phase;
        Desug.phase;
        Print.phase;
        (*
        Context_analysis.phase;
        Print.phase;
        Typecheck.phase;
        Extern_vars.phase;
        Dim_reduce.phase;
        Bool_op.phase;
        Assemble.phase;
        Peephole.phase;
        Print.phase;
        *)
    ]

let print_fancy_error msg loc verbose =
    let (fname, ystart, yend, xstart, xend) = loc in
    let line_s = if yend != ystart
        then sprintf "lines %d-%d" ystart yend
        else sprintf "line %d" ystart
    in
    let char_s = if xend != xstart || yend != ystart
        then sprintf "characters %d-%d" xstart xend
        else sprintf "character %d" xstart
    in
    eprintf "File \"%s\", %s, %s:\n" fname line_s char_s;
    eprintf "Error: %s\n" msg;

    if verbose >= 2 then (
        let file = open_in fname in

        (* skip lines until the first matched line *)
        for i = 1 to ystart - 1 do input_line file done;

        (* for each line in `loc`, print the source line with an underline *)
        for l = ystart to yend do
            let line = input_line file in
            let linewidth = String.length line in
            let left = if l = ystart then xstart else 1 in
            let right = if l = yend then xend else linewidth in
            if linewidth > 0 then (
                prerr_endline line;
                for i = 1 to left - 1 do prerr_char ' ' done;
                for i = left to right do prerr_char '^' done;
                prerr_endline ""
            )
        done
    )

(* Main function, returns exit status
 * () -> int *)
let main () =
    let args = {
        filename = None;
        verbose = 2;
        cpp = true;
    } in
    let args_spec = [
        ("-v",     Arg.Int (fun i -> args.verbose <- i),  "Set verbosity");
        ("-nocpp", Arg.Unit (fun i -> args.cpp <- false), "Disable C preprocessor");
    ] in
    let usage = "Usage: " ^ Sys.argv.(0) ^ " [-nocpp] [-v <verbosity>] <file>" in

    try
        try
            Arg.parse args_spec (fun s -> args.filename <- Some s) usage;
            compile args;
            0
        with
        | InvalidNode ->
            raise (CompileError "invalid node")
        | InvalidInput name ->
            raise (CompileError ("invalid input for phase \"" ^ name ^ "\""))
        | NodeError (node, msg) ->
            raise (LocError (Util.locof node, msg))
    with
    | CompileError msg ->
        eprintf "Error: %s\n" msg;
        1
    | LocError (loc, msg) ->
        print_fancy_error msg loc args.verbose;
        1

let _ = exit (main ())