Re-introduced DimDec node to get array dimension declarations to work properly, and rewrote a bunch of code to make it actually work...

README.md

@@ -10,3 +10,5 @@ Issues & TODO
 - Keep file content in buffer to prevent error messages from crashing when
   reading from stdin.
 - Documentation for each phase, in ocamldoc format.
+- Create automated testsuite runner.
+- Assembly printer should print optimized instructions.

main.ml

@@ -46,7 +46,7 @@ let compile () =
             let output = if cond () then (
                 log_plain_line 1 (expand 13 ("- " ^ id ^ ":") ^ msg);
                 let output = phase input in
-                if id = args.endphase || args.verbose = 2 then (
+                if id = args.endphase || args.verbose >= 2 then (
                     let _ = Print.phase output in ()
                 );
                 output

phases/assemble.ml

@@ -55,6 +55,8 @@ let assemble program =
 
         | VarDec (_, name, _, _) ->
             [comline (sprintf "local var \"%s\" at index %d" name (indexof node))]
+        | DimDec (name, _, _) ->
+            [comline (sprintf "local dim \"%s\" at index %d" name (indexof node))]
 
         | LocalFuns _ -> []
 
@@ -221,7 +223,7 @@ let assemble program =
                 | (a, b) when a = b -> Load (typeof dec, Current,     indexof dec)
                 | (a, b)            -> Load (typeof dec, Rel (b - a), indexof dec)
             in
-            (trav_all dims) @                     (* push dimensions *)
+            (trav_all (List.rev dims)) @          (* push dimensions *)
             [InlineComment (load, nameof dec)] @  (* push array reference *)
             [InlineComment (LoadArray (basetypeof dec), node2str node)]
 

phases/constant_propagation.ml

@@ -159,7 +159,8 @@ let rec propagate consts node =
     | _ -> transform_children propagate node
 
 let rec prune_vardecs consts = function
-    | VarDec (ctype, name, init, ann) when Hashtbl.mem consts name -> DummyNode
+    | VarDec (_, name, _, _) when Hashtbl.mem consts name -> DummyNode
+    | DimDec (name, _, _) when Hashtbl.mem consts name -> DummyNode
     | node -> transform_children (prune_vardecs consts) node
 
 let phase = function

phases/context_analysis.ml

@@ -47,11 +47,13 @@ let rec analyse scope depth node =
     let rec collect node = match node with
         (* Add node reference for this varname to vars map *)
         | VarDec (ctype, name, init, ann) ->
-            let node = match init with
-                | Some value -> VarDec (ctype, name, Some (collect value),
-                                        Depth depth :: ann)
-                | None -> VarDec (ctype, name, init, Depth depth :: ann)
-            in
+            (* Traverse Dim nodes *)
+            let node = VarDec (ctype, name, init, Depth depth :: ann) in
+            add_to_scope (Varname name) node depth scope;
+            node
+
+        | DimDec (name, init, ann) ->
+            let node = DimDec (name, init, Depth depth :: ann) in
             add_to_scope (Varname name) node depth scope;
             node
 
@@ -65,11 +67,6 @@ let rec analyse scope depth node =
             add_to_scope (Varname name) node depth scope;
             node
 
-        | Dim (name, ann) ->
-            let node = Dim (name, Depth depth :: ann) in
-            add_to_scope (Varname name) node depth scope;
-            node
-
         | GlobalDef (export, ctype, name, init, ann) ->
             let ctype = match ctype with
                 | Array (ctype, dims) -> Array (ctype, List.map collect dims)
@@ -80,13 +77,9 @@ let rec analyse scope depth node =
             node
 
         (* Functions are traversed later on, for now only add the name *)
-        | FunDec (ret_type, name, params, ann) ->
-            let node = FunDec (ret_type, name, params, Depth depth :: ann) in
-            add_to_scope (Funcname name) node depth scope;
-            node
-
-        | FunDef (export, ret_type, name, params, body, ann) ->
-            let node = FunDef (export, ret_type, name, params, body, Depth depth :: ann) in
+        | FunDec (_, name, _, _)
+        | FunDef (_, _, name, _, _, _) ->
+            let node = annotate (Depth depth) node in
             add_to_scope (Funcname name) node depth scope;
             node
 
@@ -123,16 +116,18 @@ let rec analyse scope depth node =
             let body = analyse local_scope (depth + 1) body in
             FunDef (export, ret_type, name, params, body, ann)
 
-        | Param (Array (ctype, dims), name, ann) as node ->
-            let _ = List.map (traverse scope depth) dims in
+        | Param (Array (ctype, dims), name, ann) ->
+            let dims = List.map (traverse scope depth) dims in
+            let node = Param (Array (ctype, dims), name, ann) in
             add_to_scope (Varname name) node depth scope;
             node
 
-        | Dim (name, _) as dim ->
-            add_to_scope (Varname name) dim depth scope;
-            node
+        (* Prevent Dim nodes from VarDec types from being added twice *)
+        | DimDec _ -> node
 
+        | Dim (name, _)  (* Dim nodes as children of Param nodes *)
         | Param (_, name, _) ->
+            let node = annotate (Depth depth) node in
             add_to_scope (Varname name) node depth scope;
             node
 

phases/desug.ml

@@ -70,7 +70,11 @@ let rec var_init = function
             | VarDec (ctype, name, init, ann) as dec ->
                 (* array definition: create __allocate statement *)
                 let alloc = match ctype with
-                    | Array (_, dims) -> [Allocate (dec, dims, ann)]
+                    | Array (_, dims) ->
+                        let create_dimvar = function
+                            | Dim (name, _) -> Var (name, None, [])
+                            | _ -> raise InvalidNode
+                        in [Allocate (dec, List.map create_dimvar dims, ann)]
                     | _ -> []
                 in
                 (* initialisation: create assign statement *)
@@ -81,6 +85,11 @@ let rec var_init = function
                 inits := !inits @ add;
                 VarDec (ctype, name, None, ann)
 
+            | DimDec (name, Some init, ann) ->
+                (* dimension initialisation: create assign statement *)
+                inits := !inits @ [Assign (name, None, init, ann)];
+                DimDec (name, None, ann)
+
             | LocalFuns funs -> LocalFuns (List.map var_init funs)
 
             | node -> transform_children extract_inits node
@@ -218,38 +227,36 @@ let rec array_init = function
  * }
  *
  * This behaviour is of course incorrect. To avoid dim() from being evaluated
- * twice, the snippet above is transformed into (note the $$ which will help
- * later during constant propagation):
+ * twice, the snippet above is transformed into the following code: (note the $$
+ * which will help later during constant propagation)
  * void foo() {
- *    int a$dim$$1 = 10;
- *    int a$dim$$2 = dim();
  *    int[a$dim$$1, a$dim$$2] arr;
+ *    a$dim$$1 = 10;
+ *    a$dim$$2 = dim();
  *    arr[1, 2] = 1;
  * }
  *
- * ... which then becomes:
+ * ... which later becomes:
  * void foo() {
- *    int a$dim$$1;
- *    int a$dim$$2;
  *    int[a$dim$$1, a$dim$$2] arr;
- *    a$dim$1 = 10;
- *    a$dim$2 = dim();
- *    arr = __allocate(a$dim$1 * a$dim$2);
+ *    a$dim$$1 = 10;
+ *    a$dim$$2 = dim();
+ *    arr = __allocate(a$dim$$1 * a$dim$$2);
  *    arr[1 * a$dim$2 * 0] = 1;
  * }
  * *)
 let rec array_dims = function
-    | VarDec (Array (ctype, dims), name, init, ann) ->
+    | VarDec (Array (ctype, values), name, init, ann) ->
         let make_dimname i _ = name ^ "$dim$$" ^ string_of_int (i + 1) in
-        let dimnames = mapi make_dimname dims in
+        let dimnames = mapi make_dimname values in
 
-        let make_dimvar d n = Var (n, None, annof d) in
-        let dimvars = List.map2 make_dimvar dims dimnames in
+        let make_dimvar value name = Dim (name, annof value) in
+        let dims = List.map2 make_dimvar values dimnames in
 
-        let make_dimdec dimname dim = VarDec (Int, dimname, Some dim, []) in
-        let dimdecs = List.map2 make_dimdec dimnames dims in
+        let make_dimdec name value = DimDec (name, Some value, annof value) in
+        let dimdecs = List.map2 make_dimdec dimnames values in
 
-        Block (dimdecs @ [VarDec (Array (ctype, dimvars), name, init, ann)])
+        Block (dimdecs @ [VarDec (Array (ctype, dims), name, init, ann)])
 
     | node -> transform_children array_dims node
 

phases/dim_reduce.ml

@@ -39,7 +39,7 @@ and dim_reduce depth = function
     | node -> transform_children (dim_reduce depth) node
 
 let rec simplify_decs = function
-    | VarDec (Array (ctype, dims), name, init, ann) ->
+    | VarDec (Array (ctype, dims), name, init, ann) as node ->
         VarDec (FlatArray ctype, name, init, ann)
 
     | Param (Array (ctype, dims), name, ann) ->

phases/index_analysis.ml

@@ -28,7 +28,7 @@ let tag_index program =
             (* Traverse own function body first *)
             let params = List.map trav params in
             let body = trav body in
-            let ann = Index !stacklen :: ann in
+            let ann = Index (!stacklen - List.length params) :: ann in
 
             (* Traverse local functions after the function body *)
             let body = trav_localfuns trav body in
@@ -37,7 +37,7 @@ let tag_index program =
 
         | LocalFuns _ -> node
 
-        | VarDec _ | Dim _ ->
+        | VarDec _ | DimDec _ | Param _ | Dim _ ->
             let index = !stacklen in
             stacklen := !stacklen + 1;
             annotate (Index index) (transform_children trav node)

phases/print.ml

@@ -43,7 +43,7 @@ let suffix = function
 
 let rtn_suffix = function
     | ExternFun index        -> "e " ^ si index
-    | LocalFun (size, label) -> " " ^ si size ^ label
+    | LocalFun (size, label) -> " " ^ si size ^ " " ^ label
 
 let rec instr2str = function
     (* Global / directives *)

stringify.ml

@@ -24,7 +24,8 @@ let nameof = function
     | FunDef (_, _, name, _, _, _)
     | VarDec (_, name, _, _)
     | Param (_, name, _)
-    | Dim (name, _) -> name
+    | Dim (name, _)
+    | DimDec (name, _, _) -> name
     | _ -> raise InvalidNode
 
 (* operator -> string *)
@@ -88,7 +89,7 @@ and node2str node =
     | VarDec (var_type, name, None, _) ->
         (type2str var_type) ^ " " ^ name ^ ";"
     | VarDec (var_type, name, Some init, _) ->
-        (type2str var_type) ^ " " ^ name ^ " = " ^ (str init) ^ ";"
+        (type2str var_type) ^ " " ^ name ^ " = " ^ str init ^ ";"
     | Assign (name, None, value, _) ->
         name ^ " = " ^ (str value) ^ ";"
     | Assign (name, Some dims, value, _) ->
@@ -149,6 +150,15 @@ and node2str node =
         "<scalar:" ^ str value ^ ">"
     | Arg node                     when args.verbose >= 3 ->
         "<arg:" ^ str node ^ ">"
+    | DimDec (name, None, _)       when args.verbose >= 3 ->
+        type2str Int ^ " <dim:" ^ name ^ ">;"
+    | DimDec (name, Some init, _)  when args.verbose >= 3 ->
+        type2str Int ^ " <dim:" ^ name ^ "> = " ^ str init ^ ";"
+
+    | DimDec (name, None, _) ->
+        type2str Int ^ " " ^ name ^ ";"
+    | DimDec (name, Some init, _) ->
+        type2str Int ^ " " ^ name ^ " = " ^ str init ^ ";"
 
     | VarLet (dec, dims, value, _) ->
         node2str (Assign (nameof dec, dims, value, []))

types.ml

@@ -72,6 +72,7 @@ and node =
     | ArrayScalar of node                      (* (Bool|Int|Float)Const *)
     | ArrayInit of node * ctype                (* Array(Scalar|Const) * dimensions *)
     | Cond of node * node * node * ann         (* cond, true_expr, false_expr *)
+    | DimDec of string * node option * ann
     | DummyNode                                (* null node, pruned by traversals *)
 
 type stack_scope = Glob | Local | Rel of int | Current

util.ml

@@ -90,6 +90,11 @@ let transform_children trav node =
     | GlobalDef (export, ctype, name, Some init, ann) ->
         GlobalDef (export, ctype, name, Some (trav init), ann)
 
+    | VarDecs decs ->
+        VarDecs (trav_all decs)
+    | LocalFuns funs ->
+        LocalFuns (trav_all funs)
+
     | VarDec (ctype, name, Some init, ann) ->
         VarDec (ctype, name, Some (trav init), ann)
     | Assign (name, None, value, ann) ->
@@ -142,11 +147,8 @@ let transform_children trav node =
         VarUse (dec, Some (trav_all dims), ann)
     | FunUse (dec, params, ann) ->
         FunUse (dec, trav_all params, ann)
-
-    | VarDecs decs ->
-        VarDecs (trav_all decs)
-    | LocalFuns funs ->
-        LocalFuns (trav_all funs)
+    | DimDec (name, Some init, ann) ->
+        DimDec (name, Some (trav init), ann)
 
     | _ -> node
 
@@ -211,6 +213,8 @@ let annotate a = function
         Param (ctype, name, a :: ann)
     | Dim (name, ann) ->
         Dim (name, a :: ann)
+    | DimDec (name, init, ann) ->
+        DimDec (name, init, a :: ann)
 
     | _ -> raise InvalidNode
 
@@ -243,7 +247,8 @@ let rec annof = function
     | TypeCast (_, _, ann)
     | VarUse (_, _, ann)
     | FunUse (_, _, ann)
-    | FunCall (_, _, ann) -> ann
+    | FunCall (_, _, ann)
+    | DimDec (_, _, ann) -> ann
 
     | ArrayInit (value, _)
     | ArrayScalar value
@@ -290,6 +295,10 @@ let typeof = function
     | TypeCast (ctype, _, _)
         -> ctype
 
+    (* Dim nodes are always type Int, and are copied by context analysis before
+     * they are annotated with Type Int, so this match is necessary *)
+    | DimDec _ | Dim _ -> Int
+
     (* Other nodes must be annotated during typechecking *)
     | node ->
         let rec trav = function
@@ -399,7 +408,8 @@ let nameof = function
     | FunDef (_, _, name, _, _, _)
     | VarDec (_, name, _, _)
     | Param (_, name, _)
-    | Dim (name, _) -> name
+    | Dim (name, _)
+    | DimDec (name, _, _) -> name
     | _ -> raise InvalidNode
 
 let optmap f = function