Version française
Home     About     Download     Resources     Contact us    
Browse thread
camlp4
[ Home ] [ Index: by date | by threads ]
[ Search: ]

[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
Date: -- (:)
From: Nicolas Pouillard <nicolas.pouillard@g...>
Subject: Re: [Caml-list] camlp4
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
3.10.1 for instance), it would be simpler for me to look at the changes?

Cheers,

> Here is the code
> -------------------------------------------------------------------------
> open Camlp4;;
> 
> module Id = struct
>  let name =    "ListComprehension";;
>  let version = "$Id: ListComprehension";;
> end
> 
> module Make (Syntax : Sig.Camlp4Syntax) = struct
> 
> open Sig;;
> include Syntax;;
> 
> let rec safe_nth n = function
>  | [] -> None
>  | [(x,_)] -> if n = 1 then Some x else None
>  | _ :: l -> safe_nth (n - 1) l
> ;;
> 
> let stream_peek_nth n s = safe_nth n (Stream.npeek n s);;
> 
> let lc_generator = Gram.Entry.of_parser "lc_generator" (fun s ->
>  let rec skip_patt n = match stream_peek_nth n s 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 s 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
> );;
> 
> let var = ref 0;;
> let fresh () = incr var; !var;;
> 
> let rec compr _loc e acc = function
>  | [] -> <:expr< $e$::$acc$ >>
>  | `filter b :: qs -> <:expr< if $b$ then $compr _loc e acc qs$ else $acc$ >>
>  | `gen (p, l1) :: qs ->
>  let h  = Format.sprintf "__h__%i" (fresh ()) in
>  let u  = Format.sprintf "__u__%i" (fresh ()) in
>  let us = Format.sprintf "__us__%i" (fresh ()) in
>  <:expr<
>   let rec $lid:h$ = function
>    | [] -> $acc$
>    | $lid:u$ :: $lid:us$ -> $if Ast.is_irrefut_patt p then
>     <:expr< (fun $p$ -> $compr _loc e <:expr< ($lid:h$ $lid:us$) >> qs$) $lid:u$ >>
>    else
>     <:expr<
>      (function $p$ ->
>       $compr _loc e <:expr< ($lid:h$ $lid:us$) >> qs$ | _ -> $lid:h$ $lid:us$) $lid:u$
>     >>
>    $
>   in $lid:h$ $l1$
>  >>
>  | _ -> <:expr< [] >>
> ;;
> 
> let list_comprehension = Gram.Entry.mk "list_comprehension";;
> 
> DELETE_RULE Gram expr: "["; sem_expr_for_list; "]" END;;
> 
> EXTEND Gram
>  GLOBAL: expr list_comprehension;
>  expr: LEVEL "simple" [
>   [ "["; e = list_comprehension; "]" -> e]
>  ];
>  list_comprehension: [
>   [ 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 quantifier SEP ";" ->
>    compr _loc e <:expr< [] >> l
>   | e = expr LEVEL "top" -> <:expr< [$e$] >> ]
>  ];
>  quantifier: [
>   [ lc_generator; p = patt; "<-"; e = expr LEVEL "top" -> `gen (p, e)
>   | e = expr LEVEL "top" -> `filter e ]
>  ];
> END;;
> 
> end
> 
> let module M = Register.OCamlSyntaxExtension Id Make in ();;
> -------------------------------------------------------------------------
> On Tue, Jan 22, 2008 at 02:42:00PM +0100, Nicolas Pouillard wrote:
> > Excerpts from christian.sternagel's message of Tue Jan 22 14:33:55 +0100 2008:
> > > > > How about the transformation from Chapter 7 of [1] (by Philip Wadler)?
> > > > > It should be similar to the `pseudo code':
> > > > > 
> > > > > type expr = ...;;
> > > > > type patt = ...;;
> > > > > type qualifier = Gen of patt * expr | Filt of expr;;
> > > > > type compr = (expr * qualifier list);;
> > > > > let rec expr = function
> > > > >  | ...
> > > > >  | (e, qs) -> transform [] (e, qs)
> > > > >  | ...
> > > > > and transform l = function
> > > > >  | (e, []) -> expr e :: expr l
> > > > >  | (e, Filt f :: qs) -> if expr f then transform l (e, qs) else expr l
> > > > >  | (e, Gen (p, l1) :: qs) ->
> > > > >   let rec h = function
> > > > >    | [] -> expr l
> > > > >    | u :: us -> (function p -> transform (h us) (e, qs) | _ -> h us) u
> > > > >   in h (expr l1)
> > > > > ;;
> > > > > 
> > > > > (* where h, u, us are fresh variables not occurring in e, l1, l, or qs *)
> > > > > 
> > > > > Sorry I'm not yet familiar with camlp4 grammar extensions, but of course
> > > > > above code would make use of them otherwise.
> > > > 
> > > > Yes this approach can be integrated with a camlp4 extension.
> > > > 
> > > > > It is stated in [1] that the resulting code is optimal in that it
> > > > > performs the minimum number of cons operations.
> > > > 
> > > > Nice.
> > > > 
> > > > > And I did ignore the hint that fresh variables make things
> > > > > complicated :).
> > > > 
> > > > Yes it can...
> > > > 
> > > > Best regards,
> > > > 
> > > > -- 
> > > > Nicolas Pouillard aka Ertai
> > > > 
> > > I deduce that there is no standard way of introducing
> > > `fresh' (w.r.t. the abstract syntax tree) variables
> > > within a camlp4 syntax extension? Wouldn't that be nice? =)
> > > 
> > 
> > That  would be nice, but doing it cleanly would require a large amount of work
> > and user visible changes.
> > 
> > -- 
> > Nicolas Pouillard aka Ertai
> 

-- 
Nicolas Pouillard aka Ertai