open Genlex

let expand_orec _loc l =
  let subpel (pa,ex) =
    let (p,s) = match pa with
      |MLast.PaLid(_l,s) -> (MLast.PaLid(_l,s^"_aux"),s)
      |_ -> assert false
    in
    let rec subex s = function
      |MLast.ExApp(_l,x,y) -> MLast.ExApp(_l,subex s x,subex s y)
      |MLast.ExAcc(_l,x,y) -> MLast.ExAcc(_l,subex s x,subex s y)
      |MLast.ExLid(_l,e) when e = s -> MLast.ExLid(_l,s^"_rec")
      |MLast.ExFun(_l,pel) ->
              MLast.ExFun(_l,List.map(fun (p,o,e) -> (p,o,subex s e)) pel) 
      |MLast.ExTup(_l,l) -> MLast.ExTup(_l,List.map (subex s) l)
      |MLast.ExSeq(_l,l) -> MLast.ExSeq(_l,List.map (subex s) l)
      |MLast.ExMat(_l,e,pel) ->
              let l = List.map(fun (p,o,e) -> (p,o,subex s e)) pel in
              MLast.ExMat(_l,subex s e,l)
      |ex -> ex
    in (p,<:expr< fun $lid:s^"_rec"$ -> $subex s ex$ >>)
  in 
  let newpel (pa,ex) =
    let s = match pa with
      |MLast.PaLid(_,s) -> s
      |_ -> assert false
    in
    let newex s = <:expr< fun t -> $lid:s^"_aux"$ $lid:s$ t >>
    in (pa,newex s)
  in (List.map subpel l)@(List.map newpel l)

EXTEND
Pcaml.expr: LEVEL "top" [[
  "let"; "orec"; l = LIST1 Pcaml.let_binding SEP "and"; "in";
        x = Pcaml.expr LEVEL "top" ->
    let pel = expand_orec _loc l in
    <:expr< let rec $list:pel$ in $x$ >>
]];
Pcaml.str_item: [[
    "let"; "orec"; l = LIST1 Pcaml.let_binding SEP "and"; "in";
    x = Pcaml.expr LEVEL "top" ->
        let pel = expand_orec _loc l in
        <:str_item< let rec $list:pel$ in $x$ >>
    |"let"; "orec"; l = LIST1 Pcaml.let_binding SEP "and" ->
         let pel = expand_orec _loc l in
         <:str_item< value rec $list:pel$ >>
]];
END