let convert
    (_loc: Ast.Loc.t)
    (a_perform_body: Ast.expr)
    (a_bind_function: Ast.expr)
    (a_fail_function: Ast.expr): Ast.expr =
  let rec loop _loc a_perform_body =
    match a_perform_body with
        <:expr< let $rec:_$ $_$ in $lid:"<--"$ >> ->
          Loc.raise _loc
            (Stream.Error "convert: monadic binding cannot be last a \"perform\" body")
      | <:expr< let $rec:r$ $binding:bs$ in $body$ >> ->
        let body' = loop _loc body in
          <:expr< let $rec:r$ $binding:bs$ in $body'$ >>
      | <:expr< let module $m$ = $mb$ in $body$ >> ->
        let body' = loop _loc body in
          <:expr< let module $m$ = $mb$ in $body'$ >>
      | <:expr< do { $e$ } >> ->
         let b1, b2, bs =
           match Ast.list_of_expr e [] with
               b1 :: b2 :: bs -> b1, b2, bs
             | _ -> assert false in
         let do_rest () =
           loop _loc
             (match bs with
                 [] -> b2
               | _  -> <:expr< do { $list:(b2 :: bs)$ } >>)
         and do_merge a_body =
           loop _loc <:expr< do { $list:(a_body :: b2 :: bs)$ } >> in
             begin
               match b1 with
                   (* monadic binding *)
                   <:expr< let $p$ = $e$ in $lid:"<--"$ >> ->
                     if is_irrefutable_pattern p then
                       <:expr< $a_bind_function$ $e$ (fun $p$ -> $do_rest ()$) >>
                     else
                       <:expr< $a_bind_function$
                               $e$
                               (fun [$p$ -> $do_rest ()$
                                     | _ -> $a_fail_function$ ]) >>
                   (* recursive monadic binding *)
                 | <:expr< let rec $binding:b$ in $lid:"<--"$ >> ->
                   let pattern_list = List.map fst (Ast.pel_of_binding b) in
                   let patterns = tuplify_patt _loc pattern_list
                   and patt_as_exp =
                     tuplify_expr
                       _loc
                       (List.map (fun x -> patt_to_exp _loc x) pattern_list)
                   in
                     List.iter
                       (fun p ->
                         if not (is_irrefutable_pattern p) then
                           Loc.raise _loc
                             (Stream.Error
                                 ("convert: refutable patterns and " ^
                                     "recursive bindings do not go together")))
                       pattern_list;
                     <:expr< let rec $binding:b$ in
                               $a_bind_function$
                                 $patt_as_exp$
                                 (fun $patterns$ -> $do_rest ()$) >>
                 | (* map through the regular let *)
                   <:expr< let $rec:r$ $binding:bs$ in $body$ >> ->
                   <:expr< let $rec:r$ $binding:bs$ in $do_merge body$ >>
                 | <:expr< let module $m$ = $mb$ in $body$ >> ->
                   <:expr< let module $m$ = $mb$ in $do_merge body$ >>
                 | _ -> <:expr< $a_bind_function$ $b1$ (fun _ -> $do_rest ()$) >>
             end
      | any_body -> any_body
  in loop _loc a_perform_body