open recursion

open recursion

[Pietro Abate]

[-- Attachment #1: Type: text/plain, Size: 1084 bytes --]

Hi all,
Today, inspired by this message:
http://caml.inria.fr/pub/ml-archives/caml-list/2006/10/6f9aaa1bdd7f959e92ccd1be147da5ed.en.html
I wrote this small camlp4 extension (attached) to 'open' recursive
functions.

functions specified with 'orec' are re-written as follows:

let orec fib x = match x with
 | 0 -> 0
 | 1 -> 1
 | n -> fib (n - 1) + fib (n - 2)

let rec fib_aux fib_rec x =
  match x with
    0 -> 0
  | 1 -> 1
  | n -> fib_rec (n - 1) + fib_rec (n - 2)
and fib t = fib_aux fib t

Even if it works for small examples, I'm not sure if this approach is
sound in general, in particular with mutually recursive functions. Did 
I miss something obvious ?

p

ocamlc -c -pp 'camlp4o -I . pa_extend.cmo q_MLast.cmo' -I /usr/lib/ocaml/3.09.2/camlp4/ pa_polyrec.ml

camlp4o -I . pa_extend.cmo q_MLast.cmo pr_o.cmo pa_polyrec.cmo pt.ml

-- 
++ Blog: http://blog.rsise.anu.edu.au/?q=pietro
++ 
++ "All great truths begin as blasphemies." -George Bernard Shaw
++ Please avoid sending me Word or PowerPoint attachments.
   See http://www.fsf.org/philosophy/no-word-attachments.html

[-- Attachment #2: pa_polyrec.ml --]
[-- Type: text/plain, Size: 1682 bytes --]


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

[-- Attachment #3: pt.ml --]
[-- Type: text/plain, Size: 374 bytes --]


let orec fib x = match x with
 | 0 -> 0
 | 1 -> 1
 | n -> fib (n - 1) + fib (n - 2)

let rec f = function
  |1 -> 0
  |n -> f (n-1)
;;

let orec f = function
  |1 -> 0
  |n -> f (n-1)
;;

let orec f = function
  | 1 -> 0
  | n when (n mod 2) = 0 -> f (n - 1)
  | n -> g ( n - 2 )
and g = function
  | 0 -> 0
  | n when (n mod 2) > 0 -> g ( n - 1 )
  | n -> f ( n - 1 )
;;