Mostly fixed line numbers + added fancy error message

Makefile

@@ -1,7 +1,8 @@
 RESULT := civicc
 SOURCES := ast.ml lexer.mll parser.mly util.mli util.ml stringify.mli \
 	stringify.ml \
-	phases/parse.ml phases/print.ml phases/desug.ml phases/context_analysis.ml \
+	phases/parse.ml phases/print.ml phases/desug.ml \
+	phases/context_analysis.ml phases/test.ml \
 	main.ml
 PRE_TARGETS := ast.cmi
 LIBS := str

lexer.mll

@@ -83,10 +83,10 @@ rule token = parse
     | ['0'-'9']+'.'['0'-'9']+ as f { FLOAT_CONST (float_of_string f) }
     | ['A'-'Z''a'-'z']['A'-'Z''a'-'z''0'-'9''_']* as id { ID id }
 
-    | '\r'|'\n'|"\r\n"  { next_line lexbuf; token lexbuf }
-    | [' ''\t']+        { token lexbuf }
-    | "//"[^'\n']*      { token lexbuf }
-    | "/*"_*"*/"        { token lexbuf }
+    | '\r' | '\n' | "\r\n"  { next_line lexbuf; token lexbuf }
+    | [' ''\t']+            { token lexbuf }
+    | "//"[^'\n']*          { token lexbuf }
+    | "/*"_*"*/"            { token lexbuf }
 
     | eof       { EOF }
-    | _ as chr  { raise (SyntaxError ("Unexpected char: " ^ Char.escaped chr)) }
+    | _ as chr  { raise (SyntaxError ("unexpected char: " ^ Char.escaped chr)) }

main.ml

@@ -1,3 +1,4 @@
+open Lexing
 open Printf
 open Ast
 
@@ -13,22 +14,61 @@ let compile infile verbose =
         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;*)
+        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 1 in
+    let verbose = ref 2 in
     let args = [
         ("-v", Arg.Int (fun i -> verbose := i), "Set verbosity")
     ] in
@@ -41,12 +81,9 @@ let main () =
     with
     | CompileError msg ->
         prerr_endline ("Error: " ^ msg);
-        -1
+        1
     | LocError (msg, loc) ->
-        let (file, ystart, yend, xstart, xend) = loc in
-        let yend = if yend = ystart then "" else "-" ^ string_of_int yend in
-        let xend = if xend = xstart then "" else "-" ^ string_of_int xend in
-        eprintf "Error: %s at %s:%d%s:%d%s" msg file ystart yend xstart xend;
-        -1
+        print_fancy_error msg loc !verbose;
+        1
 
 let _ = exit (main ())

phases/context_analysis.ml

@@ -7,9 +7,10 @@ module StrMap = Map.Make (String)
 let analyse_context node =
     let scope = ref StrMap.empty in
     let add_to_scope name decl depth desc =
-        if StrMap.mem name !scope then
-            raise (LocError (sprintf "cannot redeclare %s \"%s\"" desc name, (locof node)))
-        else
+        if StrMap.mem name !scope then(
+            eprintf "node: %s\n" (Stringify.node2str !decl);
+            raise (LocError (sprintf "cannot redeclare %s \"%s\"" desc name, (locof !decl)))
+        ) else
             scope := StrMap.add name (decl, depth) !scope
     in
     let rec analyse depth = function

phases/desug.ml

@@ -1,10 +1,10 @@
 open Ast
 open Util
 
-let rec flatten = function
+let rec flatten_blocks = function
     | [] -> []
-    | Block nodes :: t -> (flatten nodes) @ (flatten t)
-    | h :: t -> h :: (flatten t)
+    | Block nodes :: t -> (flatten_blocks nodes) @ (flatten_blocks t)
+    | h :: t -> h :: (flatten_blocks t)
 
 let rec var_init = function
     (* Split local variable initialisations in declaration and assignment *)
@@ -13,23 +13,26 @@ let rec var_init = function
             let rec trav inits node = match node with
                 (* translate scalar array initialisation to ArrayScalar node,
                  * for easy replacement later on *)
-                | VarDec (ArrayDef (_, _) as vtype, name, Some ((BoolConst (_, l)) as v), loc) :: t
-                | VarDec (ArrayDef (_, _) as vtype, name, Some ((FloatConst (_, l)) as v), loc) :: t
-                | VarDec (ArrayDef (_, _) as vtype, name, Some ((IntConst (_, l)) as v), loc) :: t ->
+                | VarDec (ArrayDef (_, _) as vtype, name,
+                          Some ((BoolConst  (_, l)) as v), loc) :: t
+                | VarDec (ArrayDef (_, _) as vtype, name,
+                          Some ((FloatConst (_, l)) as v), loc) :: t
+                | VarDec (ArrayDef (_, _) as vtype, name,
+                          Some ((IntConst   (_, l)) as v), loc) :: t ->
                     trav inits (VarDec (vtype, name, Some (ArrayScalar (v, l)), loc) :: t)
 
                 | VarDec (ctype, name, init, loc) :: t ->
                     (* array definition: create __allocate statement *)
                     let alloc = match ctype with
-                        | ArrayDef (_, dims) -> [Allocate (name, dims, noloc)]
+                        | ArrayDef (_, dims) -> [Allocate (name, dims, loc)]
                         | _ -> []
                     in
-                    (* variable initialisation: create assign statement *)
-                    let stats = match init with
+                    (* initialisation: create assign statement *)
+                    let add = match init with
                         | Some value -> alloc @ [Assign (name, value, loc)]
                         | None -> alloc
                     in
-                    VarDec (ctype, name, None, loc) :: (trav (inits @ stats) t)
+                    VarDec (ctype, name, None, loc) :: (trav (inits @ add) t)
 
                 (* initialisations need to be placed after local functions *)
                 | (FunDef (_, _, _, _, _, _) as h) :: t ->
@@ -48,7 +51,7 @@ let rec var_init = function
 
     (* Move global initialisations to __init function *)
     | Program (decls, loc) ->
-        let decls = flatten (List.map var_init decls) in
+        let decls = flatten_blocks (List.map var_init decls) in
         let rec trav assigns = function
             | [] -> (assigns, [])
             | (Assign (_, _, _) as h) :: t -> trav (assigns @ [h]) t