From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: X-Spam-Checker-Version: SpamAssassin 3.1.3 (2006-06-01) on yquem.inria.fr X-Spam-Level: X-Spam-Status: No, score=0.1 required=5.0 tests=AWL autolearn=disabled version=3.1.3 X-Original-To: caml-list@yquem.inria.fr Delivered-To: caml-list@yquem.inria.fr Received: from concorde.inria.fr (concorde.inria.fr [192.93.2.39]) by yquem.inria.fr (Postfix) with ESMTP id 1DF2BBC0A for ; Thu, 5 Apr 2007 05:23:48 +0200 (CEST) Received: from mail.rsise.anu.edu.au (mail.rsise.anu.edu.au [150.203.208.4]) by concorde.inria.fr (8.13.6/8.13.6) with ESMTP id l353NgLP003325 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=NO) for ; Thu, 5 Apr 2007 05:23:47 +0200 Received: from localhost (localhost [127.0.0.1]) by mail.rsise.anu.edu.au (Postfix) with ESMTP id BB547545FD for ; Thu, 5 Apr 2007 13:23:35 +1000 (EST) Received: from mail.rsise.anu.edu.au ([150.203.208.4]) by localhost (mail [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id 12610-04 for ; Thu, 5 Apr 2007 13:23:35 +1000 (EST) Received: from pulp.rsise.anu.edu.au (pulp.rsise.anu.edu.au [150.203.208.49]) by mail.rsise.anu.edu.au (Postfix) with ESMTP id 6F59B545F8 for ; Thu, 5 Apr 2007 13:23:30 +1000 (EST) Received: by pulp.rsise.anu.edu.au (Postfix, from userid 1560) id 94935A0B895; Thu, 5 Apr 2007 13:23:30 +1000 (EST) Date: Thu, 5 Apr 2007 13:23:30 +1000 From: Pietro Abate To: ocaml ml Subject: open recursion Message-ID: <20070405032330.GA18425@pulp.rsise.anu.edu.au> Mail-Followup-To: Pietro Abate , ocaml ml MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="NzB8fVQJ5HfG6fxh" Content-Disposition: inline X-Operating-System: GNU/Linux X-Organization: Research School of Information Science and Engineering (Australian National University) User-Agent: Mutt/1.5.13 (2006-08-11) X-Virus-Scanned: by amavisd-new-20030616-p10 (Debian) at mail.rsise.anu.edu.au X-Miltered: at concorde with ID 46146BBE.000 by Joe's j-chkmail (http://j-chkmail . ensmp . fr)! X-Spam: no; 0.00; recursion:01 camlp:01 recursive:01 recursive:01 ocamlc:01 -pp:01 cmo:01 mlast:01 cmo':01 usr:01 lib:01 ocaml:01 camlp:01 cmo:01 mlast:01 X-Attachments: name="pa_polyrec.ml" name="pt.ml" --NzB8fVQJ5HfG6fxh Content-Type: text/plain; charset=us-ascii Content-Disposition: inline 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 --NzB8fVQJ5HfG6fxh Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="pa_polyrec.ml" 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 --NzB8fVQJ5HfG6fxh Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="pt.ml" 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 ) ;; --NzB8fVQJ5HfG6fxh--