Version française
Home     About     Download     Resources     Contact us    
Browse thread
problems with the new camlp4 (again)
[ Home ] [ Index: by date | by threads ]
[ Search: ]

[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
Date: -- (:)
From: Benedikt Grundmann <benedikt-grundmann@w...>
Subject: problems with the new camlp4 (again)
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)