Generalized error printing and applied it in context analysis

ast.ml

@@ -45,6 +45,8 @@ and node =
     | TypeCast of ctype * node * loc
     | FunCall of string * node list * loc
 
+    | Type of ctype
+
 (* container for command-line arguments *)
 type args = {
     mutable infile : string option;
@@ -64,6 +66,8 @@ type intermediate =
 exception LocError of loc * string
 exception NodeError of node * string
 exception CompileError of string
+exception EmptyError
+
 exception InvalidNode
 exception InvalidInput of string
 

main.ml

@@ -1,6 +1,7 @@
-open Lexing
 open Printf
+open Lexing
 open Ast
+open Util
 
 (* Compile CVC file to assembly code
  * in_channel -> int -> repr *)
@@ -11,13 +12,13 @@ let compile args =
     in
     run_phases (Args args) [
         Load.phase;
-        (*Print.phase;*)
+        Print.phase;
         Parse.phase;
         Print.phase;
         Desug.phase;
         Print.phase;
-        (*
         Context_analysis.phase;
+        (*
         Print.phase;
         Typecheck.phase;
         Extern_vars.phase;
@@ -29,40 +30,6 @@ let compile args =
         *)
     ]
 
-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 () =
@@ -99,7 +66,9 @@ let main () =
         eprintf "Error: %s\n" msg;
         1
     | LocError (loc, msg) ->
-        print_fancy_error msg loc args.verbose;
+        prerr_loc_msg loc ("Error: " ^ msg) args.verbose;
+        1
+    | EmptyError ->
         1
 
 let _ = exit (main ())

phases/context_analysis.ml

@@ -4,17 +4,23 @@ open Util
 
 module StrMap = Map.Make (String)
 
-let analyse_context node =
+let analyse_context args node =
     let scope = ref StrMap.empty in
     let add_to_scope name decl depth desc =
-        if StrMap.mem name !scope then(
-            raise (NodeError (!decl, sprintf "cannot redeclare %s \"%s\"" desc name))
+        if StrMap.mem name !scope then (
+            let msg = sprintf "Error: cannot redeclare %s \"%s\"" desc name in
+            prerr_loc_msg (locof !decl) msg args.verbose;
+
+            let (orig, _) = StrMap.find name !scope in
+            prerr_loc_msg (locof !orig) "Previously declared here:" args.verbose;
+
+            raise EmptyError
         ) else
             scope := StrMap.add name (decl, depth) !scope
     in
-    let rec analyse depth = function
+    let rec analyse depth node = match node with
         (* Add node reference for this varname to vars map *)
-        | VarDec (ctype, name, init, loc) as node ->
+        | VarDec (ctype, name, init, loc) ->
             let node = match init with
                 | Some value ->
                     let value = analyse depth value in
@@ -26,25 +32,29 @@ let analyse_context node =
 
         (* For a variable, look for its declaration in the current scope and
          * save a reference with the relative nesting depth *)
-        | Var (name, _) as node ->
+        | Var (name, _) ->
             if StrMap.mem name !scope then
                 let (decl, decl_depth) = StrMap.find name !scope in
                 VarUse (node, decl, depth - decl_depth)
             else
                 raise (NodeError (node, (sprintf "undefined variable \"%s\"" name)))
 
-        (*
         (* Increase nesting level when entering function *)
-        | FunDef (export, ret_type, name, params, body, loc) as node ->
-            let vars = StrMap.add name (ref node) vars in
-            let inctrav vars = function
-                | [] -> []
-                | h :: t -> analyse vars h :: (inctrav vars
-            in
-            let body = inc_trav body
-            let body = List.map (analyse vars) body in
-            FunDef (export, ret_type, name, params, body, loc) as node ->
-        *)
+        | FunDef (export, ret_type, name, params, body, loc) ->
+            add_to_scope name (ref node) depth "function";
+            let params = List.map (analyse (depth + 1)) params in
+            let body = analyse (depth + 1) body in
+            FunDef (export, ret_type, name, params, body, loc)
+
+        | Param (ArrayDec (_, dims) as atype, name, _) as node ->
+            let add dim = add_to_scope dim (ref (Type atype)) depth "variable" in
+            List.iter add dims;
+            add_to_scope name (ref node) depth "variable";
+            node
+
+        | Param (_, name, _) ->
+            add_to_scope name (ref node) depth "variable";
+            node
 
         | node -> transform_children (analyse depth) node
     in
@@ -54,5 +64,5 @@ let rec phase input =
     prerr_endline "- Context analysis";
     match input with
     | Ast (node, args) ->
-        Ast (analyse_context node, args)
+        Ast (analyse_context args node, args)
     | _ -> raise (InvalidInput "context analysis")

phases/desug.ml

@@ -63,13 +63,13 @@ let rec var_init = function
                 let (assigns, decls) = trav assigns t in
                 (assigns, (h :: decls))
         in
-        let (assigns, decls) = trav [] decls in
-        (match assigns with
+        let (assigns, decls) = trav [] decls in (
+            match assigns with
             | [] -> Program (decls, loc)
             | assigns ->
                 let init_func = FunDef (true, Void, "__init", [], Block assigns, noloc) in
                 Program (init_func :: decls, loc)
-            )
+        )
 
     (* Move global variable initialisations to exported __init function *)
     | GlobalDef (export, ctype, name, Some init, loc) ->

test/scope.cvc

@@ -1,5 +1,3 @@
-#include "civic.h"
-
-void foo() {
-    foo = bar;
+int foobar() {
+    int foobar;
 }

test/test.cvc

@@ -1,4 +1,4 @@
-extern void printInt(int i);
+#include "civic.h"
 
 export int glob = 0;
 

util.ml

@@ -1,3 +1,4 @@
+open Printf
 open Lexing
 open Ast
 
@@ -101,11 +102,45 @@ let transform_children trav node =
     | Binop (_, _, _, loc)
     | Cond (_, _, _, loc)
     | TypeCast (_, _, loc)
-    | FunCall (_, _, loc)
-        -> loc
+    | FunCall (_, _, loc) -> loc
 
-    | Expr value
-    | VarUse (value, _, _)
-        -> locof value
+    | Expr value | VarUse (value, _, _) -> locof value
 
-    | Block _ -> noloc
+    | Block _ | Type _ -> noloc
+
+let prerr_loc (fname, ystart, yend, xstart, xend) =
+    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;
+    ()
+
+let prerr_loc_msg loc msg 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 "%s\n" msg;
+
+    if verbose >= 2 then prerr_loc loc;
+    ()

util.mli

@@ -11,3 +11,9 @@ val transform_children : (Ast.node -> Ast.node) -> Ast.node -> Ast.node
 
 (* Extract location from node *)
 val locof : Ast.node -> Ast.loc
+
+(* Print file location to stderr *)
+val prerr_loc : Ast.loc -> unit
+
+(* Print file location to stderr *)
+val prerr_loc_msg : Ast.loc -> string -> int -> unit