civicaml/main.ml

open Lexing
open Printf
open Ast

(* Compile infile to assembly code
 * in_channel -> int -> repr *)
let compile infile verbose =
    let rec run_phases ir = function
        | [] -> ir
        | h::t -> run_phases (h ir) t
    in
    run_phases (Inputfile (infile, verbose)) [
        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 filename = ref None in
    let verbose = ref 2 in
    let args = [
        ("-v", Arg.Int (fun i -> verbose := i), "Set verbosity")
    ] in
    let usage = "Usage: " ^ Sys.argv.(0) ^ " [ -v VERBOSITY ] FILE" in

    try
        Arg.parse args (fun s -> filename := Some s) usage;
        let _ = compile !filename !verbose in
        0
    with
    | CompileError msg ->
        prerr_endline ("Error: " ^ msg);
        1
    | NodeError (node, msg) ->
        print_fancy_error msg (Util.locof node) !verbose;
        1
    | LocError (loc, msg) ->
        print_fancy_error msg loc !verbose;
        1

let _ = exit (main ())