problems with the new camlp4 (again)

problems with the new camlp4 (again)

[Benedikt Grundmann]

Hi everybody,

Sorry to bother you again.  Here my next problem:

Given a description of a constructor with arguments (name and number
of arguments), I want to generate a function which given a tuple of
that many elements returns the constructor applied to the arguments
and another function which given a value constructed by that
constructor returns the arguments as a tuple.

Example:

type foo = Bar of t1 * t2

description would be ("Bar", 2)

generated functions:

let wrap (a, b) = Bar (a,b)

let unwrap (Bar (a, b)) = (a, b)

Right now I do that by writing lots of special cases (one for each
arity up to a limit).  But how can I do it in a generic way?

Current solution:

let gen_wrap c =
  let _loc = c.cons_loc in
  let n    = List.length c.cons_args in
  match n with
    | 1 -> <:expr< fun a -> $uid:c.cons_name$ a >>
    | 2 -> <:expr< fun (a, b) -> $uid:c.cons_name$ a b >>
    | 3 -> <:expr< fun (a, b, c) -> $uid:c.cons_name$ a b c >>
    | 4 -> <:expr< fun (a, b, c, d) -> $uid:c.cons_name$ a b c d >>
    | _ -> assert false

let gen_unwrap c =
  let _loc = c.cons_loc in
  let n    = List.length c.cons_args in
  let case =
    match n with
      | 1 -> <:match_case< $uid:c.cons_name$ a -> a >>
      | 2 -> <:match_case< $uid:c.cons_name$ a b -> (a, b) >>
      | 3 -> <:match_case< $uid:c.cons_name$ a b c -> (a,b,c) >>
      | 4 -> <:match_case< $uid:c.cons_name$ a b c d -> (a,b,c,d) >>
      | _ -> assert false
  in
  <:expr< fun c -> match c with [ $case$ | _ -> assert False ] >>


You can have a look at the "complete" syntax extension here:

http://osprepo.janestcapital.com/trac/osp2007/browser/osp/2007/econcurrency/trunk/src/pa_pickle.ml

Thanks in advance for any help :-)

Cheers,

Bene


-- 
Calvin: I try to make everyone's day a little more
surreal.

(From Calvin & Hobbes)

Re: [Caml-list] problems with the new camlp4 (again)

[Bruno De Fraine]

On 03 Jul 2007, at 21:59, Benedikt Grundmann wrote:
> description would be ("Bar", 2)
>
> generated functions:
>
> let wrap (a, b) = Bar (a,b)
>
> let unwrap (Bar (a, b)) = (a, b)

Given a function to generate variable names:

let var_name =
   let b = int_of_char 'a' in
   fun i -> String.make 1 (char_of_int (b+i))
;;

and some copy-pasted auxiliary functions:

let rec fold_range f accu l u =
   if l < u then let u = u - 1 in fold_range f (f accu u) l u else accu
;;

let lid_patt _loc n = <:patt< $lid:n$ >> ;;
let lid_expr _loc n = <:expr< $lid:n$ >> ;;

let tuple_patt _loc = function
   | [] -> <:patt< () >>
   | [p] -> p
   | p::ps -> <:patt< ($p$,$list:ps$) >>
;;

let expr_of_cons _loc n es =
   List.fold_left (fun acc e ->
     <:expr< $acc$ $e$ >>
   ) <:expr< $uid:n$ >> es
;;

This is quite trivial:

let gen_wrap _loc (n,i) =
   let var_names = fold_range (fun l c -> (var_name c)::l) [] 0 i in
   let
     patt = tuple_patt _loc (List.map (lid_patt _loc) var_names) and
     expr = expr_of_cons _loc n (List.map (lid_expr _loc) var_names)
   in <:expr< fun $patt$ -> $expr$ >>
;;

Test:

# let _loc = Loc.ghost in
   (gen_wrap _loc ("Bar",2) = <:expr< fun (a,b) -> Bar a b >>) ;;
- : bool = true

I'll leave "gen_unwrap" as an exercise.

Regards,
Bruno

--
Bruno De Fraine
Vrije Universiteit Brussel
Faculty of Applied Sciences, DINF - SSEL
Room 4K208, Pleinlaan 2, B-1050 Brussels
tel: +32 (0)2 629 29 75
fax: +32 (0)2 629 28 70
e-mail: Bruno.De.Fraine@vub.ac.be