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 ] " 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 ())