From: Siraaj Khandkar <siraaj@khandkar.net>
Date: Mon, 17 Sep 2018 11:02:39 +0000 (-0400)
Subject: Fix fragile pattern matching
X-Git-Url: https://git.xandkar.net/?a=commitdiff_plain;h=789ef466bebb54a589039a8100147a11ea6f9719;p=tiger.ml.git

Fix fragile pattern matching
---

diff --git a/compiler/src/lib/tiger/tiger_error.ml b/compiler/src/lib/tiger/tiger_error.ml
index f49bca4..b4ec719 100644
--- a/compiler/src/lib/tiger/tiger_error.ml
+++ b/compiler/src/lib/tiger/tiger_error.ml
@@ -213,3 +213,25 @@ let is_wrong_type t =
   | Invalid_operand_type _
   | Different_operand_types _ ->
       false
+
+let is_invalid_syntax t =
+  match t with
+  | Invalid_syntax _ ->
+      true
+  | Wrong_type _
+  | Unknown_type _
+  | Unknown_id _
+  | Id_is_a_function _
+  | Id_not_a_function _
+  | No_such_field_in_record _
+  | Exp_not_a_record _
+  | Exp_not_an_array _
+  | Wrong_type_of_expression_in_var_dec _
+  | Wrong_type_used_as_array _
+  | Wrong_type_used_as_record _
+  | Wrong_type_of_field_value _
+  | Wrong_type_of_arg _
+  | Wrong_number_of_args _
+  | Invalid_operand_type _
+  | Different_operand_types _ ->
+      false
diff --git a/compiler/src/lib/tiger/tiger_error.mli b/compiler/src/lib/tiger/tiger_error.mli
index a9d30eb..ed4a7cf 100644
--- a/compiler/src/lib/tiger/tiger_error.mli
+++ b/compiler/src/lib/tiger/tiger_error.mli
@@ -73,3 +73,4 @@ val to_string : t -> string
 val is_unknown_id   : t -> bool
 val is_unknown_type : t -> bool
 val is_wrong_type   : t -> bool
+val is_invalid_syntax : t -> bool
diff --git a/compiler/src/lib/tiger/tiger_test_cases_book.ml b/compiler/src/lib/tiger/tiger_test_cases_book.ml
index 92ad429..3911f53 100644
--- a/compiler/src/lib/tiger/tiger_test_cases_book.ml
+++ b/compiler/src/lib/tiger/tiger_test_cases_book.ml
@@ -85,7 +85,7 @@ let is_error_expected_parsing_of_filename =
   let module E = Tiger_error in
   function
   | "test49.tig" ->
-      Some (function E.Invalid_syntax _ -> true | _ -> false)
+      Some Error.is_invalid_syntax
       (* TODO: Be more specific - test position *)
   | _ ->
     (* TODO: Fill-in other expected cases *)