Re: [Caml-list] First order compile time functorial polymorphism in Ocaml

[Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>]

From: "Jacques Carette" <carette@mcmaster.ca>

> I most certainly would welcome such a set of tools for reuse.
> 
> Has anyone seriously looked (from an ML point of view) at the "scrap
> your boilerplate" paper from the Haskell crowd ?
> 
> When faced with the following issue myself for a 'monster' algebraic
> datatype (but containing no negatives), I wrote the code found
> below.  I would welcome any and all criticisms of it [the code works
> and is useful, but is doubtless a horrible hack].
> 
> Jacques

My standard way to approach such problems is to use open recursion: I
find it simpler and more general. Yet you have to understand fixpoints
to use it properly.

let map_one f = function
  | Msum x -> Msum (List.map f x)
  | Mprod x -> Mprod (List.map f x)
  | Mpow(x,y) -> Mpow (f x, fy)
  ...
  | Mstateseq x -> Mstateseq (List.map f x)
  | Mint _ | Mbool _ | Mfloat _ | Mstring _ | Mlocal _
  | Mexport _ | Mparam _ as x -> x

Then you can derive all other mapping functions easily.

let rec generic_traverse filter f x =
  let z = map_one (generic_traverse filter f) x in
  if filter z then f z else z

let rec deep_map f x = f (map_one f x)

etc...

Or you can use it directly

let rec flatten x =
  match map_one flatten x with
  | Mlist x -> List.map Simpl.flatten x
  | Mseq x -> List.map Simpl.flatten2 x
  | x ->  x

Jacques (aussi)

Your original code:
> (* part of a toy interpreted for a Maple-like language *)
> open Maple;;
> 
> let rec generic_traverse filter f x = 
>     let traverse r = generic_traverse filter f r in
>     let activate z = if filter z then f z else z in
>     let tt = function
>     | Mint x as z -> activate z
>     | Mbool x as z -> activate z
>     | Mfloat(x,y) as z -> activate z
>     | Mname x as z -> activate z
>     | Mstring x as z -> activate z
>     | Mlocal x as z -> activate z
>     | Mexport x as z -> activate z
>     | Mparam x as z -> activate z
>     | Msum x -> activate(Msum (List.map traverse x))
>     | Mprod x -> activate(Mprod (List.map traverse x))
>     | Mpow(x,y) -> activate(Mpow(traverse x, traverse y))
>     | Mcomp(o,x,y) -> activate(Mcomp(o, traverse x, traverse y))
>     | Mtableref(n,i) -> activate(Mtableref( traverse n, List.map traverse i))
>     | Mnot x -> activate(Mnot(traverse x))
>     | Mand(x,y) -> activate(Mand(traverse x, traverse y))
>     | Mor(x,y) -> activate(Mor(traverse x, traverse y))
>     | Mxor(x,y) -> activate(Mxor(traverse x, traverse y))
>     | Mimplies(x,y) -> activate(Mimplies(traverse x, traverse y))
>     | Mrange(x,y) -> activate(Mrange(traverse x, traverse y))
>     | Mproc x -> 
>         let f = function
>             | None -> None
>             | Some z -> Some(traverse z) in
>         let y=f x.mresult_type in 
>         activate(Mproc( {
>             mparams = List.map traverse x.mparams;
>             mresult_type = y;
>             mlocals = List.map traverse x.mlocals;
>             mclosure = x.mclosure; (* do not traverse the closure! *)
>             moptions = List.map traverse x.moptions;
>             mdescription = List.map traverse x.mdescription;
>             mbody = List.map traverse x.mbody
>             } ))
>     | Mmodule x -> activate(Mmodule( {
>         mmod_params = List.map traverse x.mmod_params;
>         mmod_locals = List.map traverse x.mmod_locals;
>         mmod_exports = List.map traverse x.mmod_exports;
>         mmod_closure = x.mmod_closure; (* do not traverse the closure! *)
>         mmod_options = List.map traverse x.mmod_options;
>         mmod_description = List.map traverse x.mmod_description;
>         mbody_of_module = List.map traverse x.mbody_of_module
>         } ))
>     | Mfunc(n,i) -> activate(Mfunc( traverse n, List.map traverse i))
>     | Mforfrom(i,ifrom,ito,iby,iwhile,body) ->
>             activate(Mforfrom(traverse i, traverse ifrom, traverse ito,
>                 traverse iby, traverse iwhile, List.map traverse body))
>     | Mforin(i,iin,iwhile,body) ->
>             activate(Mforin(traverse i, traverse iin, traverse iwhile,
>                 List.map traverse body))
>     | Mreturn x -> activate(Mreturn(traverse x))
>     | Merror x -> activate(Merror(traverse x))
>     | Mread x -> activate(Mread(traverse x))
>     | Muneval x -> activate(Muneval(traverse x))
>     | Msave x -> activate(Msave(List.map traverse x))
>     | Mdcolon(x,y) -> activate(Mdcolon(traverse x, traverse y))
>     | Massign(x,y) -> activate(Massign(List.map traverse x, List.map traverse y))
>     | Mseq x -> activate(Mseq(List.map traverse x))
>     | Mlist x -> activate(Mlist(List.map traverse x))
>     | Mif (x,y,z) -> activate(Mif( (traverse x), (traverse y), (traverse z) ))
>     | Mstatseq x -> activate(Mstatseq(List.map traverse x))
>     (*| _ as x -> activate x *)
>     in
>     tt x
>       ;;
> 
> (* example [fake] use *)
> 
> let filt = function
>      | Mlist _ | Mseq _ -> true
>      | _ -> false
> and
>      do_something = function
>      | Mlist x -> List.map Simpl.flatten x
>      | Mseq x -> List.map Simpl.flatten2 x
>      | _ -> raise CannotHappenButCompilerCantKnowIt ;;

---------------------------------------------------------------------------
Jacques Garrigue      Kyoto University     garrigue at kurims.kyoto-u.ac.jp
		<A HREF=http://wwwfun.kurims.kyoto-u.ac.jp/~garrigue/>JG</A>

-------------------
To unsubscribe, mail caml-list-request@inria.fr Archives: http://caml.inria.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/
Beginner's list: http://groups.yahoo.com/group/ocaml_beginners