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.0 required=5.0 tests=none autolearn=disabled version=3.1.3 X-Original-To: caml-list@yquem.inria.fr Delivered-To: caml-list@yquem.inria.fr Received: from mail2-relais-roc.national.inria.fr (mail2-relais-roc.national.inria.fr [192.134.164.83]) by yquem.inria.fr (Postfix) with ESMTP id 3AF43BC6B for ; Thu, 24 Jan 2008 10:01:31 +0100 (CET) X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: AgAAAF/il0eK6AGOn2dsb2JhbACQJAEBAQEBBgQGCQgYnjI X-IronPort-AV: E=Sophos;i="4.25,243,1199660400"; d="scan'208";a="6515782" Received: from lmr1.uibk.ac.at (HELO smtp.uibk.ac.at) ([138.232.1.142]) by mail2-smtp-roc.national.inria.fr with ESMTP; 24 Jan 2008 10:01:30 +0100 Received: from smc.uibk.ac.at (smc.uibk.ac.at [138.232.1.226] c703350@smc.uibk.ac.at) by smtp.uibk.ac.at (8.13.8/8.13.8/F1) with ESMTP id m0O91RaX016453 for ; Thu, 24 Jan 2008 10:01:27 +0100 Received: from smc.uibk.ac.at (localhost [127.0.0.1] c703350@smc.uibk.ac.at) by smc.uibk.ac.at (8.13.8+Sun/uibk) with ESMTP id m0O91QV7000894 for ; Thu, 24 Jan 2008 10:01:26 +0100 (MET) Received: (from c703350@localhost) by smc.uibk.ac.at (8.13.8+Sun/8.13.8/Submit) id m0O91QEK000893 for caml-list@yquem.inria.fr; Thu, 24 Jan 2008 10:01:26 +0100 (MET) Date: Thu, 24 Jan 2008 10:01:26 +0100 From: Christian Sternagel To: caml-list Subject: Re: [Caml-list] camlp4 Message-ID: <20080124090126.GB761@pc6197-c703.uibk.ac.at> Mail-Followup-To: caml-list References: <1200676132.4790dd24bfca9@web-mail2.uibk.ac.at> <95513600801181130u2f6584b8w505cd10e848bcc65@mail.gmail.com> <1200685853-sup-3987@ausone.local> <1200755341.4792128d5dad6@web-mail2.uibk.ac.at> <1200842484-sup-3237@ausone.local> <20080122133355.GI3862@pc6197-c703.uibk.ac.at> <1201009268-sup-196@port-ext18.ensta.fr> <20080122164320.GJ3862@pc6197-c703.uibk.ac.at> <1201025959-sup-3129@ausone.local> Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline In-Reply-To: <1201025959-sup-3129@ausone.local> User-Agent: Mutt/1.4.2.3i X-Scanned-By: MIMEDefang 2.61 at uibk.ac.at on 138.232.1.140 X-Spam: no; 0.00; camlp:01 0100,:01 admittedly:01 camlp:01 cheers:01 rocquencourt:01 syntax:01 struct:01 syntax:01 sig:01 struct:01 sig:01 strm:01 npeek:01 strm:01 On Tue, Jan 22, 2008 at 07:20:55PM +0100, Nicolas Pouillard wrote: > Excerpts from christian.sternagel's message of Tue Jan 22 17:43:20 +0100 2008: > > I tried to implement the optimizations for list comprehensions > > as stated in the book by simon peyton jones (1987). The problem > > of using fresh variables I circumvented in an admittedly `ugly' way, > > however (which is not fool proof since there could be programmers > > that use variable names like __h__0, __h__1, ...). > > > > The Starting point was the file Camlp4ListComprehension.ml from > > camlp4. > > > > Any comments are wellcome. > > Nice start, however can you make it more closer to the original code (as in Yes. Here it is. The `fresh variable' problem, however, is not really solved. Maybe, using some dedicated namespace is indeed the easiest solution (hence I did that in my code). cheers christisn @Ertai: sorry for the duplicate... the first time I forgot to reply to the list. -------------------------------------------------------------------------- open Camlp4; (* -*- camlp4r -*- *) (****************************************************************************) (* *) (* Objective Caml *) (* *) (* INRIA Rocquencourt *) (* *) (* Copyright 2007 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed under *) (* the terms of the GNU Library General Public License, with the special *) (* exception on linking described in LICENSE at the top of the Objective *) (* Caml source tree. *) (* *) (****************************************************************************) (* Authors: * - Nao Hirokawa: initial version * - Nicolas Pouillard: revised syntax version * - Christian Sternagel: optimization of Chapter 7 of * [Simon Peyton Jones, 1987. The Implementation of * Functional Programming Languages] *) module Id = struct value name = "Camlp4ListComprenhsion"; value version = "$Id: Camlp4ListComprehension.ml,v 1.1.2.1 2007/05/27 16:23:35 pouillar Exp $"; end; module Make (Syntax : Sig.Camlp4Syntax) = struct open Sig; include Syntax; value rec loop n = fun [ [] -> None | [(x, _)] -> if n = 1 then Some x else None | [_ :: l] -> loop (n - 1) l ]; value stream_peek_nth n strm = loop n (Stream.npeek n strm); (* usual trick *) value test_patt_lessminus = Gram.Entry.of_parser "test_patt_lessminus" (fun strm -> let rec skip_patt n = match stream_peek_nth n strm with [ Some (KEYWORD "<-") -> n | Some (KEYWORD ("[" | "[<")) -> skip_patt (ignore_upto "]" (n + 1) + 1) | Some (KEYWORD "(") -> skip_patt (ignore_upto ")" (n + 1) + 1) | Some (KEYWORD "{") -> skip_patt (ignore_upto "}" (n + 1) + 1) | Some (KEYWORD ("as" | "::" | "," | "_")) | Some (LIDENT _ | UIDENT _) -> skip_patt (n + 1) | Some _ | None -> raise Stream.Failure ] and ignore_upto end_kwd n = match stream_peek_nth n strm with [ Some (KEYWORD prm) when prm = end_kwd -> n | Some (KEYWORD ("[" | "[<")) -> ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) | Some (KEYWORD "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) | Some (KEYWORD "{") -> ignore_upto end_kwd (ignore_upto "}" (n + 1) + 1) | Some _ -> ignore_upto end_kwd (n + 1) | None -> raise Stream.Failure ] in skip_patt 1); value index = ref 0; value var base = Format.sprintf "__camlp4_list_comprehension__%s__%i" base (incr index; !index); value compr _loc e qs = let rec transform _loc e acc = fun [ [] -> <:expr< [ $e$ :: $acc$ ] >> | [`cond b :: qs] -> <:expr< if $b$ then $transform _loc e acc qs$ else $acc$ >> | [`gen (p, l) :: qs] -> let h = var "h" and u = var "u" and us = var "us" in <:expr< let rec $lid:h$ = fun [ [] -> $acc$ | [ $lid:u$ :: $lid:us$ ] -> $if Ast.is_irrefut_patt p then <:expr< (fun [ $p$ -> $transform _loc e <:expr< ($lid:h$ $lid:us$) >> qs$ ] ) $lid:u$ >> else <:expr< (fun [ $p$ -> $transform _loc e <:expr< ($lid:h$ $lid:us$) >> qs$ | _ -> $lid:h$ $lid:us$ ] ) $lid:us$ >> $ ] in $lid:h$ $l$ >> | _ -> <:expr< [] >> ] in transform _loc e <:expr< [] >> qs; DELETE_RULE Gram expr: "["; sem_expr_for_list; "]" END; value is_revised = try do { DELETE_RULE Gram expr: "["; sem_expr_for_list; "::"; expr; "]" END; True } with [ Not_found -> False ]; value comprehension_or_sem_expr_for_list = Gram.Entry.mk "comprehension_or_sem_expr_for_list"; EXTEND Gram GLOBAL: expr comprehension_or_sem_expr_for_list; expr: LEVEL "simple" [ [ "["; e = comprehension_or_sem_expr_for_list; "]" -> e ] ] ; comprehension_or_sem_expr_for_list: [ [ e = expr LEVEL "top"; ";"; mk = sem_expr_for_list -> <:expr< [ $e$ :: $mk <:expr< [] >>$ ] >> | e = expr LEVEL "top"; ";" -> <:expr< [$e$] >> | e = expr LEVEL "top"; "|"; l = LIST1 item SEP ";" -> compr _loc e l | e = expr LEVEL "top" -> <:expr< [$e$] >> ] ] ; item: [ [ test_patt_lessminus; p = patt; "<-" ; e = expr LEVEL "top" -> `gen (p, e) | e = expr LEVEL "top" -> `cond e ] ] ; END; if is_revised then EXTEND Gram GLOBAL: expr comprehension_or_sem_expr_for_list; comprehension_or_sem_expr_for_list: [ [ e = expr LEVEL "top"; ";"; mk = sem_expr_for_list; "::"; last = expr -> <:expr< [ $e$ :: $mk last$ ] >> | e = expr LEVEL "top"; "::"; last = expr -> <:expr< [ $e$ :: $last$ ] >> ] ] ; END else (); end; let module M = Register.OCamlSyntaxExtension Id Make in (); -------------------------------------------------------------------------- > > -- > Nicolas Pouillard aka Ertai