Implemented array dims expansion correctly (probably), more bugfixes

Makefile

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

README.md

@@ -8,3 +8,4 @@ Issues & TODO
 -------------
 
 - Check for illegal assigments of loop counter in for-loop body.
+- Array initializations (scalar and array constant).

ast.ml

@@ -8,6 +8,7 @@ type operator = Neg | Not
 type ctype = Void | Bool | Int | Float
            | ArrayDec of ctype * node list
            | ArrayDef of ctype * node list
+           | ArraySpec of ctype * int
 and node =
     (* global *)
     | Program of node list * loc
@@ -47,9 +48,9 @@ and node =
     | Arg of node
 
     (* additional types for convenience in traversals *)
-    | VarLet of node * node * ctype * int
+    | VarLet of node * ctype * int
     | VarUse of node * ctype * int
-    | FunUse of node * ctype * int
+    | FunUse of node * node * int
     | DimDec of node
     | Type of node * ctype
     | DummyNode

main.ml

@@ -19,6 +19,9 @@ let compile args =
         Print.phase;
         Context_analysis.phase;
         Typecheck.phase;
+        Print.phase;
+        Expand_dims.phase;
+        Print.phase;
         (*
         Extern_vars.phase;
         Dim_reduce.phase;
@@ -63,7 +66,7 @@ let main () =
         | InvalidInput name ->
             raise (CompileError ("invalid input for phase \"" ^ name ^ "\""))
         | NodeError (node, msg) ->
-            raise (LocError (Util.locof node, msg))
+            raise (LocError (locof node, msg))
     with
     | CompileError msg ->
         eprintf "Error: %s\n" msg;

parser.mly

@@ -14,6 +14,10 @@
     let rec make_dims dimloc = function
         | [] -> []
         | dim :: tail -> Dim (dim, dimloc) :: (make_dims dimloc tail)
+
+    let rec make_args = function
+        | [] -> []
+        | h::t -> Arg h :: (make_args t)
 %}
 
 (* Tokens *)
@@ -156,8 +160,7 @@ statement:
     { Assign (name, value, loc $startpos(name) $endpos(name)) }
 
     | name=ID; LPAREN; args=separated_list(COMMA, expr); RPAREN; SEMICOL
-    { let rec make_args = function [] -> [] | h::t -> Arg h :: (make_args t) in
-      Expr (FunCall (name, make_args args, loc $startpos(name) $endpos(name))) }
+    { Expr (FunCall (name, make_args args, loc $startpos(name) $endpos(name))) }
 
     (* if-statements and (do-)while-loops: use location of condition *)
     | IF; LPAREN; cond=expr; RPAREN; body=block
@@ -189,7 +192,7 @@ block:
 
 expr:
     | name=ID; LPAREN; args=separated_list(COMMA, expr); RPAREN
-    { FunCall (name, args, loc $startpos $endpos) }
+    { FunCall (name, make_args args, loc $startpos $endpos) }
 
     | LPAREN; expr; RPAREN              { $2 }
     | ID                                { Var ($1, loc $startpos $endpos) }

phases/context_analysis.ml

@@ -84,7 +84,8 @@ let rec analyse scope depth args node =
          * and depth of the assigned variable are *)
         | Assign (name, value, loc) ->
             let (decl, dec_depth) = check_in_scope (Varname name) node scope in
-            VarLet (node, collect value, ctypeof decl, depth - dec_depth)
+            let assign = Assign (name, collect value, loc) in
+            VarLet (assign, ctypeof decl, depth - dec_depth)
 
         | _ -> transform_children collect node
     in

phases/dim_reduce.ml

@@ -1,63 +1,11 @@
 open Ast
 open Util
 
-let rec expand_dims = function
-    (* Flatten Block nodes returned by transformations below*)
-    | FunDef (export, ret_type, name, params, body, loc) as node ->
-        let params = flatten_blocks (List.map expand_dims params) in
-        FunDef (export, ret_type, name, params, expand_dims body, loc)
-
-    | FunDec (ret_type, name, params, loc) ->
-        let params = flatten_blocks (List.map expand_dims params) in
-        FunDec (ret_type, name, params, loc)
-
-    | FunCall (name, args, loc) as node ->
-        FunCall (name, flatten_blocks (List.map expand_dims args), loc)
-
-    (* Add additional parameters for array dimensions *)
-    | Param (ArrayDec (_, dims), name, _) as node ->
-        let rec do_expand = function
-            | [] -> [node]
-            | Dim (name, loc) :: tail ->
-                Param (Int, name, loc) :: (do_expand tail)
-            | _ -> raise InvalidNode
-        in
-        Block (do_expand dims)
-
-    (* Add additional function arguments for array dimensions *)
-    | Arg (VarUse (_, ArrayDec (_, dims), _)) as node ->
-        let rec do_expand = function
-            | [] -> [node]
-            | Dim (name, _) :: tail ->
-                Var (name, noloc) :: (do_expand tail)
-            | _ -> raise InvalidNode
-        in
-        Block (do_expand dims)
-
-    | node -> transform_children expand_dims node
-
-(*
-let rec array_init = function
-    (* transform scalar assignment into nested for loops *)
-    | Assign (name, ArrayScalar (value)) ->
-        let rec add_loop indices = function
-            | [] ->
-                Assign (Deref (name, indices), value)
-            | dim :: rest ->
-                let counter = fresh_var "counter" in
-                let ind = (indices @ [Var counter]) in
-                For (counter, IntConst 0, dim, IntConst 1, add_loop ind rest)
-        in
-        add_loop [] dims
-
-    | Assign (name, ArrayConst (dims)) -> Block []
-
-    | node -> transform array_init node
-*)
+let rec dim_reduce = function
+    | node -> transform_children dim_reduce node
 
 let rec phase input =
     prerr_endline "- Array dimension reduction";
     match input with
-    | Ast (node, args) ->
-        Ast (expand_dims node, args)
+    | Ast (node, args) -> Ast (dim_reduce node, args)
     | _ -> raise (InvalidInput "dimension reduction")

phases/expand_dims.ml

@@ -0,0 +1,49 @@
+open Ast
+open Util
+
+let rec expand_dims = function
+    (* Flatten Block nodes returned by transformations below *)
+    | FunDef (export, ret_type, name, params, body, loc) ->
+        let params = flatten_blocks (List.map expand_dims params) in
+        FunDef (export, ret_type, name, params, expand_dims body, loc)
+
+    | FunDec (ret_type, name, params, loc) ->
+        let params = flatten_blocks (List.map expand_dims params) in
+        FunDec (ret_type, name, params, loc)
+
+    | FunUse (funcall, fundef, depth) ->
+        FunUse (expand_dims funcall, expand_dims fundef, depth)
+
+    | FunCall (name, args, loc) ->
+        FunCall (name, flatten_blocks (List.map expand_dims args), loc)
+
+    (* Add additional parameters for array dimensions *)
+    | Param (ArrayDec (ctype, dims), name, loc) ->
+        let rec do_expand = function
+            | [] ->
+                [Param (ArraySpec (ctype, list_size dims), name, loc)]
+            | Dim (name, loc) :: tail ->
+                Param (Int, name, loc) :: (do_expand tail)
+            | _ -> raise InvalidNode
+        in
+        Block (do_expand dims)
+
+    (* Add additional function arguments for array dimensions *)
+    | Arg (VarUse (var, ArrayDec (ctype, dims), depth)) ->
+        let rec do_expand = function
+            | [] ->
+                let spec = ArraySpec (ctype, list_size dims) in
+                [Arg (VarUse (var, spec, depth))]
+            | Dim (name, _) :: tl ->
+                Arg (VarUse (Var (name, noloc), Int, depth)) :: (do_expand tl)
+            | _ -> raise InvalidNode
+        in
+        Block (do_expand dims)
+
+    | node -> transform_children expand_dims node
+
+let rec phase input =
+    prerr_endline "- Expand array dimensions";
+    match input with
+    | Ast (node, args) -> Ast (expand_dims node, args)
+    | _ -> raise (InvalidInput "expand dimensions")

phases/typecheck.ml

@@ -11,20 +11,25 @@ open Stringify
  * - 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 left-hand side.
- * - The number of arguments used for a function call must match the number of
+ * x The number of arguments used for a function call must match the number of
  *   parameters for that function.
- * - The types of the function arguments must match the types of parameters.
+ * 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
  *   a boolean.
  * x Only values having a basic type can be type cast.
  *)
 
+let spec = function
+    | ArrayDec (ctype, dims) -> ArraySpec (ctype, list_size dims)
+    | ctype                  -> ctype
+
 let check_type ?(msg="") expected = function
-    | Type (node, got) when got != expected ->
+    | Type (node, got) when (spec got) <> (spec expected) ->
         let msg = match msg with
             | "" -> sprintf "expected type %s, got %s"
                             (type2str expected) (type2str got)
+                            (*(type2str (spec expected)) (type2str (spec got))*)
             | _ -> msg
         in
         raise (NodeError (node, msg))
@@ -53,11 +58,29 @@ let check_type_op allowed_types desc = function
     | _ -> raise InvalidNode
 
 let rec typecheck node = match node with
-    | BoolConst (value, _)    -> Type (node, Bool)
-    | IntConst (value, _)     -> Type (node, Int)
-    | FloatConst (value, _)   -> Type (node, Float)
-    | VarUse (_, ctype, _)    -> Type (node, ctype)
-    | FunUse (_, ret_type, _) -> Type (node, ret_type)
+    | BoolConst  (value, _) -> Type (node, Bool)
+    | IntConst   (value, _) -> Type (node, Int)
+    | FloatConst (value, _) -> Type (node, Float)
+    | VarUse (_, ctype, _)  -> Type (node, ctype)
+
+    | FunUse (FunCall (_, args, _), FunDef (_, ftype, name, params, _, _), _) ->
+        (match (list_size args, list_size params) with
+        | (nargs, nparams) when nargs != nparams ->
+            let msg =
+                sprintf "function \"%s\" expects %d arguments, got %d"
+                        name nparams nargs
+            in
+            raise (NodeError (node, msg))
+        | _ ->
+            let check_arg_type arg param =
+                check_type (ctypeof param) (typecheck arg);
+            in
+            List.iter2 check_arg_type args params;
+            Type (node, ftype)
+        )
+
+    | Arg (Type (_, vtype)) -> Type (node, vtype)
+    | Arg value             -> typecheck (Arg (typecheck value))
 
     | Monop (op, (Type (_, vtype) as value), _) ->
         let desc = sprintf "unary operator \"%s\"" (op2str op) in
@@ -78,11 +101,11 @@ let rec typecheck node = match node with
         check_type ttype fexpr;
         Type (node, ttype)
 
-    | VarLet (_, (Type (_, vtype) as value), dec_type, depth) ->
+    | VarLet (Assign (_, (Type _ as value), _), dec_type, depth) ->
         check_type dec_type value;
-        Type (node, vtype)
-    | VarLet (assign, value, dec_type, depth) ->
-        typecheck (VarLet (assign, typecheck value, dec_type, depth))
+        node
+    | VarLet (assign, dec_type, depth) ->
+        typecheck (VarLet (typecheck assign, dec_type, depth))
 
     | TypeCast (ctype, (Type _ as value), loc) ->
         check_type_op [Bool; Int; Float] "typecast" value;
@@ -90,10 +113,8 @@ let rec typecheck node = match node with
     | TypeCast (ctype, value, loc) ->
         typecheck (TypeCast (ctype, typecheck value, loc))
 
-    | Return (Type _, _) ->
-        node
-    | Return (value, loc) ->
-        typecheck (Return (typecheck value, loc))
+    | Return (Type _, _)  -> node
+    | Return (value, loc) -> typecheck (Return (typecheck value, loc))
 
     | FunDef (export, ret_type, name, params, body, loc) ->
         let params = transform_all typecheck params in

stringify.ml

@@ -25,12 +25,13 @@ let op2str = function
 
 (* ctype -> string *)
 let rec type2str = function
-    | Void -> "void"
-    | Bool -> "bool"
-    | Int -> "int"
+    | Void  -> "void"
+    | Bool  -> "bool"
+    | Int   -> "int"
     | Float -> "float"
     | ArrayDec (t, dims)
-    | ArrayDef (t, dims) -> (type2str t) ^ "[" ^ (concat ", " dims) ^ "]"
+    | ArrayDef (t, dims)   -> (type2str t) ^ "[" ^ (concat ", " dims) ^ "]"
+    | ArraySpec (t, ndims) -> (type2str t) ^ "[" ^ string_of_int ndims ^ "]"
 
 and concat sep nodes = String.concat sep (List.map node2str nodes)
 
@@ -107,11 +108,18 @@ and node2str node =
     | TypeCast (ctype, value, _) -> "(" ^ type2str ctype ^ ")" ^ str value
     | FunCall (name, args, _) -> name ^ "(" ^ (concat ", " args) ^ ")"
 
-    | Arg node
-    | VarUse (node, _, _)
-    | FunUse (node, _, _) -> str node
-
+    (* FIXME: these should be printed when verbose=3
+    | Arg node -> "<arg>(" ^ str node ^ ")"
     | Type (node, ctype) -> str node ^ ":" ^ type2str ctype
+    | VarUse (value, _, _)
+    | FunUse (value, _, _) -> "<use>(" ^ str value ^ ")"
+    *)
+
+    | Arg node
+    | Type (node, _)
+    | FunUse (node, _, _)
+    | VarLet (node, _, _)
+    | VarUse (node, _, _) -> str node
 
     | _ -> raise InvalidNode
 

test/scope.cvc

@@ -15,7 +15,7 @@ int get_glob() {
 int glob = 1;
 
 int foo(int param) {
-    int foo = foo();
+    int foo = foo(1);
     int glob;
     return foo;
 }

util.ml

@@ -71,6 +71,10 @@ let transform_children trav node =
     | Arg value ->
         Arg (trav value)
 
+    | Type (value, ctype) ->
+        Type (trav value, ctype)
+    | VarLet (assign, def, depth) ->
+        VarLet (trav assign, def, depth)
     | VarUse (var, def, depth) ->
         VarUse (trav var, def, depth)
     | FunUse (funcall, def, depth) ->
@@ -117,9 +121,11 @@ let rec transform_all trav = function
     | FunCall (_, _, loc) -> loc
 
     | Expr value
+    | VarLet (value, _, _)
     | VarUse (value, _, _)
     | FunUse (value, _, _)
     | Arg value
+    | Type (value, _)
     | DimDec value -> locof value
 
     | _ -> noloc
@@ -184,3 +190,7 @@ let ctypeof = function
 let block_body = function
     | Block nodes -> nodes
     | _ -> raise InvalidNode
+
+let rec list_size = function
+    | [] -> 0
+    | hd :: tl -> 1 + (list_size tl)

util.mli

@@ -29,3 +29,6 @@ val ctypeof : Ast.node -> Ast.ctype
 
 (* Extract the node list from a Block node *)
 val block_body : Ast.node -> Ast.node list
+
+(* Get the size of a list by traversing it recurcively *)
+val list_size : 'a list -> int