Implemented external variables using getters and setters, some general changes & fixes in other phases for compliance

Makefile

@@ -1,6 +1,6 @@
 RESULT := civicc
 PHASES := load parse print desug context_analysis expand_dims typecheck \
-	dim_reduce bool_op
+	dim_reduce bool_op extern_vars
 SOURCES := ast.ml stringify.mli stringify.ml util.mli util.ml lexer.mll \
 	parser.mly $(patsubst %,phases/%.ml,$(PHASES)) main.ml
 PRE_TARGETS := ast.cmi ast.o stringify.cmi stringify.o util.cmi util.o

main.ml

@@ -16,20 +16,20 @@ let compile () =
         Parse.phase;
         (*Print.phase*)
         Desug.phase;
-        (*Print.phase*)
+        Print.phase;
         Context_analysis.phase;
-        (*Print.phase*)
+        Print.phase;
         Typecheck.phase;
         (*Print.phase*)
         Expand_dims.phase;
         (*Print.phase*)
         Bool_op.phase;
-        Print.phase;
-        (*
+        (*Print.phase*)
         Dim_reduce.phase;
         Print.phase;
         Extern_vars.phase;
         Print.phase;
+        (*
         Assemble.phase;
         Print.phase;
         Peephole.phase;

parser.mly

@@ -97,12 +97,6 @@ decl:
     { let loc = loc $startpos(name) $endpos(name) in
       GlobalDef (export, Array (ctype, dims), name, None, loc) }
 
-    | export=boption(EXPORT); ctype=basic_type;
-      LBRACK; dims=separated_list(COMMA, expr); RBRACK;
-      name=ID; ASSIGN; init=expr; SEMICOL
-    { let loc = loc $startpos(name) $endpos(name) in
-      GlobalDef (export, Array (ctype, dims), name, Some init, loc) }
-
 fun_header:
     (* function header: use location of function name *)
     | ret=basic_type; name=ID; LPAREN; params=separated_list(COMMA, param); RPAREN

phases/context_analysis.ml

@@ -57,7 +57,13 @@ let rec analyse scope depth args node =
             add_to_scope (Varname name) node depth scope;
             node
 
-        (* For global vars, only add the name *)
+        (* For global vars, only the name and array dimensions *)
+        | GlobalDec (Array (ctype, dims), name, loc) ->
+            add_to_scope (Varname name) node depth scope;
+            GlobalDec (Array (ctype, List.map collect dims), name, loc)
+        | Dim (name, loc) ->
+            add_to_scope (Varname name) (DimDec node) depth scope;
+            node
         | GlobalDec (_, name, _)
         | GlobalDef (_, _, name, _, _) ->
             add_to_scope (Varname name) node depth scope;
@@ -122,18 +128,15 @@ let rec analyse scope depth args node =
             let body = analyse local_scope (depth + 1) args body in
             FunDef (export, ret_type, name, params, body, loc)
 
-        | Param (Array (_, dims), name, _) as node ->
-            let rec add_dims = function
-                | [] -> ()
-                | Dim (name, _) as dim :: tail ->
-                    add_to_scope (Varname name) (DimDec dim) depth scope;
-                    add_dims tail
-                | _ -> raise InvalidNode
-            in
-            add_dims dims;
+        | Param (Array (ctype, dims), name, loc) as node ->
+            let _ = List.map (traverse scope depth) dims in
             add_to_scope (Varname name) node depth scope;
             node
 
+        | Dim (name, _) as dim ->
+            add_to_scope (Varname name) (DimDec dim) depth scope;
+            node
+
         | Param (_, name, _) ->
             add_to_scope (Varname name) node depth scope;
             node

phases/desug.ml

@@ -8,7 +8,8 @@ let rec var_init = function
         let decls = flatten_blocks (List.map var_init decls) in
         let rec trav assigns = function
             | [] -> (assigns, [])
-            | (Assign _ as h) :: t -> trav (assigns @ [h]) t
+            | (Assign _ as h) :: t
+            | (Allocate _ as h) :: t -> trav (assigns @ [h]) t
             | h :: t ->
                 let (assigns, decls) = trav assigns t in
                 (assigns, (h :: decls))
@@ -21,16 +22,41 @@ let rec var_init = function
                 Program (init_func :: decls, loc)
         )
 
-    (* Move global variable initialisations to exported __init function *)
+    (* Global variable initialisation:
+     * Add an assign statement and the Program node will remove it later on *)
     | GlobalDef (export, ctype, name, Some init, loc) ->
         Block [GlobalDef (export, ctype, name, None, loc);
-               Assign (name, None, init, locof init)]
+               Assign (name, None, init, loc)]
+
+    (* Global array definition:
+     * - Create a new global variable for each dimension and initialise it to
+     *   the given expression
+     * - create __allocate statement in __init *)
+    | GlobalDef (export, Array (ctype, dims), name, None, loc) as dec ->
+        let rec create_dimvars i = function
+            | [] -> []
+            | hd :: tl ->
+                let dimname = name ^ "$" ^ string_of_int i in
+                let var = Var (dimname, loc) in
+                var :: (create_dimvars (i + 1) tl)
+        in
+        let dimvars = create_dimvars 1 dims in
+        let create_globaldef dim = function
+            | Var (dimname, loc) ->
+                var_init (GlobalDef (export, Int, dimname, Some dim, loc))
+            | _ -> raise InvalidNode
+        in
+        let vardecs = List.map2 create_globaldef dims dimvars in
+        let alloc = [Allocate (name, dimvars, dec, loc)] in
+        Block (vardecs @
+               [GlobalDef (export, Array (ctype, dimvars), name, None, loc)] @
+               alloc)
 
     (* Split local variable initialisations in declaration and assignment *)
     | FunDef (export, ret_type, name, params, Block body, loc) ->
         let move_inits body =
             let rec trav inits node = match node with
-                (* translate scalar array initialisation to ArrayScalar node,
+                (* Translate scalar array initialisation to ArrayScalar node,
                  * for easy replacement later on *)
                 | VarDec (Array _ as vtype, name, Some (BoolConst _  as v), loc) :: t
                 | VarDec (Array _ as vtype, name, Some (FloatConst _ as v), loc) :: t

phases/dim_reduce.ml

@@ -6,28 +6,36 @@ let rec multiply = function
     | [node]   -> node
     | hd :: tl -> Binop (Mul, hd, multiply tl, noloc)
 
-let rec expand dims = function
+let rec expand dims depth = function
     | []       -> raise InvalidNode
-    | [node]   -> dim_reduce node
-    | hd :: tl -> let mul = Binop (Mul, dim_reduce hd, (List.hd dims), noloc) in
-                  Binop (Mul, mul, expand (List.tl dims) tl, noloc)
+    | [node]   -> dim_reduce depth node
+    | hd :: tl -> let trav = dim_reduce depth in
+                  let mul = Binop (Mul, trav hd, trav (List.hd dims), noloc) in
+                  Binop (Mul, mul, expand (List.tl dims) depth tl, noloc)
 
-and dim_reduce = function
+and dim_reduce depth = function
     | Allocate (name, dims, dec, loc) ->
         Allocate (name, [multiply dims], dec, loc)
 
+    | FunDef (export, ret_type, name, params, body, loc) ->
+        let trav = dim_reduce (depth + 1) in
+        FunDef (export, ret_type, name, List.map trav params, trav body, loc)
+
+    | Dim (name, loc) ->
+        VarUse (Var (name, loc), Int, depth)
+
     | VarUse (Type (Deref (name, values, loc), t), (Array (_, dims) as ctype), depth) ->
-        let reduced = [expand (List.rev dims) values] in
+        let reduced = [expand (List.rev dims) depth values] in
         VarUse (Type (Deref (name, reduced, loc), t), ctype, depth)
 
     | VarLet (Assign (name, Some values, value, loc), (Array (_, dims) as ctype), depth) ->
-        let reduced = Some [expand (List.rev dims) values] in
-        VarLet (Assign (name, reduced, dim_reduce value, loc), ctype, depth)
+        let reduced = Some [expand (List.rev dims) depth values] in
+        VarLet (Assign (name, reduced, dim_reduce depth value, loc), ctype, depth)
 
-    | node -> transform_children dim_reduce node
+    | node -> transform_children (dim_reduce depth) node
 
 let rec phase input =
     prerr_endline "- Array dimension reduction";
     match input with
-    | Ast node -> Ast (dim_reduce node)
+    | Ast node -> Ast (dim_reduce 0 node)
     | _ -> raise (InvalidInput "dimension reduction")

phases/extern_vars.ml

@@ -0,0 +1,142 @@
+open Ast
+open Util
+
+(* Remove Type nodes temporarily for easy traversal *)
+let rec prune_types = function
+    | Type (node, _) -> prune_types node
+    | node -> transform_children prune_types node
+
+let create_param ctype name =
+    let param = Param (ctype, name, noloc) in
+    let value = VarUse (Var (name, noloc), ctype, 0) in
+    (param, value)
+
+let call node args depth = match node with
+    | FunDec (ctype, name, _, _) as def ->
+        Type (FunUse (FunCall (name, args, noloc), def, depth), ctype)
+    | _ -> raise InvalidNode
+
+let process globals = function
+    | GlobalDef (true, Array (ctype, dims), name, None, loc) ->
+        (* Getters for array variable: crate getter for given index Note that
+         * getters and setters for dimensions are automatically generated,
+         * because they have been put into new global variables during the
+         * desugarin phase *)
+        let (param, index) = create_param Int (fresh_var "index") in
+        let var = Deref (name, [index], noloc) in
+        let body = Block [Return (var, noloc)] in
+        let getter = FunDef (true, ctype, name ^ "$get", [param], body, noloc) in
+
+        (* Setters for array variable: create setter for given index *)
+        let (param1, index) = create_param Int (fresh_var "index") in
+        let (param2, value) = create_param ctype (fresh_var "value") in
+        let body = Block [VarLet (Assign (name, Some [index], value, noloc), ctype, 1)] in
+        let setter = FunDef (true, Void, name ^ "$set", [param1; param2], body, noloc) in
+
+        [getter; setter]
+
+    | GlobalDef (true, ctype, name, None, loc) ->
+        (* Getter for basic variable type: return the variable *)
+        let var = VarUse (Var (name, noloc), ctype, 1) in
+        let body = [Return (var, noloc)] in
+        let getter = FunDef (true, ctype, name ^ "$get", [], Block body, noloc) in
+
+        (* Setter for basic variable type: assign the variable *)
+        let (param, value) = create_param ctype (fresh_var "value") in
+        let body = [VarLet (Assign (name, None, value, noloc), ctype, 1)] in
+        let setter = FunDef (true, Void, name ^ "$set", [param], Block body, noloc) in
+
+        [getter; setter]
+
+    | GlobalDec (Array (ctype, dims), name, loc) ->
+        (* Getters for external array variable: create getter for a given index *)
+        (* Setters for external array variable:
+         * - define setter for a given index
+         * - define setter for each dimension*)
+        let (param, _) = create_param Int "index" in
+        let rec process_dims i = function
+            | [] -> []
+            | Dim (oldname, _) :: tl ->
+                let dimname = name ^ "$" ^ string_of_int i in
+
+                let getter = FunDec (Void, dimname ^ "$get", [], noloc) in
+
+                let (param, _) = create_param ctype "value" in
+                let setter = FunDec (Void, dimname ^ "$set", [param], noloc) in
+
+                Hashtbl.add globals oldname (call getter, call setter);
+                getter :: setter :: (process_dims (i + 1) tl)
+            | _ -> raise InvalidNode
+        in
+
+        let getter = FunDec (ctype, name ^ "$get", [param], noloc) in
+
+        let (param1, index) = create_param Int "index" in
+        let (param2, value) = create_param ctype "value" in
+        let setter = FunDec (Void, name ^ "$set", [param1; param2], noloc) in
+
+        Hashtbl.add globals name (call getter, call setter);
+        getter :: setter :: (process_dims 1 dims)
+
+    (* Getter for basic variable type: return the variable *)
+    | GlobalDec (ctype, name, loc) ->
+        let getter = FunDec (ctype, name ^ "$get", [], noloc) in
+
+        let (param, _) = create_param ctype "value" in
+        let setter = FunDec (Void, name ^ "$set", [param], noloc) in
+
+        Hashtbl.add globals name (call getter, call setter);
+        [getter; setter]
+
+    | _ -> raise InvalidNode
+
+let rec create_funcs globals = function
+    | Program (decls, loc) ->
+        let decls = List.map (create_funcs globals) decls in
+        Program (flatten_blocks (List.map (create_funcs globals) decls), loc)
+
+    | GlobalDef (true, ctype, name, None, loc) as node ->
+        Block (GlobalDef (false, ctype, name, None, loc) ::
+               (process globals node))
+
+    | GlobalDec (ctype, name, loc) as node ->
+        Block (process globals node)
+
+    | node -> transform_children (create_funcs globals) node
+
+let rec replace_vars scope depth = function
+    | (VarDec (_, name, _, _) as node)
+    | (Param (_, name, _) as node)
+            when Hashtbl.mem scope name ->
+        Hashtbl.remove scope name;
+        node
+
+    | FunDef (export, ret_type, name, params, body, loc) ->
+        let local_scope = Hashtbl.copy scope in
+        let trav = replace_vars local_scope (depth + 1) in
+        let params = List.map trav params in
+        FunDef (export, ret_type, name, params, trav body, loc)
+
+    | VarUse (Var (name, loc), _, _) as node when Hashtbl.mem scope name ->
+        let (get, _) = Hashtbl.find scope name in
+        get [] depth
+
+    | VarLet (Assign (name, None, value, _), _, _) when Hashtbl.mem scope name ->
+        let (_, set) = Hashtbl.find scope name in
+        Expr (set [replace_vars scope depth value] depth)
+
+    | VarLet (Assign (name, Some dims, value, _), _, _) when Hashtbl.mem scope name ->
+        let dims = List.map (replace_vars scope depth) dims in
+        let (_, set) = Hashtbl.find scope name in
+        Expr (set (dims @ [replace_vars scope depth value]) depth)
+
+    | node -> transform_children (replace_vars scope depth) node
+
+let rec phase input =
+    prerr_endline "- Create getters and setters for extern variables";
+    match input with
+    | Ast node ->
+        let globals = Hashtbl.create 20 in
+        let node = create_funcs globals (prune_types node) in
+        Ast (replace_vars globals 0 node)
+    | _ -> raise (InvalidInput "extern vars")

phases/typecheck.ml

@@ -195,12 +195,6 @@ let rec typecheck node = match node with
 
     | _ -> transform_children typecheck node
 
-(* Remove any Type nodes from the tree to allow more convenient matching in
- * later phases *)
-(*let rec prune_types = function
-    | Type (node, _) -> prune_types node
-    | node -> transform_children prune_types node*)
-
 let rec phase input =
     prerr_endline "- Type checking";
     match input with

stringify.ml

@@ -50,7 +50,6 @@ and node2str node =
         concat "\n\n" decls
     | Param (param_type, name, _) ->
         (type2str param_type) ^ " " ^ name
-    | Dim (name, _) -> name
     | FunDec (ret_type, name, params, _) ->
         let params = concat ", " params in
         "extern " ^ type2str ret_type ^ " " ^ name ^ "(" ^ params ^ ");"
@@ -116,6 +115,8 @@ and node2str node =
 
     (* Some intermediate nodes print more information at higher verbosity, for
      * debugging purposes *)
+    | Dim (name, _)             when args.verbose >= 3 ->
+        "<dim>(" ^ name ^  ")"
     | ArrayScalar value         when args.verbose >= 3 ->
         "<scalar>(" ^ str value ^ ")"
     | Arg node                  when args.verbose >= 3 ->
@@ -127,6 +128,8 @@ and node2str node =
     | FunUse (value, _, _)      when args.verbose >= 3 ->
         "<use>(" ^ str value ^ ")"
 
+    | Dim (name, _)  -> name
+
     | ArrayScalar node
     | ArrayInit (node, _)
     | Arg node

test/extern_vars.cvc

@@ -0,0 +1,15 @@
+export bool local = true;
+
+export int[10] localarr;
+
+extern float ext;
+
+extern int[n, m] extarr;
+
+export int main() {
+    void localfunc(int n) {
+        m = n;
+    }
+    extarr[2, 3] = n;
+    return 0;
+}

util.ml

@@ -4,10 +4,15 @@ open Ast
 
 (* Logging functions *)
 
+let prt_line = prerr_endline
+
+let prt_node node = prt_line (Stringify.node2str node)
+
 let log_line verbosity line =
-    if args.verbose >= verbosity then prerr_endline line
+    if args.verbose >= verbosity then prt_line line
 
-let log_node verbosity node = log_line verbosity (Stringify.node2str node)
+let log_node verbosity node =
+    if args.verbose >= verbosity then prt_node node
 
 let dbg_line = log_line verbosity_debug
 
@@ -205,7 +210,7 @@ let ctypeof = function
     | Type (_, ctype)
         -> ctype
 
-    | DimDec _ -> Int
+    | Dim _ | DimDec _ -> Int
 
     | _ -> raise InvalidNode
 

util.mli

@@ -1,4 +1,6 @@
 (* Logging functions, they print to stderr and consider the verbosity flag *)
+val prt_line : string -> unit
+val prt_node : Ast.node -> unit
 val log_line : int -> string -> unit
 val log_node : int -> Ast.node -> unit
 val dbg_line : string -> unit