From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: X-Original-To: caml-list@sympa.inria.fr Delivered-To: caml-list@sympa.inria.fr Received: from mail2-relais-roc.national.inria.fr (mail2-relais-roc.national.inria.fr [192.134.164.83]) by sympa.inria.fr (Postfix) with ESMTPS id C1AE57FADB for ; Mon, 3 Nov 2014 15:13:57 +0100 (CET) Received-SPF: None (mail2-smtp-roc.national.inria.fr: no sender authenticity information available from domain of christoph.hoeger@tu-berlin.de) identity=pra; client-ip=130.149.7.33; receiver=mail2-smtp-roc.national.inria.fr; envelope-from="christoph.hoeger@tu-berlin.de"; x-sender="christoph.hoeger@tu-berlin.de"; x-conformance=sidf_compatible Received-SPF: None (mail2-smtp-roc.national.inria.fr: no sender authenticity information available from domain of christoph.hoeger@tu-berlin.de) identity=mailfrom; client-ip=130.149.7.33; receiver=mail2-smtp-roc.national.inria.fr; envelope-from="christoph.hoeger@tu-berlin.de"; x-sender="christoph.hoeger@tu-berlin.de"; x-conformance=sidf_compatible Received-SPF: None (mail2-smtp-roc.national.inria.fr: no sender authenticity information available from domain of postmaster@mail.tu-berlin.de) identity=helo; client-ip=130.149.7.33; receiver=mail2-smtp-roc.national.inria.fr; envelope-from="christoph.hoeger@tu-berlin.de"; x-sender="postmaster@mail.tu-berlin.de"; x-conformance=sidf_compatible X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: Aq0BAEKNV1SClQchnGdsb2JhbABchDrVVwKBIBYBAQEBAREBAQEBAQYNCQkULoQDAQEEJwsBRRELIRYPCQMCAQIBRQYNBgIBAReIJgTHWCyQXTqESwWTJZJMkGAegVtrgksBAQE X-IPAS-Result: Aq0BAEKNV1SClQchnGdsb2JhbABchDrVVwKBIBYBAQEBAREBAQEBAQYNCQkULoQDAQEEJwsBRRELIRYPCQMCAQIBRQYNBgIBAReIJgTHWCyQXTqESwWTJZJMkGAegVtrgksBAQE X-IronPort-AV: E=Sophos;i="5.07,308,1413237600"; d="scan'208";a="104428854" Received: from mail.tu-berlin.de ([130.149.7.33]) by mail2-smtp-roc.national.inria.fr with ESMTP/TLS/DHE-RSA-AES256-SHA; 03 Nov 2014 15:13:42 +0100 X-tubIT-Incoming-IP: 91.66.251.158 Received: from ip5b42fb9e.dynamic.kabel-deutschland.de ([91.66.251.158] helo=[192.168.178.21]) by mail.tu-berlin.de (exim-4.72/mailfrontend-6) with esmtpa for id 1XlIO4-0002ph-4b; Mon, 03 Nov 2014 15:13:41 +0100 Message-ID: <54578D94.6070001@tu-berlin.de> Date: Mon, 03 Nov 2014 15:13:40 +0100 From: =?ISO-8859-15?Q?Christoph_H=F6ger?= Organization: Technische =?ISO-8859-15?Q?Universit=E4t_Berlin?= User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:31.0) Gecko/20100101 Thunderbird/31.2.0 MIME-Version: 1.0 To: "caml-list@inria.fr >> caml users" References: <20141101125425.90219C38B8@www1.g3.pair.com> In-Reply-To: <20141101125425.90219C38B8@www1.g3.pair.com> Content-Type: text/plain; charset=iso-8859-15 Content-Transfer-Encoding: 8bit X-PMX-Version: 6.0.0.2142326, Antispam-Engine: 2.7.2.2107409, Antispam-Data: 2014.11.3.140320 X-PMX-Spam: Gauge=IIIIIII, Probability=0%, Report='' Subject: Re: [Caml-list] is it possible to embed an OCaml interpreter into an OCaml Module? -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 Thanks for the hint. I wasn't able to figure out, how MetaOCaml does the trick, though. So, here is my solution. The trick is to store away the old "toploop" global variable from the Symtable module. This seems to work, although it looks a bit hacky. I am unsure whether this works _outside_ of a toplevel. The sane way would be to also fork Translmod and add a completely new global variable for my interpreter, but that seems to be impossible (adding that global variable programatically). I do not understand, why there is no API dealing with it. Is there a deeper reason? let toploop_id = Ident.create_persistent "Toploop" let execute_phrase print_outcome ppf phr = match phr with | Ptop_def sstr -> let outer_toploop = Symtable.get_global_value toploop_id in let _ = Symtable.assign_global_value toploop_id (Obj.repr toplevel_value_api) in let oldenv = !toplevel_env in Typecore.reset_delayed_checks (); let (str, sg, newenv) = Typemod.type_toplevel_phrase oldenv sstr in if !Clflags.dump_typedtree then Printtyped.implementation ppf str; let sg' = Typemod.simplify_signature sg in ignore (Includemod.signatures oldenv sg sg'); Typecore.force_delayed_checks (); let lam = Translmod.transl_toplevel_definition str in Warnings.check_fatal (); begin try toplevel_env := newenv; let res = load_lambda ppf lam in let out_phr = match res with | Result v -> let res = if print_outcome then Printtyp.wrap_printing_env oldenv (fun () -> match str.str_items with | [ { str_desc = Tstr_eval (exp, _attrs) }] -> let outv = outval_of_value newenv v exp.exp_type in let ty = Printtyp.tree_of_type_scheme exp.exp_type in Ophr_eval (outv, ty) | [] -> Ophr_signature [] | _ -> Ophr_signature (item_list newenv sg')) else Ophr_signature [] in Symtable.assign_global_value toploop_id outer_toploop ; res | Exception exn -> Symtable.assign_global_value toploop_id outer_toploop ; toplevel_env := oldenv; if exn = Out_of_memory then Gc.full_major(); let outv = outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn in Ophr_exception (exn, outv) in !print_out_phrase ppf out_phr; begin match out_phr with | Ophr_eval (_, _) | Ophr_signature _ -> true | Ophr_exception _ -> false end with x -> toplevel_env := oldenv; raise x end | Ptop_dir(dir_name, dir_arg) -> let d = try Some (Hashtbl.find directive_table dir_name) with Not_found -> None in begin match d with | None -> fprintf ppf "Unknown directive `%s'.@." dir_name; false | Some d -> match d, dir_arg with | Directive_none f, Pdir_none -> f (); true | Directive_string f, Pdir_string s -> f s; true | Directive_int f, Pdir_int n -> f n; true | Directive_ident f, Pdir_ident lid -> f lid; true | Directive_bool f, Pdir_bool b -> f b; true | _ -> fprintf ppf "Wrong type of argument for directive `%s'.@." dir_name; false end - -- Christoph Höger Technische Universität Berlin Fakultät IV - Elektrotechnik und Informatik Übersetzerbau und Programmiersprachen Sekr. TEL12-2, Ernst-Reuter-Platz 7, 10587 Berlin Tel.: +49 (30) 314-24890 E-Mail: christoph.hoeger@tu-berlin.de -----BEGIN PGP SIGNATURE----- Version: GnuPG v1 iEYEARECAAYFAlRXjZMACgkQhMBO4cVSGS946ACdG788ViovGE5X6j0XbuswsZ3z uJ4An2BXxlFRMSiagkIYi9EQb0SqrHwz =xCBd -----END PGP SIGNATURE-----