More patterns

hazelgrove · Dec 20, 2024 · 4a79a14 · 4a79a14
1 parent 57b3e8b
commit 4a79a14
Show file tree

Hide file tree

Showing 2 changed files with 43 additions and 3 deletions.
diff --git a/src/haz3lmenhir/AST.re b/src/haz3lmenhir/AST.re
@@ -205,6 +205,8 @@ let arb_constructor_ident =
     );
 
 // ['a'-'z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_']*
+// Currently an issue if the keyword is a prefix of another word. `let ? = ina in ?`
+// Temporarily doing single char identifiers as a fix
 let arb_ident =
   QCheck.(
     // TODO make this support full indent instead of just lower alpha
@@ -222,7 +224,7 @@ let arb_ident =
         | "in" => "keyword"
         | _ => ident
         },
-      string_gen_of_size(Gen.int_range(1, 5), arb_lower_alpha),
+      string_gen_of_size(Gen.int_range(1, 1), arb_lower_alpha),
     )
   );
 
@@ -330,6 +332,19 @@ let rec gen_exp_sized = (n: int): QCheck.Gen.t(exp) =>
   )
 and gen_typ_sized: int => QCheck.Gen.t(typ) =
   n =>
+    /*
+       | SumTyp(sumtype)
+       | UnknownType(typ_provenance)
+       | ArrowType(typ, typ)
+       | TypVar(string)
+       | InvalidTyp(string)
+       | ForallType(tpat, typ)
+       | RecType(tpat, typ)
+     and sumterm =
+       | Variant(string, option(typ))
+       | BadEntry(typ)
+
+       */
     QCheck.Gen.(
       let leaf_nodes =
         oneof([
@@ -348,6 +363,12 @@ and gen_typ_sized: int => QCheck.Gen.t(typ) =
               join(
                 map(
                   (sizes: array(int)) => {
+                    let sizes =
+                      switch (sizes) {
+                      | [|single|] => [|(single - 1) / 2, (single - 1) / 2|] // Can't have singleton tuples. Replace this with a minimum parameter on list sizes
+                      | _ => sizes
+                      };
+
                     let typs = Array.map((size: int) => self(size), sizes);
 
                     let flattened = flatten_a(typs);
@@ -400,6 +421,12 @@ and gen_pat_sized: int => QCheck.Gen.t(pat) =
               join(
                 map(
                   sizes => {
+                    let sizes =
+                      switch (sizes) {
+                      | [|single|] => [|(single - 1) / 2, (single - 1) / 2|] // Can't have singleton tuples. Replace this with a minimum parameter on list sizes
+                      | _ => sizes
+                      };
+
                     let pats = Array.map((size: int) => self(size), sizes);
 
                     let flattened = flatten_a(pats);

diff --git a/test/Test_Menhir.re b/test/Test_Menhir.re
@@ -248,8 +248,8 @@ let i = ref(0);
 let qcheck_menhir_maketerm_equivalent_test =
   QCheck.Test.make(
     ~name="Menhir and maketerm are equivalent",
-    ~count=1000,
-    QCheck.make(~print=AST.show_exp, AST.gen_exp_sized(4)),
+    ~count=100,
+    QCheck.make(~print=AST.show_exp, AST.gen_exp_sized(7)),
     exp => {
       let core_exp = Conversion.Exp.of_menhir_ast(exp);
 
@@ -266,6 +266,14 @@ let qcheck_menhir_maketerm_equivalent_test =
                 |> Exp.fresh
               | _ => cont(e)
               },
+          ~f_pat=
+            (cont, e) =>
+              switch (e.term) {
+              | Tuple(es) =>
+                Parens(Tuple(es |> List.map(cont)) |> Pat.fresh)
+                |> Pat.fresh
+              | _ => cont(e)
+              },
           core_exp,
         );
 
@@ -968,6 +976,11 @@ let ex5 = list_of_mylist(x) in
 (ex1, ex2, ex3, ex4, ex5)
     |},
     ),
+    // This fails because MakeTerm can't handle left to right keyword prefixes.
+    skip_menhir_maketerm_equivalent_test(
+      "Example failure",
+      {|let ? = ina in ?|} // let ? = ina in ?
+    ),
     QCheck_alcotest.to_alcotest(qcheck_menhir_maketerm_equivalent_test),
     // Disabled due to bugs in ExpToSegment
     // e.g. https://github.com/hazelgrove/hazel/issues/1445