|
|
@@ -33,7 +33,7 @@ let array_width = function
|
|
|
let check_type ?(msg="") expected = function
|
|
|
| Type (node, got) when (spec got) <> (spec expected) ->
|
|
|
let msg = match msg with
|
|
|
- | "" -> sprintf "expected type %s, got %s"
|
|
|
+ | "" -> sprintf "type mismatch: expected type %s, got %s"
|
|
|
(type2str expected) (type2str got)
|
|
|
(*(type2str (spec expected)) (type2str (spec got))*)
|
|
|
| _ -> msg
|
|
|
@@ -55,9 +55,9 @@ let op_result_type operand_type = function
|
|
|
(* Check if the given operator can be applied to the given type *)
|
|
|
let check_type_op allowed_types desc = function
|
|
|
| Type (node, ctype) when not (List.mem ctype allowed_types) ->
|
|
|
- let msg =
|
|
|
- sprintf "%s cannot be applied to type %s, only to %s"
|
|
|
- desc (type2str ctype) (types2str allowed_types)
|
|
|
+ let msg = sprintf
|
|
|
+ "%s cannot be applied to type %s, only to %s"
|
|
|
+ desc (type2str ctype) (types2str allowed_types)
|
|
|
in
|
|
|
raise (NodeError (node, msg))
|
|
|
| Type _ -> ()
|
|
|
@@ -66,9 +66,8 @@ let check_type_op allowed_types desc = function
|
|
|
let check_dims_match dims dec_type errnode =
|
|
|
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
|
|
|
+ let msg = sprintf
|
|
|
+ "dimension mismatch: expected %d indices, got %d" expected got
|
|
|
in
|
|
|
raise (NodeError (errnode, msg))
|
|
|
| _ -> ()
|
|
|
@@ -77,9 +76,9 @@ let rec typecheck node = match node with
|
|
|
| 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
|
|
|
+ let msg = sprintf
|
|
|
+ "function \"%s\" expects %d arguments, got %d"
|
|
|
+ name nparams nargs
|
|
|
in
|
|
|
raise (NodeError (node, msg))
|
|
|
| _ ->
|
|
|
@@ -163,15 +162,15 @@ let rec typecheck node = match node with
|
|
|
| (Void, Some (ret, _)) ->
|
|
|
raise (NodeError (ret, "void function should not have a return value"))
|
|
|
| ((Bool | Int | Float), None) ->
|
|
|
- let msg =
|
|
|
- sprintf "expected return value of type %s for function \"%s\""
|
|
|
- (type2str ret_type) name
|
|
|
+ let msg = sprintf
|
|
|
+ "expected return value of type %s for function \"%s\""
|
|
|
+ (type2str ret_type) name
|
|
|
in
|
|
|
raise (NodeError (node, msg))
|
|
|
| ((Bool | Int | Float), Some (ret, t)) when t != ret_type ->
|
|
|
- let msg =
|
|
|
- sprintf "function \"%s\" has return type %s, got %s"
|
|
|
- name (type2str ret_type) (type2str t)
|
|
|
+ let msg = sprintf
|
|
|
+ "function \"%s\" has return type %s, got %s"
|
|
|
+ name (type2str ret_type) (type2str t)
|
|
|
in
|
|
|
raise (NodeError (ret, msg))
|
|
|
| _ ->
|
Taddeus Kroes