 # Mutually recursive parser in Angstrom

I want to defined mutually recursive parser functions using Angstrom and

1. it seems that built-in `fix` doesn’t help me
2. I can’t declare my own polyvariadic `fix` because parser type is abstract.

I also checked other parser-combinator libraries and they seems to have parser type to be concrete. How should I proceed? @seliopou ?

``````open Angstrom

let rec fix_comb f a = f (fix_comb f) a

let fix_poly :
(('a -> 'b) list -> 'a -> 'b) list -> ('a -> 'b) list =
fun l ->
fix_comb
(fun self l -> List.map (fun li x -> li (self l) x) l)
l

[@@@warning "-8-27"]

let [ even; odd ] =
let open_even [ even; odd ] n = n = 0 || odd (n - 1)
and open_odd [ even; odd ] n = n <> 0 && even (n - 1) in
fix_poly [ open_even; open_odd ]

[@@@warning "+8+27"]

let parens p =
char '(' >>= fun _ ->
p >>= fun x ->
char ')' >>= fun _ -> return x

let const =
char '0' >>= fun c -> return (Printf.sprintf "%c" c)

let [ sum; product ] =
let open_sum [ sum; product ] =
choice
[
parens sum;
( product >>= fun h ->
many (char '+' >>= fun _ -> product) >>= fun tl ->
return
(List.fold_left
(fun acc r -> Printf.sprintf "%s+%s" acc r)
h tl) );
]
and open_product [ sum; product ] =
choice
[
parens sum;
( const >>= fun h ->
many (char '*' >>= fun _ -> product) >>= fun tl ->
return
(List.fold_left
(fun acc r -> Printf.sprintf "%s*%s" acc r)
h tl) );
]
in

fix_poly [ open_sum; open_product ]

(*
81 |   fix_poly [ open_sum; open_product ]
^^^^^^^^
Error: This expression has type string t list -> string t
but an expression was expected of type ('a -> 'b) list -> 'a -> 'b
Type string t is not compatible with type 'a -> 'b  *)
``````

I found a dirty hack but I still need proper solution

``````let sum, product =
let sum1 : string t ref =
ref @@ Obj.magic (fun _ -> failwith "sum")
in
let pro1 : string t ref =
ref @@ Obj.magic (fun _ -> failwith "product")
in
let sum =
fix @@ fun self ->
choice
[
parens self;
( !pro1 >>= fun h ->
many (char '+' >>= fun _ -> !pro1) >>= fun tl ->
return
(List.fold_left
(fun acc r -> Printf.sprintf "%s+%s" acc r)
h tl) );
]
in
let product =
fix @@ fun self ->
choice
[
parens !sum1;
( const >>= fun h ->
many (char '*' >>= fun _ -> self) >>= fun tl ->
return
(List.fold_left
(fun acc r -> Printf.sprintf "%s*%s" acc r)
h tl) );
]
in
pro1 := product;
sum1 := sum;
(sum, product)

let%test _ =
parse_string ~consume:Consume.All sum "0*0+0*0"
= Ok "0*0+0*0"
``````
1 Like

One way of coding recursion without let-rec is via a recursively-typed dispatch-table. I think there’s an example of this in `typing/tast_mapper.mli`.

1 Like

Yeah, thanks Chet. But I still think that it is not an expected solution.

``````  type dispatch = {
sum : dispatch -> string t;
product : dispatch -> string t;
}

let d =
let sum d =
fix @@ fun self ->
choice
[
parens self;
( d.product d >>= fun h ->
many (char '+' >>= fun _ -> d.product d)
>>= fun tl ->
return
(List.fold_left
(fun acc r -> Printf.sprintf "%s+%s" acc r)
h tl) );
]
in
let product d =
fix @@ fun self ->
choice
[
parens (d.sum d);
( const >>= fun h ->
many (char '*' >>= fun _ -> self) >>= fun tl ->
return
(List.fold_left
(fun acc r -> Printf.sprintf "%s*%s" acc r)
h tl) );
]
in
{ sum; product }

let%test _ =
parse_string ~consume:Consume.All (d.sum d) "0*0+0*0"
= Ok "0*0+0*0"
``````

Oh hm, no, I didn’t mean that. I don’t know Angstrom, but let’s suppose that we have a recursive-descent parser, with type `'a t` as the type of parsers that parse the input to a type `'a` [I suspect that that’s what you mean above, but just being concrete]. Suppose we have three nonterminals, say … “expr”, “block”, and “procedure”, which are mutually-recusive. Then I might do the following:

``````let expr __dt__ strm = ........ __dt__.expr __dt__ strm ....
..... __dt__.block __dt__ strm ...
and block __dt__ strm = ...... __dt__.expr __dt__ strm .....
and procedure __dt__ strm = .... __dt__.block __dt__ strm ...

let dt = { expr = expr ; block = block ; procedure = procedure }

let top_expr strm = dt.expr dt strm
... etc ....
``````

Notice that there’s no recursion in the code: it all comes about via the type. This referred to as “open recursion” because you can replace (in the dispatch table) the definition of any of the constituent functions by a new one (that can (heh) use the previous one as a fallback, of course).

The thing you describe is essentially the same, so it looks like that we understand each other Ah, ok. I assumed you were turned-off by the need to use “fix” in your example code.