Finished type checking & content analysis

ast.ml

@@ -21,15 +21,14 @@ and node =
 
     (* statements *)
     | VarDec of ctype * string * node option * loc
-    | Assign of string * node * loc
-    | ArrayAssign of string * node list * node * loc
+    | Assign of string * node list option * node * loc
     | Return of node * loc
     | If of node * node * loc
     | IfElse of node * node * node * loc
     | While of node * node * loc
     | DoWhile of node * node * loc
     | For of string * node * node * node * node * loc
-    | Allocate of string * node list * loc
+    | Allocate of string * node list * node * loc
     | Expr of node
     | Block of node list
 

main.ml

@@ -22,9 +22,10 @@ let compile args =
         Print.phase;
         Expand_dims.phase;
         Print.phase;
+        Dim_reduce.phase;
+        Print.phase;
         (*
         Extern_vars.phase;
-        Dim_reduce.phase;
         Print.phase;
         Print.phase;
         Bool_op.phase;

parser.mly

@@ -157,11 +157,11 @@ var_dec:
 statement:
     (* assignment: use location of assigned variable name *)
     | name=ID; ASSIGN; value=expr; SEMICOL
-    { Assign (name, value, loc $startpos(name) $endpos(name)) }
+    { Assign (name, None, value, loc $startpos(name) $endpos(name)) }
 
-    | name=ID; LBRACK; dims=separated_list(COMMA, expr); RBRACK;
+    | name=ID; LBRACK; dims=separated_list(COMMA, expr); brk=RBRACK;
       ASSIGN; value=expr; SEMICOL
-    { ArrayAssign (name, dims, value, loc $startpos(name) $endpos(name)) }
+    { Assign (name, Some dims, value, loc $startpos(name) $endpos(brk)) }
 
     | name=ID; LPAREN; args=separated_list(COMMA, expr); RPAREN; SEMICOL
     { Expr (FunCall (name, make_args args, loc $startpos(name) $endpos(name))) }

phases/context_analysis.ml

@@ -82,9 +82,15 @@ let rec analyse scope depth args node =
 
         (* Assign statements are wrapped in VarLet nodes, which stores the type
          * and depth of the assigned variable are *)
-        | Assign (name, value, loc) ->
+        | Assign (name, None, value, loc) ->
             let (decl, dec_depth) = check_in_scope (Varname name) node scope in
-            let assign = Assign (name, collect value, loc) in
+            let assign = Assign (name, None, collect value, loc) in
+            VarLet (assign, ctypeof decl, depth - dec_depth)
+
+        | Assign (name, Some dims, value, loc) ->
+            let (decl, dec_depth) = check_in_scope (Varname name) node scope in
+            let dims = Some (List.map collect dims) in
+            let assign = Assign (name, dims, collect value, loc) in
             VarLet (assign, ctypeof decl, depth - dec_depth)
 
         | _ -> transform_children collect node

phases/desug.ml

@@ -28,13 +28,13 @@ let for_to_while node =
                 noloc
             ) in
             Block [
-                Assign (_i, start, locof start);
-                Assign (_stop, stop, locof stop);
-                Assign (_step, step, locof step);
+                Assign (_i, None, start, locof start);
+                Assign (_stop, None, stop, locof stop);
+                Assign (_step, None, step, locof step);
                 While (cond, traverse (Block (
                     (* TODO: check for illegal assigments of counter in body *)
                     block_body (replace_var counter _i body) @
-                    [Assign (_i, Binop (Add, vi, vstep, noloc), noloc)]
+                    [Assign (_i, None, Binop (Add, vi, vstep, noloc), noloc)]
                 )), loc);
             ]
 
@@ -49,7 +49,7 @@ 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 -> trav (assigns @ [h]) t
             | h :: t ->
                 let (assigns, decls) = trav assigns t in
                 (assigns, (h :: decls))
@@ -65,7 +65,7 @@ let rec var_init = function
     (* Move global variable initialisations to exported __init function *)
     | GlobalDef (export, ctype, name, Some init, loc) ->
         Block [GlobalDef (export, ctype, name, None, loc);
-               Assign (name, init, locof init)]
+               Assign (name, None, init, locof init)]
 
     (* Split local variable initialisations in declaration and assignment *)
     | FunDef (export, ret_type, name, params, Block body, loc) ->
@@ -81,18 +81,18 @@ let rec var_init = function
                           Some ((IntConst   (_, l)) as v), loc) :: t ->
                     trav inits (VarDec (vtype, name, Some (ArrayScalar (v, l)), loc) :: t)
 
-                | VarDec (ctype, name, init, loc) :: t ->
+                | VarDec (ctype, name, init, loc) as dec :: tl ->
                     (* array definition: create __allocate statement *)
                     let alloc = match ctype with
-                        | ArrayDef (_, dims) -> [Allocate (name, dims, loc)]
+                        | ArrayDef (_, dims) -> [Allocate (name, dims, dec, loc)]
                         | _ -> []
                     in
                     (* initialisation: create assign statement *)
                     let add = match init with
-                        | Some value -> alloc @ [Assign (name, value, loc)]
+                        | Some value -> alloc @ [Assign (name, None, value, loc)]
                         | None -> alloc
                     in
-                    VarDec (ctype, name, None, loc) :: (trav (inits @ add) t)
+                    VarDec (ctype, name, None, loc) :: (trav (inits @ add) tl)
 
                 (* initialisations need to be placed after local functions *)
                 | (FunDef (_, _, _, _, _, _) as h) :: t ->
@@ -115,10 +115,10 @@ let rec var_init = function
 (*
 let rec array_init = function
     (* transform scalar assignment into nested for loops *)
-    | Assign (name, ArrayScalar (value)) ->
+    | Assign (name, None, ArrayScalar (value), loc) ->
         let rec add_loop indices = function
             | [] ->
-                Assign (Deref (name, indices), value)
+                Assign (name, indices, value, loc)
             | dim :: rest ->
                 let counter = fresh_var "counter" in
                 let ind = (indices @ [Var counter]) in
@@ -126,7 +126,7 @@ let rec array_init = function
         in
         add_loop [] dims
 
-    | Assign (name, ArrayConst (dims)) -> Block []
+    | Assign (name, None, ArrayConst (dims), loc) -> Block []
 
     | node -> transform array_init node
 *)

phases/typecheck.ml

@@ -5,19 +5,19 @@ open Stringify
 
 (*
  * Do a number of checks:
- * x A void function must not return a value.
- * x A non-void function must return a value of the correct type.
+ * - A void function must not return a value.
+ * - A non-void function must return a value of the correct type.
  * - Array indices must be of type integer.
  * - The number of array indices must match the number of array dimensions.
- * x The type on the right-hand side of an assignment must match the type on
+ * - The type on the right-hand side of an assignment must match the type on
  *   the left-hand side.
- * x The number of arguments used for a function call must match the number of
+ * - The number of arguments used for a function call must match the number of
  *   parameters for that function.
- * x The types of the function arguments must match the types of parameters.
- * x The operands of a unary or binary operation must have valid types.
- * x The predicate expression of an if, while, or do-while statement must be
+ * - The types of the function arguments must match the types of parameters.
+ * - The operands of a unary or binary operation must have valid types.
+ * - The predicate expression of an if, while, or do-while statement must be
  *   a boolean.
- * x Only values having a basic type can be type cast.
+ * - Only values having a basic type can be type cast.
  *)
 
 let spec = function
@@ -57,6 +57,10 @@ let check_type_op allowed_types desc = function
     | Type _ -> ()
     | _ -> raise InvalidNode
 
+let array_width = function
+    | ArrayDec (_, dims) -> list_size dims
+    | _                  -> raise InvalidNode
+
 let rec typecheck node = match node with
     | BoolConst  (value, _) -> Type (node, Bool)
     | IntConst   (value, _) -> Type (node, Int)
@@ -101,9 +105,26 @@ let rec typecheck node = match node with
         check_type ttype fexpr;
         Type (node, ttype)
 
-    | VarLet (Assign (_, (Type _ as value), _), dec_type, depth) ->
+    | VarLet (Assign (_, None, (Type _ as value), _), dec_type, depth) ->
         check_type dec_type value;
         node
+    | VarLet (Assign (_, Some dims, (Type _ as value), _) as assign, dec_type, depth) ->
+        (* Number of assigned indices must match array definition *)
+        (match (list_size dims, array_width dec_type) with
+        | (got, expected) when got != expected ->
+            let msg =
+                sprintf "dimension mismatch: expected %d indices, got %d"
+                        expected got
+            in
+            raise (NodeError (assign, msg))
+        | _ -> ());
+
+        (* Array indices must be ints *)
+        List.iter (check_type Int) dims;
+
+        (* Assigned value must match array base type *)
+        check_type (base_type dec_type) value;
+        node
     | VarLet (assign, dec_type, depth) ->
         typecheck (VarLet (typecheck assign, dec_type, depth))
 
@@ -113,6 +134,11 @@ let rec typecheck node = match node with
     | TypeCast (ctype, value, loc) ->
         typecheck (TypeCast (ctype, typecheck value, loc))
 
+    | Allocate (name, dims, dec, loc) ->
+        let dims = List.map typecheck dims in
+        List.iter (check_type Int) dims;
+        Allocate (name, dims, dec, loc)
+
     | Return (Type _, _)  -> node
     | Return (value, loc) -> typecheck (Return (typecheck value, loc))
 

stringify.ml

@@ -68,9 +68,9 @@ and node2str node =
         (type2str var_type) ^ " " ^ name ^ ";"
     | VarDec (var_type, name, Some init, _) ->
         (type2str var_type) ^ " " ^ name ^ " = " ^ (str init) ^ ";"
-    | Assign (name, value, _) ->
+    | Assign (name, None, value, _) ->
         name ^ " = " ^ (str value) ^ ";"
-    | ArrayAssign (name, dims, value, _) ->
+    | Assign (name, Some dims, value, _) ->
         name ^ "[" ^ (concat ", " dims) ^ "] = " ^ (str value) ^ ";"
     | Expr expr ->
         str expr ^ ";"
@@ -91,7 +91,7 @@ and node2str node =
         in
         let range = str start ^ ", " ^ str stop ^ step in
         "for (int " ^ counter ^ " = " ^ range ^ ") " ^ str body
-    | Allocate (name, dims, _) ->
+    | Allocate (name, dims, _, _) ->
         name ^ " = __allocate(" ^ concat ", " dims ^ ");"
     | Block body -> "{\n" ^ indent (concat "\n" body) ^ "\n}"
 

util.ml

@@ -39,10 +39,10 @@ let transform_children trav node =
 
     | VarDec (ctype, name, Some init, loc) ->
         VarDec (ctype, name, Some (trav init), loc)
-    | Assign (name, value, loc) ->
-        Assign (name, trav value, loc)
-    | ArrayAssign (name, dims, value, loc) ->
-        ArrayAssign (name, trav_all dims, trav value, loc)
+    | Assign (name, None, value, loc) ->
+        Assign (name, None, trav value, loc)
+    | Assign (name, Some dims, value, loc) ->
+        Assign (name, Some (trav_all dims), trav value, loc)
     | Return (value, loc) ->
         Return (trav value, loc)
     | If (cond, body, loc) ->
@@ -55,6 +55,8 @@ let transform_children trav node =
         DoWhile (trav cond, trav body, loc)
     | For (counter, start, stop, step, body, loc) ->
         For (counter, trav start, trav stop, trav step, trav body, loc)
+    | Allocate (name, dims, dec, loc) ->
+        Allocate (name, trav_all dims, dec, loc)
     | Expr value ->
         Expr (trav value)
     | Block (body) ->
@@ -101,15 +103,14 @@ let rec transform_all trav = function
     | GlobalDec (_, _, loc)
     | GlobalDef (_, _, _, _, loc)
     | VarDec (_, _, _, loc)
-    | Assign (_, _, loc)
-    | ArrayAssign (_, _, _, loc)
+    | Assign (_, _, _, loc)
     | Return (_, loc)
     | If (_, _, loc)
     | IfElse (_, _, _, loc)
     | While (_, _, loc)
     | DoWhile (_, _, loc)
     | For (_, _, _, _, _, loc)
-    | Allocate (_, _, loc)
+    | Allocate (_, _, _, loc)
     | BoolConst (_, loc)
     | IntConst (_, loc)
     | FloatConst (_, loc)
@@ -197,3 +198,8 @@ let block_body = function
 let rec list_size = function
     | [] -> 0
     | hd :: tl -> 1 + (list_size tl)
+
+let base_type = function
+    | ArrayDec (ctype, _)
+    | ArrayDef (ctype, _)
+    | ctype -> ctype

util.mli

@@ -32,3 +32,6 @@ val block_body : Ast.node -> Ast.node list
 
 (* Get the size of a list by traversing it recurcively *)
 val list_size : 'a list -> int
+
+(* Get the basic type of a ctype, removing array dimensions *)
+val base_type : Ast.ctype -> Ast.ctype