[CHR] error is a rule pattern matches a non-constraint (fix #48)

Author: gares

src/compiler.ml

@@ -1628,6 +1628,14 @@ let chose_indexing predicate l =
   in
     aux 0 l
 
+let check_rule_pattern_in_clique clique { Data.CHR.pattern; rule_name } =
+  try
+    let outside =
+      List.find (fun x -> not (Data.CHR.in_clique clique x)) pattern in
+    error ("CHR rule " ^ rule_name ^ ": matches " ^ C.show outside ^
+      " which is not a constraint on which it is applied. Check the list of predicates after the \"constraint\" keyword.");
+  with Not_found -> ()
+
 let run
   {
     WithMain.types;
@@ -1653,6 +1661,7 @@ let run
       let chr, clique = CHR.new_clique clique chr in
       let rules = filter_if flags.defined_variables pifexpr rules in 
       let rules = List.map (compile_chr initial_depth) rules in
+      List.iter (check_rule_pattern_in_clique clique) rules;
       List.fold_left (fun x y -> CHR.add_rule clique y x) chr rules)
     CHR.empty chr in
   let ifexpr { Ast.Clause.attributes = { Assembled.ifexpr } } = ifexpr in

src/data.ml

@@ -469,6 +469,7 @@ module CHR : sig
   val new_clique : constant list -> t -> t * clique
   val clique_of : constant -> t -> Constants.Set.t option
   val add_rule : clique -> rule -> t -> t
+  val in_clique : clique -> constant -> bool
 
   val rules_for : constant -> t -> rule list
 
@@ -498,6 +499,8 @@ end = struct (* {{{ *)
 
   let empty = { cliques = Constants.Map.empty; rules = Constants.Map.empty }
 
+  let in_clique m c = Constants.Set.mem c m
+
   let new_clique cl ({ cliques } as chr) =
     if cl = [] then error "empty clique";
     let c = List.fold_right Constants.Set.add cl Constants.Set.empty in

tests/sources/chr_not_clique.elpi

@@ -0,0 +1,5 @@
+constraint a {
+
+  rule b.
+
+}

tests/suite/elpi_specific.ml

@@ -208,3 +208,10 @@ let () = declare "accumulate_twice2"
   ~typecheck:true
   ~expectation:Test.Failure
   ()
+
+let () = declare "CHR_no_clique"
+  ~source_elpi:"chr_not_clique.elpi"
+  ~description:"CHR rule on a non constraint"
+  ~typecheck:true
+  ~expectation:Test.Failure
+  ()