Ppxlib: using `Ast_pattern` to describe cases

Learning
1

I’m trying to write a PPX of the form

match%foo x with
| "bar" -> ...
| _ -> ...

while using the Ast_pattern module to constrain the LHS patterns to be strings. However I’ve come up short trying to find a way to describe cases like this.

Per the manual, pexp_match has the signature:

val pexp_match : 
  (expression, 'a, 'b) Ast_pattern0.t ->
  (case list, 'c, 'd) Ast_pattern0.t ->
  (expression, 'e, 'f) Ast_pattern0.t

It’s clear to me how I can constrain the kind of expression of “the thing to be matched on”, but how to construct a case list pattern is alluding me. I see the case function which seems to describe what I want, but that is for a single case, not a list. And using it with many provides a type error:

|       Ast_pattern.(single_expr_payload (pexp_match __ (many (case ~lhs:(pstring __) ~rhs:__ ~guard:__ ))))
                                                              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This expression has type
         (case, string -> expression option -> expression -> 'a, 'a) t
       but an expression was expected of type (case, string -> string, 'b) t
       Type expression option -> expression -> 'a is not compatible with type
         string

(which makes sense, but is disappointing)

Is there something I’m missing, or is there no way to describe the pattern I’m looking for?

2

As you’ve noticed, many operates only on the first continuation parameter:

val many : ('a, 'b -> 'c, 'c) t -> ('a list, 'b list -> 'c, 'c) t

(The 'b is the first continuation parameter. In your case, that’s string. The 'c in your case is expression option -> expression).

We can modify the continuation to pack the (first) three continuation parameters from case into a 3-tuple:

let case' () = case ~lhs:(pstring __) ~rhs:__ ~guard:__ |> pack3
val case' :
  unit ->
  (case, string * expression option * expression -> 'a, 'a) Ast_pattern.t

Then the definition with many works:

let payload () = single_expr_payload (pexp_match __ (many (case' ())))
val payload :
  unit ->
  (
    payload,
    expression -> (string * expression option * expression) list -> 'a,
    'a
  ) Ast_pattern.t

See also: docs. For more than three values, use some combination of the packN and mapN combinators.

1 Like