civicaml/main.ml

open Printf
open Lexing
open Types
open Util

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

(* Main function, returns exit status
 * Command-line arguments are stored in Util.args
 * () -> int *)
let main () =
    let args_spec = [
        ("-o", Arg.String (fun s -> args.outfile <- Some s),
            "Output file (defaults to foo.s for foo.cvc)");
        ("-v", Arg.Int (fun i -> args.verbose <- i),
            "Set verbosity (0|1|2)");
        ("-nocpp", Arg.Unit (fun i -> args.cpp <- false),
            "Disable C preprocessor");
    ] in
    let usage = "Usage: " ^ Sys.argv.(0) ^ " [-o <file>] [-nocpp] [-v <verbosity>] [<file>]" in

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

let _ = exit (main ())