[asl] Change error message for bad pattern.

asllib/PP.mli

@@ -76,6 +76,9 @@ val pp_int_constraints : int_constraint list printer
 val pp_local_decl_item : local_decl_item printer
 (** Pretty-print a local declaration item. *)
 
+val pp_pattern : pattern printer
+(** Pretty-print a pattern. *)
+
 val pp_t : t printer
 (** Print an AST from printer for a literal *)
 

asllib/Typing.ml

@@ -1239,7 +1239,7 @@ module Annotate (C : ANNOTATE_CONFIG) : S = struct
         Pattern_Not new_q |: TypingRule.PNot
     (* End *)
     (* Begin PSingle *)
-    | Pattern_Single e ->
+    | Pattern_Single e as p ->
         let t_e, e' = annotate_expr env e in
         let+ () =
          fun () ->
@@ -1254,12 +1254,12 @@ module Annotate (C : ANNOTATE_CONFIG) : S = struct
           | T_Bits _, T_Bits _ ->
               check_bits_equal_width loc env t_struct t_e_struct ()
           | T_Enum li1, T_Enum li2 when list_equal String.equal li1 li2 -> ()
-          | _ -> fatal_from loc (Error.BadTypesForBinop (EQ_OP, t, t_e))
+          | _ -> fatal_from loc (Error.BadPattern (p, t))
         in
         Pattern_Single e' |: TypingRule.PSingle
     (* End *)
     (* Begin PGeq *)
-    | Pattern_Geq e ->
+    | Pattern_Geq e as p ->
         let t_e, e' = annotate_expr env e in
         let+ () = check_statically_evaluable env e' in
         let+ () =
@@ -1268,12 +1268,12 @@ module Annotate (C : ANNOTATE_CONFIG) : S = struct
           and t_e_struct = Types.get_structure env t_e in
           match (t_struct.desc, t_e_struct.desc) with
           | T_Real, T_Real | T_Int _, T_Int _ -> ()
-          | _ -> fatal_from loc (Error.BadTypesForBinop (GEQ, t, t_e))
+          | _ -> fatal_from loc (Error.BadPattern (p, t))
         in
         Pattern_Geq e' |: TypingRule.PGeq
     (* End *)
     (* Begin PLeq *)
-    | Pattern_Leq e ->
+    | Pattern_Leq e as p ->
         let t_e, e' = annotate_expr env e in
         let+ () = check_statically_evaluable env e' in
         let+ () =
@@ -1282,12 +1282,12 @@ module Annotate (C : ANNOTATE_CONFIG) : S = struct
           and t_e_anon = Types.make_anonymous env t_e in
           match (t_anon.desc, t_e_anon.desc) with
           | T_Real, T_Real | T_Int _, T_Int _ -> ()
-          | _ -> fatal_from loc (Error.BadTypesForBinop (LEQ, t, t_e))
+          | _ -> fatal_from loc (Error.BadPattern (p, t))
         in
         Pattern_Leq e' |: TypingRule.PLeq
     (* End *)
     (* Begin PRange *)
-    | Pattern_Range (e1, e2) ->
+    | Pattern_Range (e1, e2) as p ->
         let t_e1, e1' = annotate_expr env e1
         and t_e2, e2' = annotate_expr env e2 in
         let+ () =
@@ -1297,9 +1297,7 @@ module Annotate (C : ANNOTATE_CONFIG) : S = struct
           and t_e2_anon = Types.make_anonymous env t_e2 in
           match (t_anon.desc, t_e1_anon.desc, t_e2_anon.desc) with
           | T_Real, T_Real, T_Real | T_Int _, T_Int _, T_Int _ -> ()
-          | _, T_Int _, T_Int _ | _, T_Real, T_Real ->
-              fatal_from loc (Error.BadTypesForBinop (GEQ, t, t_e1))
-          | _ -> fatal_from loc (Error.BadTypesForBinop (GEQ, t_e1, t_e2))
+          | _ -> fatal_from loc (Error.BadPattern (p, t))
         in
         Pattern_Range (e1', e2') |: TypingRule.PRange
     (* End *)

asllib/error.ml

@@ -63,6 +63,7 @@ type error_desc =
   | BadRecursiveDecls of identifier list
   | UnrespectedParserInvariant
   | BadATC of ty * ty  (** asserting, asserted *)
+  | BadPattern of pattern * ty
   | ConstrainedIntegerExpected of ty
   | ParameterWithoutDecl of identifier
   | BaseValueEmptyType of ty
@@ -269,6 +270,10 @@ module PPrint = struct
            corresponding@ getter@ of@ signature@ @[@[%a@]@ ->@ %a@]"
           func.name (pp_comma_list pp_ty) args pp_ty ret
     | UnexpectedATC -> pp_print_text f "ASL Typing error: unexpected ATC."
+    | BadPattern (p, t) ->
+        fprintf f
+          "ASL Typing error:@ Bad@ pattern@ %a@ for@ expression@ of@ type@ %a."
+          pp_pattern p pp_ty t
     | BadReturnStmt (Some t) ->
         fprintf f
           "ASL Typing error:@ cannot@ return@ nothing@ from@ a@ function,@ an@ \

asllib/tests/regressions.t/bad-pattern.asl

@@ -0,0 +1,6 @@
+func main () => integer
+begin
+  case 3 of
+  when '101' => print ("Cannot happen");
+  end
+end

asllib/tests/regressions.t/run.t

@@ -438,3 +438,5 @@ Empty getters/setters
   ASL Static Error: Unsupported expression n.
   File pstate-exp.asl, line 98, characters 12 to 13:
   ASL Static Error: Unsupported expression n.
+
+  $ aslref bad-pattern.asl