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 rec repeat str n = if n = 0 then "" else str ^ (repeat str (n - 1)) 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 | LocError (msg, loc) -> print_fancy_error msg loc !verbose; 1 let _ = exit (main ())