* Re: [Caml-list] Re: instanciation of functor using command line
[not found] ` <46C99CC3.7000508@irisa.fr>
@ 2007-08-20 16:41 ` Virgile Prevosto
0 siblings, 0 replies; 5+ messages in thread
From: Virgile Prevosto @ 2007-08-20 16:41 UTC (permalink / raw)
To: Thomas Gazagnaire; +Cc: Caml list
[-- Attachment #1: Type: text/plain, Size: 698 bytes --]
Le lun 20 aoû 2007 15:53:07 CEST,
Thomas Gazagnaire <thomas.gazagnaire@irisa.fr> a écrit :
> Virgile Prevosto a écrit :
> > In fact, I've written something like that some time ago. If someone
> > is interested, I might try to find the code (and maybe adapt it to
> > 3.10).
> >
>
> I am interested :)
OK. After re-reading the code, I'm not completely sure that it'll do
exactly what you want, but it is attached to this mail, with a very
small example of the syntactic constructions it defines. It should
compile with ocaml 3.09.2
(ocamlc -c -pp "camlp4o pa_extend.cmo q_MLast.cmo -impl" -impl
choose_module.ml4)
--
E tutto per oggi, a la prossima volta.
Virgile
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: choose_module.ml4 --]
[-- Type: text/x-ocaml; name=choose_module.ml4, Size: 5894 bytes --]
(* Copyright (c) 2004-2007, Virgile Prevosto
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* * Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* * The names of its contributors may not be used to endorse or promote
* products derived from this software without specific prior
* written permission.
*
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
* DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY
* DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
(** syntactic sugar to choose modules implementation according to some
condition.
*)
(* incompatible with ocaml 3.10. Usage:
ocamlc -pp camlp4o choose_module.cmo file.ml
added expressions:
choose_module M = match e with Foo when true -> M1 | _ -> Mdefault in M.x
register_module "ident" M1,M2,M3 in choice
select_module A from choice using e with F in A.x
register and select use an intermediate file, choice.p4o, written by
register and read by select. if e is equal to "ident", then A will be
bound to F(M1,M2,M3)
*)
open Pcaml
let choices = Grammar.Entry.create Pcaml.gram "choices"
(* extension of file storing list of module choices. *)
let ext = ".p4o"
let open_path open_func f =
if Sys.file_exists f then
open_func f
else
let rec try_dir lst =
match lst with
[] -> raise Not_found
| a::l ->
let fpath = Filename.concat a f in
if Sys.file_exists fpath then
open_func fpath
else try_dir l
in try_dir !Odyl_main.path
let open_in_path = open_path open_in_bin
let open_out_path = open_path open_out_bin
let make_one_choice a mod_expr exp =
let _loc = Lexing.dummy_pos, Lexing.dummy_pos in
<:expr<let module $uid:a$ = $mod_expr$ in $exp$>>
EXTEND
expr: [[
"choose_module"; a = UIDENT; "="; "match" ; cond = expr; "with";
OPT "|"; l = LIST1 choices SEP "|";
"in"; e = expr ->
let new_l = List.map
(fun (patt,optwhen,expr) ->
(patt,optwhen, make_one_choice a expr e)) l
in <:expr< match $cond$ with [$list:new_l$] >>
| "register_module"; opt=STRING; l=LIST1 module_expr SEP ","; "in";
store = LIDENT ->
let filename = store ^ ext in
let current_table =
try
let chan = open_in_path filename in
let res = Marshal.from_channel chan in
close_in chan; res
with Not_found | End_of_file -> Hashtbl.create 7
in
Hashtbl.replace current_table opt l;
let chan =
try open_out_path filename
with Not_found -> open_out_bin filename
in
Marshal.to_channel chan current_table [];
flush chan; close_out chan;
<:expr< $str:opt$ >>
| "select_module"; a = UIDENT; "from"; store = LIDENT; "using";
choice = expr;
post_process = OPT ["with"; m = module_expr -> m];
"in"; e = expr ->
let apply f x = <:module_expr< $f$ $x$>> in
let create_mod_value l =
match post_process with
None -> List.hd l
| Some s -> List.fold_left apply s l
in
let selection =
try
let chan = open_in_path (store ^ ext) in
let res =
Marshal.from_channel chan
in close_in chan; res
with Not_found | End_of_file ->
Hashtbl.create 1
in
let patts =
Hashtbl.fold
(fun patt -> fun mod_expr_list -> fun l ->
(<:patt<$str:patt$>>, None,
make_one_choice a
(create_mod_value mod_expr_list) e)
:: l)
selection [ <:patt< _ >>, None,
<:expr< failwith
("not a valid option for selection of "
^ $str:store$)>>
]
in <:expr< match $choice$ with [$list:patts$]>>
]];
choices: [[ p=patt; w = OPT ["when"; e = expr -> e]; "->"; m = module_expr ->
(p,w,m)
]];
END
^ permalink raw reply [flat|nested] 5+ messages in thread