From 89b2b30d4a1f953f08aa28fac3ad7a404151a579 Mon Sep 17 00:00:00 2001 From: Drup Date: Thu, 28 Jul 2016 00:49:07 +0200 Subject: [PATCH 01/23] Remove is_global from the API. --- src/lib/eliom_syntax.server.ml | 16 ++++------------ src/lib/eliom_syntax.server.mli | 6 ------ src/lib/server/eliommod.ml | 3 --- 3 files changed, 4 insertions(+), 21 deletions(-) diff --git a/src/lib/eliom_syntax.server.ml b/src/lib/eliom_syntax.server.ml index 3fb7550bac..c2549eaaa8 100644 --- a/src/lib/eliom_syntax.server.ml +++ b/src/lib/eliom_syntax.server.ml @@ -113,18 +113,12 @@ let get_request_data () = (* Register data *) -let is_global = ref false - let register_client_value_data ~closure_id ~args ~value = let client_value_datum = { Eliom_runtime.closure_id; args; value } in - if !is_global then - if Eliom_common.get_sp_option () = None then - current_server_section_data := - client_value_datum :: !current_server_section_data - else - raise (Eliom_client_value.Client_value_creation_invalid_context - closure_id) + if Eliom_common.get_sp_option () = None then + current_server_section_data := + client_value_datum :: !current_server_section_data else Eliom_reference.Volatile.modify request_data (fun sofar -> client_value_datum :: sofar) @@ -139,7 +133,7 @@ let last_id = ref 0 let client_value ?pos closure_id args = let instance_id = - if !is_global then begin + if Eliom_common.get_sp_option () = None then begin incr last_id; !last_id end else @@ -149,5 +143,3 @@ let client_value ?pos closure_id args = register_client_value_data ~closure_id ~args:(Eliom_lib.to_poly args) ~value; Eliom_client_value.client_value_from_server_repr value - -let set_global b = is_global := b diff --git a/src/lib/eliom_syntax.server.mli b/src/lib/eliom_syntax.server.mli index cebdc9fd06..0ac800a0dc 100644 --- a/src/lib/eliom_syntax.server.mli +++ b/src/lib/eliom_syntax.server.mli @@ -30,12 +30,6 @@ val client_value : ?pos:Eliom_lib.pos -> string -> 'args -> 'a Eliom_client_value.t -(** All client values created between [set_global true] and - [set_global false] are considered global client values - (cf. <>). *) -val set_global : bool -> unit - (** Called at the end of each server or shared section. The argument identifies the compilation unit. diff --git a/src/lib/server/eliommod.ml b/src/lib/server/eliommod.ml index c684252cfe..630e944a5f 100644 --- a/src/lib/server/eliommod.ml +++ b/src/lib/server/eliommod.ml @@ -640,10 +640,7 @@ let load_eliom_module sitedata cmo_or_name parent_tag content = config := content; config_in_tag := parent_tag; Eliom_common.begin_load_eliom_module (); - (* I want to be able to define global client values during that phase: *) - Eliom_syntax.set_global true; List.iter (fun f -> f ()) !site_init_ref; - Eliom_syntax.set_global false in let postload () = Eliom_common.end_load_eliom_module (); From 8d23f9d0cb3d294f98a4589dced82ae406da0ee6 Mon Sep 17 00:00:00 2001 From: Drup Date: Mon, 1 Aug 2016 17:26:54 +0200 Subject: [PATCH 02/23] Don't emit set_global in the ppx. --- src/ppx/ppx_eliom_client.ml | 1 - src/ppx/ppx_eliom_server.ml | 9 +-------- src/ppx/ppx_eliom_type.ml | 7 +++++-- src/ppx/ppx_eliom_utils.ml | 4 +--- src/ppx/ppx_eliom_utils.mli | 1 - 5 files changed, 7 insertions(+), 15 deletions(-) diff --git a/src/ppx/ppx_eliom_client.ml b/src/ppx/ppx_eliom_client.ml index d74046c433..9a393a1ba9 100644 --- a/src/ppx/ppx_eliom_client.ml +++ b/src/ppx/ppx_eliom_client.ml @@ -254,7 +254,6 @@ module Pass = struct let client_sig item = [item] let prelude _ = [] - let postlude _ = [] end diff --git a/src/ppx/ppx_eliom_server.ml b/src/ppx/ppx_eliom_server.ml index 7b8734c479..82b3289507 100644 --- a/src/ppx/ppx_eliom_server.ml +++ b/src/ppx/ppx_eliom_server.ml @@ -200,14 +200,7 @@ module Pass = struct push_injection ?ident id.txt expr; eid id - let set_global ~loc b = - let b = Exp.construct ~loc - {loc ; txt = Longident.Lident (if b then "true" else "false")} None - in - [%stri let () = Eliom_syntax.set_global [%e b ] ] - - let prelude loc = [ set_global ~loc true ] - let postlude loc = [ set_global ~loc false ] + let prelude _loc = [] let shared_sig item = [item] let server_sig item = [item] diff --git a/src/ppx/ppx_eliom_type.ml b/src/ppx/ppx_eliom_type.ml index a6741c9461..0e9e16307d 100644 --- a/src/ppx/ppx_eliom_type.ml +++ b/src/ppx/ppx_eliom_type.ml @@ -130,8 +130,11 @@ module Pass = struct | `Injection `Shared -> expr | `Injection `Client -> [%expr assert false] - let prelude _ = [] - let postlude _ = [] + let prelude loc = + let txt = + Printf.sprintf "__eliom__compilation_unit_id__%s" (file_hash loc) in + let id = Pat.var ~loc { loc ; txt } in + [%str let [%p id] = () ] let shared_sig _ = [] let server_sig _ = [] diff --git a/src/ppx/ppx_eliom_utils.ml b/src/ppx/ppx_eliom_utils.ml index 9105a34a63..20fb48901c 100644 --- a/src/ppx/ppx_eliom_utils.ml +++ b/src/ppx/ppx_eliom_utils.ml @@ -322,7 +322,6 @@ module type Pass = sig expression -> expression val prelude : loc -> structure - val postlude : loc -> structure end @@ -647,8 +646,7 @@ module Make (Pass : Pass) = struct let loc = {(file_position structs) with loc_ghost = true} in module_hash_declaration loc :: Pass.prelude loc @ - flatmap f structs @ - Pass.postlude loc + flatmap f structs let toplevel_signature context mapper sigs = let f psig = diff --git a/src/ppx/ppx_eliom_utils.mli b/src/ppx/ppx_eliom_utils.mli index 4b33cb5669..3ceac0ec6e 100644 --- a/src/ppx/ppx_eliom_utils.mli +++ b/src/ppx/ppx_eliom_utils.mli @@ -80,7 +80,6 @@ module type Pass = sig expression -> expression val prelude : Location.t -> structure - val postlude : Location.t -> structure end From 11dc82aeaccc2e4617b3e77a393eadef3a679293 Mon Sep 17 00:00:00 2001 From: Drup Date: Mon, 1 Aug 2016 18:34:50 +0200 Subject: [PATCH 03/23] Big renaming Eliom_runtime -> Eliom_serial (shared) Eliom_syntax -> Eliom_runtime (server) Eliom_client_core.Syntax_helper -> Eliom_runtime (client) Eliom_syntax.client_value -> Eliom_runtime.fragment (server) --- pkg/filelist.ml | 4 +- src/lib/client/eliommod_dom.ml | 36 +++++----- src/lib/eliom_client.client.ml | 8 +-- src/lib/eliom_client_core.client.ml | 72 +++++++------------ src/lib/eliom_client_value.client.ml | 2 +- src/lib/eliom_client_value.client.mli | 2 +- src/lib/eliom_client_value.server.ml | 12 ++-- src/lib/eliom_client_value.server.mli | 8 +-- src/lib/eliom_comet.server.ml | 2 +- src/lib/eliom_common.server.mli | 8 +-- src/lib/eliom_common_base.shared.ml | 14 ++-- src/lib/eliom_content.server.mli | 4 +- src/lib/eliom_content_core.client.ml | 4 +- src/lib/eliom_content_core.server.ml | 6 +- src/lib/eliom_content_core.server.mli | 4 +- src/lib/eliom_registration.server.ml | 30 ++++---- src/lib/eliom_request_info.client.ml | 4 +- src/lib/eliom_runtime.client.ml | 33 +++++++++ src/lib/eliom_runtime.client.mli | 32 +++++++++ ...ntax.server.ml => eliom_runtime.server.ml} | 31 +++++--- ...ax.server.mli => eliom_runtime.server.mli} | 26 ++++--- ...ntime.shared.ml => eliom_serial.shared.ml} | 0 ...ime.shared.mli => eliom_serial.shared.mli} | 2 +- src/lib/eliom_unwrap.client.mli | 2 +- src/ppx/ppx_eliom_client.ml | 8 +-- src/ppx/ppx_eliom_server.ml | 8 +-- src/ppx/ppx_eliom_type.ml | 2 +- src/syntax/pa_eliom_client_server.ml | 14 ++-- src/syntax/pa_eliom_type_filter.ml | 4 +- 29 files changed, 224 insertions(+), 158 deletions(-) create mode 100644 src/lib/eliom_runtime.client.ml create mode 100644 src/lib/eliom_runtime.client.mli rename src/lib/{eliom_syntax.server.ml => eliom_runtime.server.ml} (87%) rename src/lib/{eliom_syntax.server.mli => eliom_runtime.server.mli} (74%) rename src/lib/{eliom_runtime.shared.ml => eliom_serial.shared.ml} (100%) rename src/lib/{eliom_runtime.shared.mli => eliom_serial.shared.mli} (99%) diff --git a/pkg/filelist.ml b/pkg/filelist.ml index 9023b484f1..22448f0053 100644 --- a/pkg/filelist.ml +++ b/pkg/filelist.ml @@ -16,7 +16,7 @@ let server = { interface = [ "eliom_bus"; "eliom_client_value"; - "eliom_syntax"; + "eliom_runtime"; "eliom_client"; "eliom_comet"; "eliom_common"; @@ -44,7 +44,7 @@ let server = { internal = [ "eliom_comet_base"; "eliom_common_base"; - "eliom_runtime"; + "eliom_serial"; "eliom_content_"; "eliom_content_core"; "eliom_cookies_base"; diff --git a/src/lib/client/eliommod_dom.ml b/src/lib/client/eliommod_dom.ml index aeeeab3a4d..a890628392 100644 --- a/src/lib/client/eliommod_dom.ml +++ b/src/lib/client/eliommod_dom.ml @@ -101,36 +101,36 @@ let ancessor = let fast_select_request_nodes root = root##(querySelectorAll (Js.string - ("."^Eliom_runtime.RawXML.request_node_class))) + ("."^Eliom_serial.RawXML.request_node_class))) let fast_select_nodes root = if !Eliom_config.debug_timings then Firebug.console##(time (Js.string "fast_select_nodes")); let a_nodeList : Dom_html.element Dom.nodeList Js.t = root##(querySelectorAll - (Js.string ("a."^Eliom_runtime.RawXML.ce_call_service_class))) + (Js.string ("a."^Eliom_serial.RawXML.ce_call_service_class))) in let a_nodeList : Dom_html.anchorElement Dom.nodeList Js.t = Js.Unsafe.coerce a_nodeList in let form_nodeList : Dom_html.element Dom.nodeList Js.t = root##(querySelectorAll - (Js.string ("form."^Eliom_runtime.RawXML.ce_call_service_class))) + (Js.string ("form."^Eliom_serial.RawXML.ce_call_service_class))) in let form_nodeList : Dom_html.formElement Dom.nodeList Js.t = Js.Unsafe.coerce form_nodeList in let process_node_nodeList = root##(querySelectorAll - (Js.string ("."^Eliom_runtime.RawXML.process_node_class))) + (Js.string ("."^Eliom_serial.RawXML.process_node_class))) in let closure_nodeList = root##(querySelectorAll - (Js.string ("."^Eliom_runtime.RawXML.ce_registered_closure_class))) + (Js.string ("."^Eliom_serial.RawXML.ce_registered_closure_class))) in let attrib_nodeList = root##(querySelectorAll - (Js.string ("."^Eliom_runtime.RawXML.ce_registered_attr_class))) + (Js.string ("."^Eliom_serial.RawXML.ce_registered_attr_class))) in if !Eliom_config.debug_timings then Firebug.console##(timeEnd (Js.string "fast_select_nodes")); @@ -156,19 +156,19 @@ let slow_has_classes (node:Dom_html.element Js.t) = for i = 0 to (classes##.length) - 1 do found_call_service := (Js.array_get classes i - == Js.def (Js.string Eliom_runtime.RawXML.ce_call_service_class)) + == Js.def (Js.string Eliom_serial.RawXML.ce_call_service_class)) || !found_call_service; found_process_node := (Js.array_get classes i - == Js.def (Js.string Eliom_runtime.RawXML.process_node_class)) + == Js.def (Js.string Eliom_serial.RawXML.process_node_class)) || !found_process_node; found_closure := (Js.array_get classes i - == Js.def (Js.string Eliom_runtime.RawXML.ce_registered_closure_class)) + == Js.def (Js.string Eliom_serial.RawXML.ce_registered_closure_class)) || !found_closure; found_attrib := (Js.array_get classes i - == Js.def (Js.string Eliom_runtime.RawXML.ce_registered_attr_class)) + == Js.def (Js.string Eliom_serial.RawXML.ce_registered_attr_class)) || !found_attrib; done; !found_call_service,!found_process_node,!found_closure,!found_attrib @@ -179,24 +179,24 @@ let slow_has_request_class (node:Dom_html.element Js.t) = for i = 0 to (classes##.length) - 1 do found_request_node := (Js.array_get classes i - == Js.def (Js.string Eliom_runtime.RawXML.request_node_class)) + == Js.def (Js.string Eliom_serial.RawXML.request_node_class)) || !found_request_node; done; !found_request_node let fast_has_classes (node:Dom_html.element Js.t) = Js.to_bool (node##.classList##(contains - ((Js.string Eliom_runtime.RawXML.ce_call_service_class)))), + ((Js.string Eliom_serial.RawXML.ce_call_service_class)))), Js.to_bool (node##.classList##(contains - ((Js.string Eliom_runtime.RawXML.process_node_class)))), + ((Js.string Eliom_serial.RawXML.process_node_class)))), Js.to_bool (node##.classList##(contains - ((Js.string Eliom_runtime.RawXML.ce_registered_closure_class)))), + ((Js.string Eliom_serial.RawXML.ce_registered_closure_class)))), Js.to_bool (node##.classList##(contains - ((Js.string Eliom_runtime.RawXML.ce_registered_attr_class)))) + ((Js.string Eliom_serial.RawXML.ce_registered_attr_class)))) let fast_has_request_class (node:Dom_html.element Js.t) = Js.to_bool (node##.classList##(contains - ((Js.string Eliom_runtime.RawXML.request_node_class)))) + ((Js.string Eliom_serial.RawXML.request_node_class)))) let has_classes : Dom_html.element Js.t -> (bool*bool*bool*bool) = if test_classList () @@ -379,13 +379,13 @@ let copy_element (e:Dom.element Js.t) Js.Opt.iter (Dom_html.CoerceTo.element e) (fun e -> copy##.className := e##.className); let node_id = Js.Opt.to_option - (e##(getAttribute (Js.string Eliom_runtime.RawXML.node_id_attrib))) in + (e##(getAttribute (Js.string Eliom_serial.RawXML.node_id_attrib))) in match node_id with | Some id when registered_process_node id -> Js.Opt.iter (e##(getAttribute (Js.string "class"))) (fun classes -> copy##(setAttribute (Js.string "class") classes)); - copy##(setAttribute (Js.string Eliom_runtime.RawXML.node_id_attrib) id); + copy##(setAttribute (Js.string Eliom_serial.RawXML.node_id_attrib) id); Some copy | _ -> let add_attribute a = diff --git a/src/lib/eliom_client.client.ml b/src/lib/eliom_client.client.ml index 5d1c12ae2b..bf25db0c6b 100644 --- a/src/lib/eliom_client.client.ml +++ b/src/lib/eliom_client.client.ml @@ -63,7 +63,7 @@ let get_global_data () = match Eliom_unwrap.unwrap (Url.decode (Js.to_string v)) 0 with - | {Eliom_runtime.ecs_data = `Success v} -> + | {Eliom_serial.ecs_data = `Success v} -> Lwt_log.ign_debug_f "Unwrap __global_data success"; Some v | _ -> @@ -384,11 +384,11 @@ let window_open ~window_name ?window_features *) let unwrap_caml_content content = - let r : 'a Eliom_runtime.eliom_caml_service_data = + let r : 'a Eliom_serial.eliom_caml_service_data = Eliom_unwrap.unwrap (Url.decode content) 0 in - Lwt.return (r.Eliom_runtime.ecs_data, - r.Eliom_runtime.ecs_request_data) + Lwt.return (r.Eliom_serial.ecs_data, + r.Eliom_serial.ecs_request_data) let call_ocaml_service ?absolute ?absolute_path ?https ~service ?hostname ?port ?fragment diff --git a/src/lib/eliom_client_core.client.ml b/src/lib/eliom_client_core.client.ml index 0263fa2bb6..9ae2d7d520 100644 --- a/src/lib/eliom_client_core.client.ml +++ b/src/lib/eliom_client_core.client.ml @@ -113,7 +113,7 @@ end module Client_value : sig val find : instance_id:int -> poly option - val initialize : Eliom_runtime.client_value_datum -> unit + val initialize : Eliom_serial.client_value_datum -> unit end = struct let table = new%js Js.array_empty @@ -122,13 +122,13 @@ end = struct if instance_id = 0 then (* local client value *) None else Js.Optdef.to_option (Js.array_get table instance_id) - let initialize {Eliom_runtime.closure_id; args; value = server_value} = + let initialize {Eliom_serial.closure_id; args; value = server_value} = let closure = try Client_closure.find ~closure_id with Not_found -> let pos = - match Eliom_runtime.Client_value_server_repr.loc server_value + match Eliom_serial.Client_value_server_repr.loc server_value with | None -> "" | Some p -> Printf.sprintf "(%s)" (Eliom_lib.pos_to_string p) in @@ -140,7 +140,7 @@ end = struct Eliom_unwrap.late_unwrap_value server_value value; (* Only register global client values *) let instance_id = - Eliom_runtime.Client_value_server_repr.instance_id server_value in + Eliom_serial.Client_value_server_repr.instance_id server_value in if instance_id <> 0 then Js.array_set table instance_id value end @@ -180,7 +180,7 @@ end = struct Lwt_log.raise_error_f "Did not find injection %s" name)) let initialize ~compilation_unit_id - { Eliom_runtime.injection_id; injection_value } = + { Eliom_serial.injection_id; injection_value } = Lwt_log.ign_debug_f ~section "Initialize injection %d" injection_id; (* BBB One should assert that injection_value doesn't contain any value marked for late unwrapping. How to do this efficiently? *) @@ -193,8 +193,8 @@ end (* == Populating client values and injections by global data *) type compilation_unit_global_data = - { mutable server_section : Eliom_runtime.client_value_datum array list; - mutable client_section : Eliom_runtime.injection_datum array list } + { mutable server_section : Eliom_serial.client_value_datum array list; + mutable client_section : Eliom_serial.injection_datum array list } let global_data = ref String_map.empty @@ -256,11 +256,11 @@ let check_global_data global_data = "Code generating the following client values is not linked on the client:\n%s" (String.concat "\n" (List.rev_map - (fun {Eliom_runtime.closure_id; value} -> + (fun {Eliom_serial.closure_id; value} -> let instance_id = - Eliom_runtime.Client_value_server_repr.instance_id value + Eliom_serial.Client_value_server_repr.instance_id value in - match Eliom_runtime.Client_value_server_repr.loc value + match Eliom_serial.Client_value_server_repr.loc value with | None -> Printf.sprintf "%s/%d" closure_id instance_id | Some pos -> @@ -276,8 +276,8 @@ let check_global_data global_data = "Code containing the following injections is not linked on the client:\n%s" (String.concat "\n" (List.rev_map (fun d -> - let id = d.Eliom_runtime.injection_id in - match d.Eliom_runtime.injection_dbg with + let id = d.Eliom_serial.injection_id in + match d.Eliom_serial.injection_dbg with | None -> Printf.sprintf "%d" id | Some (pos, Some i) -> Printf.sprintf "%d (%s at %s)" id i (Eliom_lib.pos_to_string pos) @@ -439,7 +439,7 @@ let raw_event_handler value = (Eliom_lib.from_poly (Eliom_lib.to_poly value) : #Dom_html.event Js.t -> unit) in fun ev -> try handler ev; true with Eliom_client_value.False -> false -let closure_name_prefix = Eliom_runtime.RawXML.closure_name_prefix +let closure_name_prefix = Eliom_serial.RawXML.closure_name_prefix let closure_name_prefix_len = String.length closure_name_prefix let reify_caml_event name node ce = match ce with @@ -729,13 +729,13 @@ let get_element_cookies_info elt = Js.Opt.to_option (Js.Opt.map (elt##(getAttribute (Js.string - Eliom_runtime.RawXML.ce_call_service_attrib))) + Eliom_serial.RawXML.ce_call_service_attrib))) (fun s -> of_json (Js.to_string s))) let get_element_template elt = Js.Opt.to_option (Js.Opt.map (elt##(getAttribute (Js.string - Eliom_runtime.RawXML.ce_template_attrib))) + Eliom_serial.RawXML.ce_template_attrib))) (fun s -> Js.to_string s)) let a_handler = @@ -768,7 +768,7 @@ let form_handler let relink_process_node (node:Dom_html.element Js.t) = let id = Js.Opt.get - (node##(getAttribute (Js.string Eliom_runtime.RawXML.node_id_attrib))) + (node##(getAttribute (Js.string Eliom_serial.RawXML.node_id_attrib))) (fun () -> Lwt_log.raise_error_f ~section "unique node without id attribute") in @@ -792,7 +792,7 @@ let relink_process_node (node:Dom_html.element Js.t) = let relink_request_node (node:Dom_html.element Js.t) = let id = Js.Opt.get - (node##(getAttribute (Js.string Eliom_runtime.RawXML.node_id_attrib))) + (node##(getAttribute (Js.string Eliom_serial.RawXML.node_id_attrib))) (fun () -> Lwt_log.raise_error_f ~section "unique node without id attribute") in @@ -847,11 +847,11 @@ let relink_page_but_client_values (root:Dom_html.element Js.t) = *) let is_closure_attrib, get_closure_name, get_closure_id = - let v_prefix = Eliom_runtime.RawXML.closure_attr_prefix in + let v_prefix = Eliom_serial.RawXML.closure_attr_prefix in let v_len = String.length v_prefix in let v_prefix_js = Js.string v_prefix in - let n_prefix = Eliom_runtime.RawXML.closure_name_prefix in + let n_prefix = Eliom_serial.RawXML.closure_name_prefix in let n_len = String.length n_prefix in let n_prefix_js = Js.string n_prefix in @@ -869,7 +869,7 @@ let relink_closure_node root onload table (node:Dom_html.element Js.t) = let cid = Js.to_bytestring (get_closure_id attr) in let name = get_closure_name attr in try - let cv = Eliom_runtime.RawXML.ClosureMap.find cid table in + let cv = Eliom_serial.RawXML.ClosureMap.find cid table in let closure = raw_event_handler cv in if name = Js.string "onload" then (if Eliommod_dom.ancessor root node @@ -893,11 +893,11 @@ let relink_closure_nodes (root : Dom_html.element Js.t) ignore (List.for_all (fun f -> f ev) (List.rev !onload)) let is_attrib_attrib,get_attrib_id = - let v_prefix = Eliom_runtime.RawXML.client_attr_prefix in + let v_prefix = Eliom_serial.RawXML.client_attr_prefix in let v_len = String.length v_prefix in let v_prefix_js = Js.string v_prefix in - let n_prefix = Eliom_runtime.RawXML.client_name_prefix in + let n_prefix = Eliom_serial.RawXML.client_name_prefix in let n_len = String.length n_prefix in let n_prefix_js = Js.string n_prefix in @@ -913,7 +913,7 @@ let relink_attrib root table (node:Dom_html.element Js.t) = then let cid = Js.to_bytestring (get_attrib_id attr) in try - let value = Eliom_runtime.RawXML.ClosureMap.find cid table in + let value = Eliom_serial.RawXML.ClosureMap.find cid table in let rattrib: Eliom_content_core.Xml.attrib = (Eliom_lib.from_poly (Eliom_lib.to_poly value)) in rebuild_rattrib node rattrib @@ -1283,7 +1283,7 @@ let unwrap_tyxml = let unwrap_client_value cv = Client_value.find - ~instance_id:(Eliom_runtime.Client_value_server_repr.instance_id cv) + ~instance_id:(Eliom_serial.Client_value_server_repr.instance_id cv) (* BB By returning [None] this value will be registered for late unwrapping, and late unwrapped in Client_value.initialize as soon as it is available. *) @@ -1291,7 +1291,7 @@ let unwrap_client_value cv = let unwrap_global_data = fun (global_data', _) -> global_data := String_map.map - (fun {Eliom_runtime.server_sections_data; client_sections_data} -> + (fun {Eliom_serial.server_sections_data; client_sections_data} -> {server_section = Array.to_list server_sections_data; client_section = Array.to_list client_sections_data}) global_data' @@ -1301,7 +1301,7 @@ let _ = (Eliom_unwrap.id_of_int Eliom_common_base.client_value_unwrap_id_int) unwrap_client_value; Eliom_unwrap.register_unwrapper - (Eliom_unwrap.id_of_int Eliom_runtime.tyxml_unwrap_id_int) + (Eliom_unwrap.id_of_int Eliom_serial.tyxml_unwrap_id_int) unwrap_tyxml; Eliom_unwrap.register_unwrapper (Eliom_unwrap.id_of_int Eliom_common_base.global_data_unwrap_id_int) @@ -1328,23 +1328,3 @@ let add_string_event_listener o e f capt : unit = (Js.Unsafe.coerce o)##(attachEvent e cb) else (Js.Unsafe.coerce o)##(addEventListener e f capt) - - -(******************************************************************************) - -module Syntax_helpers = struct - - let register_client_closure closure_id closure = - Client_closure.register ~closure_id ~closure - - let open_client_section compilation_unit_id = - do_next_client_section_data ~compilation_unit_id - - let close_server_section compilation_unit_id = - do_next_server_section_data ~compilation_unit_id - - let get_escaped_value = from_poly - - let get_injection ?ident ?pos name = Injection.get ?ident ?pos ~name - -end diff --git a/src/lib/eliom_client_value.client.ml b/src/lib/eliom_client_value.client.ml index a07f1e085a..daf8b14426 100644 --- a/src/lib/eliom_client_value.client.ml +++ b/src/lib/eliom_client_value.client.ml @@ -22,6 +22,6 @@ exception Exception_on_server of string type 'a t = 'a -type injection_datum = Eliom_runtime.injection_datum +type injection_datum = Eliom_serial.injection_datum type global_data2 diff --git a/src/lib/eliom_client_value.client.mli b/src/lib/eliom_client_value.client.mli index 78eb628c78..4f6df55afd 100644 --- a/src/lib/eliom_client_value.client.mli +++ b/src/lib/eliom_client_value.client.mli @@ -48,6 +48,6 @@ exception False (**/**) -type injection_datum = Eliom_runtime.injection_datum +type injection_datum = Eliom_serial.injection_datum type global_data2 (* Global data only needed while unwrapping *) diff --git a/src/lib/eliom_client_value.server.ml b/src/lib/eliom_client_value.server.ml index a3b80e7124..0fdcbfcbb0 100644 --- a/src/lib/eliom_client_value.server.ml +++ b/src/lib/eliom_client_value.server.ml @@ -19,28 +19,28 @@ let escaped_value_escaped_value = fst -type +'a t = 'a Eliom_runtime.Client_value_server_repr.t +type +'a t = 'a Eliom_serial.Client_value_server_repr.t type 'a fragment = 'a t let client_value_unwrapper = Eliom_wrap.create_unwrapper - (Eliom_wrap.id_of_int Eliom_runtime.client_value_unwrap_id_int) + (Eliom_wrap.id_of_int Eliom_serial.client_value_unwrap_id_int) let create_client_value ?loc ~instance_id = - Eliom_runtime.Client_value_server_repr.create + Eliom_serial.Client_value_server_repr.create ?loc ~instance_id ~unwrapper:client_value_unwrapper let client_value_from_server_repr cv = cv let client_value_datum ~closure_id ~args ~value = { - Eliom_runtime.closure_id; + Eliom_serial.closure_id; args; - value = Eliom_runtime.Client_value_server_repr.to_poly value + value = Eliom_serial.Client_value_server_repr.to_poly value } exception Client_value_creation_invalid_context of string let escaped_value value : - Eliom_runtime.escaped_value (* * Eliom_wrap.unwrapper *) = + Eliom_serial.escaped_value (* * Eliom_wrap.unwrapper *) = Ocsigen_lib.to_poly value diff --git a/src/lib/eliom_client_value.server.mli b/src/lib/eliom_client_value.server.mli index 2eede01f4a..831f80463b 100644 --- a/src/lib/eliom_client_value.server.mli +++ b/src/lib/eliom_client_value.server.mli @@ -42,15 +42,15 @@ exception Client_value_creation_invalid_context of string val create_client_value : ?loc:Eliom_lib.pos -> instance_id:int -> - _ Eliom_runtime.Client_value_server_repr.t + _ Eliom_serial.Client_value_server_repr.t val client_value_from_server_repr : - 'a Eliom_runtime.Client_value_server_repr.t -> 'a t + 'a Eliom_serial.Client_value_server_repr.t -> 'a t val client_value_datum : closure_id:string -> args:Ocsigen_lib.poly -> value:'a t -> - Eliom_runtime.client_value_datum + Eliom_serial.client_value_datum val escaped_value : - 'a -> Eliom_runtime.escaped_value (* * Eliom_wrap.unwrapper *) + 'a -> Eliom_serial.escaped_value (* * Eliom_wrap.unwrapper *) diff --git a/src/lib/eliom_comet.server.ml b/src/lib/eliom_comet.server.ml index 314784fc86..3b0030c2d9 100644 --- a/src/lib/eliom_comet.server.ml +++ b/src/lib/eliom_comet.server.ml @@ -754,7 +754,7 @@ end = struct let marshal (v:'a) = let wrapped = Eliom_wrap.wrap v in - let value : 'a Eliom_runtime.eliom_comet_data_type = wrapped in + let value : 'a Eliom_serial.eliom_comet_data_type = wrapped in (Eliom_lib.Url.encode ~plus:false (Marshal.to_string value [])) let create_stateful_channel ?scope ?name stream = diff --git a/src/lib/eliom_common.server.mli b/src/lib/eliom_common.server.mli index 96813fbf65..80b80ee6cc 100644 --- a/src/lib/eliom_common.server.mli +++ b/src/lib/eliom_common.server.mli @@ -699,12 +699,12 @@ val patch_request_info: Ocsigen_extensions.request -> Ocsigen_extensions.request type eliom_js_page_data = { ejs_global_data: - (Eliom_runtime.global_data * Eliom_wrap.unwrapper) option; - ejs_request_data: Eliom_runtime.request_data; + (Eliom_serial.global_data * Eliom_wrap.unwrapper) option; + ejs_request_data: Eliom_serial.request_data; (* Event handlers *) - ejs_event_handler_table: Eliom_runtime.RawXML.event_handler_table; + ejs_event_handler_table: Eliom_serial.RawXML.event_handler_table; (* Client attrib *) - ejs_client_attrib_table: Eliom_runtime.RawXML.client_attrib_table; + ejs_client_attrib_table: Eliom_serial.RawXML.client_attrib_table; (* Session info *) ejs_sess_info: sess_info; } diff --git a/src/lib/eliom_common_base.shared.ml b/src/lib/eliom_common_base.shared.ml index 00a7c6549c..a067438aec 100644 --- a/src/lib/eliom_common_base.shared.ml +++ b/src/lib/eliom_common_base.shared.ml @@ -270,28 +270,28 @@ type sess_info = type eliom_js_page_data = { ejs_global_data: - (Eliom_runtime.global_data * Eliom_wrap.unwrapper) option; - ejs_request_data: Eliom_runtime.request_data; + (Eliom_serial.global_data * Eliom_wrap.unwrapper) option; + ejs_request_data: Eliom_serial.request_data; (* Event handlers *) - ejs_event_handler_table: Eliom_runtime.RawXML.event_handler_table; + ejs_event_handler_table: Eliom_serial.RawXML.event_handler_table; (* Client Attributes *) - ejs_client_attrib_table: Eliom_runtime.RawXML.client_attrib_table; + ejs_client_attrib_table: Eliom_serial.RawXML.client_attrib_table; (* Session info *) ejs_sess_info: sess_info; } (************ unwrapping identifiers *********************) -let tyxml_unwrap_id_int = Eliom_runtime.tyxml_unwrap_id_int +let tyxml_unwrap_id_int = Eliom_serial.tyxml_unwrap_id_int let () = assert (tyxml_unwrap_id_int = 1) let comet_channel_unwrap_id_int = 2 let react_up_unwrap_id_int = 3 let react_down_unwrap_id_int = 4 let signal_down_unwrap_id_int = 5 let bus_unwrap_id_int = 6 -let client_value_unwrap_id_int = Eliom_runtime.client_value_unwrap_id_int +let client_value_unwrap_id_int = Eliom_serial.client_value_unwrap_id_int let () = assert (client_value_unwrap_id_int = 7) -let global_data_unwrap_id_int = Eliom_runtime.global_data_unwrap_id_int +let global_data_unwrap_id_int = Eliom_serial.global_data_unwrap_id_int let () = assert (global_data_unwrap_id_int = 8) let server_function_unwrap_id_int = 9 diff --git a/src/lib/eliom_content.server.mli b/src/lib/eliom_content.server.mli index 8a21d51ba5..dba7ef08c2 100644 --- a/src/lib/eliom_content.server.mli +++ b/src/lib/eliom_content.server.mli @@ -125,8 +125,8 @@ module Xml : sig (* Concrete on client-side only. *) type node_id val get_node_id : elt -> node_id - val make_event_handler_table : elt -> Eliom_runtime.RawXML.event_handler_table - val make_client_attrib_table : elt -> Eliom_runtime.RawXML.client_attrib_table + val make_event_handler_table : elt -> Eliom_serial.RawXML.event_handler_table + val make_client_attrib_table : elt -> Eliom_serial.RawXML.client_attrib_table val caml_event_handler : (Dom_html.event Js.t -> unit) Eliom_client_value.t -> diff --git a/src/lib/eliom_content_core.client.ml b/src/lib/eliom_content_core.client.ml index 7dc012e4ef..eed7e0e8ac 100644 --- a/src/lib/eliom_content_core.client.ml +++ b/src/lib/eliom_content_core.client.ml @@ -26,7 +26,7 @@ open Eliom_lib module Xml = struct - include Eliom_runtime.RawXML + include Eliom_serial.RawXML module W = Xml_wrap.NoWrap type 'a wrap = 'a type 'a list_wrap = 'a list @@ -125,7 +125,7 @@ module Xml = struct f () else match elt.node_id with - | Eliom_runtime.RawXML.NoId -> + | Eliom_serial.RawXML.NoId -> f () | _ -> elt diff --git a/src/lib/eliom_content_core.server.ml b/src/lib/eliom_content_core.server.ml index 23a228f21e..1749406812 100644 --- a/src/lib/eliom_content_core.server.ml +++ b/src/lib/eliom_content_core.server.ml @@ -27,7 +27,7 @@ open Eliom_lib (*****************************************************************************) module Xml = struct - include Eliom_runtime.RawXML + include Eliom_serial.RawXML module W = Xml_wrap.NoWrap type 'a wrap = 'a type 'a list_wrap = 'a list @@ -89,7 +89,7 @@ module Xml = struct let get_node_id { elt } = elt.node_id let tyxml_unwrap_id = - Eliom_wrap.id_of_int Eliom_runtime.tyxml_unwrap_id_int + Eliom_wrap.id_of_int Eliom_serial.tyxml_unwrap_id_int let make elt = { elt = @@ -193,7 +193,7 @@ module Xml = struct f () else match elt'.elt.node_id with - | Eliom_runtime.RawXML.NoId -> + | Eliom_serial.RawXML.NoId -> f () | _ -> elt' diff --git a/src/lib/eliom_content_core.server.mli b/src/lib/eliom_content_core.server.mli index 7b13822ccf..fa2f0ef3c8 100644 --- a/src/lib/eliom_content_core.server.mli +++ b/src/lib/eliom_content_core.server.mli @@ -43,8 +43,8 @@ module Xml : sig (* Building ref tree. *) type node_id val get_node_id : elt -> node_id - val make_event_handler_table : elt -> Eliom_runtime.RawXML.event_handler_table - val make_client_attrib_table : elt -> Eliom_runtime.RawXML.client_attrib_table + val make_event_handler_table : elt -> Eliom_serial.RawXML.event_handler_table + val make_client_attrib_table : elt -> Eliom_serial.RawXML.client_attrib_table type internal_event_handler = | Raw of string diff --git a/src/lib/eliom_registration.server.ml b/src/lib/eliom_registration.server.ml index fdf9ea6f8f..71ca44749c 100644 --- a/src/lib/eliom_registration.server.ml +++ b/src/lib/eliom_registration.server.ml @@ -970,15 +970,15 @@ module Ocaml = struct let prepare_data data = let ecs_request_data = - let data = Eliom_syntax.get_request_data () in + let data = Eliom_runtime.get_request_data () in if not (Ocsigen_config.get_debugmode()) then Array.iter (fun d -> - Eliom_runtime.Client_value_server_repr.clear_loc - d.Eliom_runtime.value) data; + Eliom_serial.Client_value_server_repr.clear_loc + d.Eliom_serial.value) data; data in (* debug_client_value_data (debug "%s") client_value_data; *) - let r = { Eliom_runtime.ecs_request_data; + let r = { Eliom_serial.ecs_request_data; ecs_data = data } in Lwt.return (Eliom_types.encode_eliom_data r) @@ -1172,7 +1172,7 @@ let request_template = let global_data_unwrapper = Eliom_wrap.create_unwrapper - (Eliom_wrap.id_of_int Eliom_runtime.global_data_unwrap_id_int) + (Eliom_wrap.id_of_int Eliom_serial.global_data_unwrap_id_int) module Eliom_appl_reg_make_param (Html_content @@ -1248,25 +1248,25 @@ module Eliom_appl_reg_make_param let ejs_global_data = if is_initial_request () then - let data = Eliom_syntax.get_global_data () in + let data = Eliom_runtime.get_global_data () in let data = if keep_debug then data else Eliom_lib.String_map.map - (fun {Eliom_runtime.server_sections_data; + (fun {Eliom_serial.server_sections_data; client_sections_data} -> Array.iter (Array.iter (fun d -> - Eliom_runtime.Client_value_server_repr.clear_loc - d.Eliom_runtime.value)) + Eliom_serial.Client_value_server_repr.clear_loc + d.Eliom_serial.value)) server_sections_data; - { Eliom_runtime.server_sections_data; + { Eliom_serial.server_sections_data; client_sections_data = Array.map ( Array.map (fun x -> {x with - Eliom_runtime.injection_dbg = None}) + Eliom_serial.injection_dbg = None}) ) client_sections_data }) data @@ -1275,11 +1275,11 @@ module Eliom_appl_reg_make_param else None in let ejs_request_data = - let data = Eliom_syntax.get_request_data () in + let data = Eliom_runtime.get_request_data () in if not keep_debug then Array.iter (fun d -> - Eliom_runtime.Client_value_server_repr.clear_loc - d.Eliom_runtime.value) data; + Eliom_serial.Client_value_server_repr.clear_loc + d.Eliom_serial.value) data; data in @@ -1518,7 +1518,7 @@ struct let application_script = P.application_script let data_service_handler () () = - Lwt.return (Eliom_syntax.get_global_data (), global_data_unwrapper) + Lwt.return (Eliom_runtime.get_global_data (), global_data_unwrapper) let _ = match App_param.global_data_path with diff --git a/src/lib/eliom_request_info.client.ml b/src/lib/eliom_request_info.client.ml index 7015d72422..d7a6b71649 100644 --- a/src/lib/eliom_request_info.client.ml +++ b/src/lib/eliom_request_info.client.ml @@ -164,8 +164,8 @@ let get_request_template = Eliom_process.get_request_template let default_request_data = {Eliom_common.ejs_global_data = None; ejs_request_data = [||]; - ejs_event_handler_table = Eliom_runtime.RawXML.ClosureMap.empty; - ejs_client_attrib_table = Eliom_runtime.RawXML.ClosureMap.empty; + ejs_event_handler_table = Eliom_serial.RawXML.ClosureMap.empty; + ejs_client_attrib_table = Eliom_serial.RawXML.ClosureMap.empty; ejs_sess_info = {Eliom_common.si_other_get_params = []; diff --git a/src/lib/eliom_runtime.client.ml b/src/lib/eliom_runtime.client.ml new file mode 100644 index 0000000000..7bfe6cd3d8 --- /dev/null +++ b/src/lib/eliom_runtime.client.ml @@ -0,0 +1,33 @@ +(* Ocsigen + * http://www.ocsigen.org + * Copyright (C) CNRS Univ Paris Diderot + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +open Eliom_client_core + +let register_client_closure ~closure_id closure = + Client_closure.register ~closure_id ~closure + +let open_client_section compilation_unit_id = + do_next_client_section_data ~compilation_unit_id + +let close_server_section compilation_unit_id = + do_next_server_section_data ~compilation_unit_id + +let get_injection ?ident ?pos name = Injection.get ?ident ?pos ~name + +let get_escaped_value = Eliom_lib.from_poly diff --git a/src/lib/eliom_runtime.client.mli b/src/lib/eliom_runtime.client.mli new file mode 100644 index 0000000000..232399d9aa --- /dev/null +++ b/src/lib/eliom_runtime.client.mli @@ -0,0 +1,32 @@ + +(** Look-up of the value of an injection in the global injection table. *) +val get_injection : ?ident:string -> ?pos:Eliom_lib.pos -> string -> 'a + +(** Register a function from the tuple of injected values (['args]) + to the actual code of the client value (['res]) under some + closure ID *) +val register_client_closure : closure_id:string -> ('args -> 'res) -> unit + +(** Takes the next list of {!Eliom_lib_base.client_value_datum}s + from the queue of server section data of the compilation unit + provided by the first argument + (cf. {!Eliom_lib_base.compilation_unit_global_data}). It + initializes and registers the global client values created in + that section. + + Called in parallel with <>. *) +val close_server_section : string -> unit + +(** Takes the next list of {!Eliom_lib_base.injection_datum}s from + the queue of client section data of the compilation unit + specfied with the argument + (cf. {!Eliom_lib_base.compilation_unit_global_data}). It + registers those injections for subsequent usage of + {!Eliom_client.Syntax_helpers.get_injection}. + + Called in parallel with <>. *) +val open_client_section : string -> unit + +val get_escaped_value : Eliom_lib.poly -> 'a diff --git a/src/lib/eliom_syntax.server.ml b/src/lib/eliom_runtime.server.ml similarity index 87% rename from src/lib/eliom_syntax.server.ml rename to src/lib/eliom_runtime.server.ml index c2549eaaa8..7dfd5bb15b 100644 --- a/src/lib/eliom_syntax.server.ml +++ b/src/lib/eliom_runtime.server.ml @@ -23,9 +23,9 @@ type compilation_unit_global_data2 = { mutable server_section : - Eliom_runtime.client_value_datum array list; + Eliom_serial.client_value_datum array list; mutable client_section : - Eliom_runtime.injection_datum array list } + Eliom_serial.injection_datum array list } let get_global_data, modify_global_data = (* We have to classify global data from ocsigen extensions (no site @@ -85,9 +85,9 @@ let close_server_section compilation_unit_id = let close_client_section compilation_unit_id injection_data = let data = get_compilation_unit_global_data compilation_unit_id in - let injection_datum (injection_id, injection_value, loc, ident) = - { Eliom_runtime.injection_id; - injection_value ; injection_dbg = Some (loc, ident) } + let injection_datum (injection_id, injection_value, loc) = + { Eliom_serial.injection_id; + injection_value ; injection_dbg = Some loc } in let injection_data = Array.of_list injection_data in data.client_section <- @@ -96,7 +96,7 @@ let close_client_section compilation_unit_id injection_data = let get_global_data () = Eliom_lib.String_map.map (fun {server_section; client_section}-> - { Eliom_runtime.server_sections_data + { Eliom_serial.server_sections_data = Array.of_list (List.rev server_section); client_sections_data = Array.of_list (List.rev client_section) }) (get_global_data ()) @@ -104,7 +104,7 @@ let get_global_data () = (* Request data *) let request_data - : Eliom_runtime.client_value_datum list + : Eliom_serial.client_value_datum list Eliom_reference.Volatile.eref = Eliom_reference.Volatile.eref ~scope:Eliom_common.request_scope [] @@ -114,7 +114,7 @@ let get_request_data () = (* Register data *) let register_client_value_data ~closure_id ~args ~value = - let client_value_datum = { Eliom_runtime.closure_id; args; value } + let client_value_datum = { Eliom_serial.closure_id; args; value } in if Eliom_common.get_sp_option () = None then current_server_section_data := @@ -131,7 +131,7 @@ let escaped_value = Eliom_client_value.escaped_value let last_id = ref 0 -let client_value ?pos closure_id args = +let fragment ?pos closure_id args = let instance_id = if Eliom_common.get_sp_option () = None then begin incr last_id; @@ -143,3 +143,16 @@ let client_value ?pos closure_id args = register_client_value_data ~closure_id ~args:(Eliom_lib.to_poly args) ~value; Eliom_client_value.client_value_from_server_repr value + +let pos pos_fname (lnum1, bol1, cnum1) (lnum2, bol2, cnum2) = + Lexing.( + { pos_fname ; + pos_lnum = lnum1 ; + pos_bol = bol1 ; + pos_cnum = cnum1 ; + }, + { pos_fname; + pos_lnum = lnum2 ; + pos_bol = bol2 ; + pos_cnum = cnum2 ; + }) diff --git a/src/lib/eliom_syntax.server.mli b/src/lib/eliom_runtime.server.mli similarity index 74% rename from src/lib/eliom_syntax.server.mli rename to src/lib/eliom_runtime.server.mli index 0ac800a0dc..18ed3c1cb5 100644 --- a/src/lib/eliom_syntax.server.mli +++ b/src/lib/eliom_runtime.server.mli @@ -17,16 +17,24 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val get_global_data : unit -> Eliom_runtime.global_data +val get_global_data : unit -> Eliom_serial.global_data -val get_request_data : unit -> Eliom_runtime.request_data +val get_request_data : unit -> Eliom_serial.request_data (*****************************************************************************) +(** Helper to make generated code easier to read. + Simply create a pos range with the given coordinate. *) +val pos : + string -> + int * int * int -> + int * int * int -> + Eliom_lib.pos + (** Registers a client value datum for the next server section when - executed in a global_data (cf. {!Eliom_syntax.set_global}) or in + executed in a global_data (cf. {!Eliom_runtime.set_global}) or in the request_data when executed in a request. *) -val client_value : +val fragment : ?pos:Eliom_lib.pos -> string -> 'args -> 'a Eliom_client_value.t @@ -34,7 +42,7 @@ val client_value : identifies the compilation unit. Adds the list of recently registered - {!Eliom_runtime.client_value_datum}s into the queue of server + {!Eliom_serial.client_value_datum}s into the queue of server section data of the compilation unit ({!Eliom_lib_base.compilation_unit_global_data}). @@ -54,9 +62,9 @@ val close_server_section : string -> unit subproject="client"|Eliom_client.Syntax_helpers.open_client_section>>. *) val close_client_section : string -> - (int * Ocsigen_lib.poly * Eliom_lib.pos * string option) list -> + (int * Ocsigen_lib.poly * (Eliom_lib.pos * string option)) list -> unit -(** Convert any value to a {! Eliom_runtime.escaped_value} for usage - in the [args] argument to {! Eliom_syntax.client_value}. *) -val escaped_value : 'a -> Eliom_runtime.escaped_value +(** Convert any value to a {! Eliom_serial.escaped_value} for usage + in the [args] argument to {! Eliom_runtime.client_value}. *) +val escaped_value : 'a -> Eliom_serial.escaped_value diff --git a/src/lib/eliom_runtime.shared.ml b/src/lib/eliom_serial.shared.ml similarity index 100% rename from src/lib/eliom_runtime.shared.ml rename to src/lib/eliom_serial.shared.ml diff --git a/src/lib/eliom_runtime.shared.mli b/src/lib/eliom_serial.shared.mli similarity index 99% rename from src/lib/eliom_runtime.shared.mli rename to src/lib/eliom_serial.shared.mli index a58a2d48c7..c5de87683d 100644 --- a/src/lib/eliom_runtime.shared.mli +++ b/src/lib/eliom_serial.shared.mli @@ -168,7 +168,7 @@ type client_value_datum = { (** Data for initializing one injection *) type injection_datum = { - injection_dbg : (Eliom_lib_base.pos * string option) option; + injection_dbg : (Eliom_lib.pos * string option) option; injection_id : int; injection_value : Ocsigen_lib.poly; } diff --git a/src/lib/eliom_unwrap.client.mli b/src/lib/eliom_unwrap.client.mli index 416f1a44be..e59688c8a0 100644 --- a/src/lib/eliom_unwrap.client.mli +++ b/src/lib/eliom_unwrap.client.mli @@ -95,7 +95,7 @@ val register_unwrapper' : unwrap_id -> ('a -> 'b option) -> unit of [old_value] with [new_value]. *) val late_unwrap_value : - _ Eliom_runtime.Client_value_server_repr.t -> _ -> unit + _ Eliom_serial.Client_value_server_repr.t -> _ -> unit (** Lwt_log section for this module. *) val log_section : Lwt_log.section diff --git a/src/ppx/ppx_eliom_client.ml b/src/ppx/ppx_eliom_client.ml index 9a393a1ba9..5c13e9cb7d 100644 --- a/src/ppx/ppx_eliom_client.ml +++ b/src/ppx/ppx_eliom_client.ml @@ -19,7 +19,7 @@ module Pass = struct expr = (fun mapper e -> match e.pexp_desc with | Pexp_ident {txt} when Mli.is_escaped_ident @@ Longident.last txt -> - [%expr Eliom_client_core.Syntax_helpers.get_escaped_value [%e e] ] + [%expr Eliom_runtime.get_escaped_value [%e e] ] [@metaloc e.pexp_loc] | _ -> AM.default_mapper.expr mapper e ); @@ -84,7 +84,7 @@ module Pass = struct let typ = find_fragment id in let args = List.map Pat.var args in [%expr - Eliom_client_core.Syntax_helpers.register_client_closure + Eliom_runtime.register_client_closure [%e AC.str num] (fun [%p pat_args args] -> ([%e map_get_escaped_values expr] : [%t typ])) @@ -125,7 +125,7 @@ module Pass = struct let close_server_section loc = [%stri let () = - Eliom_client_core.Syntax_helpers.close_server_section + Eliom_runtime.close_server_section [%e eid @@ id_file_hash loc] ][@metaloc loc] @@ -138,7 +138,7 @@ module Pass = struct let open_client_section loc = [%stri let () = - Eliom_client_core.Syntax_helpers.open_client_section + Eliom_runtime.open_client_section [%e eid @@ id_file_hash loc] ][@metaloc loc] diff --git a/src/ppx/ppx_eliom_server.ml b/src/ppx/ppx_eliom_server.ml index 82b3289507..e198f993a5 100644 --- a/src/ppx/ppx_eliom_server.ml +++ b/src/ppx/ppx_eliom_server.ml @@ -41,7 +41,7 @@ module Pass = struct let res = List.rev !args in args := []; let aux (_, arg) = - [%expr Eliom_syntax.escaped_value [%e arg ] ] + [%expr Eliom_runtime.escaped_value [%e arg ] ] [@metaloc arg.pexp_loc] in List.map aux res @@ -98,7 +98,7 @@ module Pass = struct let close_server_section loc = [%stri let () = - Eliom_syntax.close_server_section + Eliom_runtime.close_server_section [%e eid @@ id_file_hash loc] ] [@metaloc loc] @@ -130,7 +130,7 @@ module Pass = struct in [%stri let () = - Eliom_syntax.close_client_section + Eliom_runtime.close_client_section [%e eid @@ id_file_hash loc ] [%e injection_list ] ][@metaloc loc] @@ -184,7 +184,7 @@ module Pass = struct let loc = expr.pexp_loc in let e = format_args @@ flush_escaped_bindings () in [%expr - (Eliom_syntax.client_value + (Eliom_runtime.fragment ~pos:([%e position loc ]) [%e AC.str num ] [%e e ] diff --git a/src/ppx/ppx_eliom_type.ml b/src/ppx/ppx_eliom_type.ml index 0e9e16307d..d5779ed8f0 100644 --- a/src/ppx/ppx_eliom_type.ml +++ b/src/ppx/ppx_eliom_type.ml @@ -115,7 +115,7 @@ module Pass = struct [%expr [%e flush_typing_expr () ]; [%e frag_eid] := - Some ( Eliom_syntax.client_value "" 0 : + Some ( Eliom_runtime.fragment "" 0 : [%t typ] Eliom_client_value.t); match ! [%e frag_eid] with | Some x -> (x : _ Eliom_client_value.t) diff --git a/src/syntax/pa_eliom_client_server.ml b/src/syntax/pa_eliom_client_server.ml index 3e8c6b581f..e005aeb1ae 100644 --- a/src/syntax/pa_eliom_client_server.ml +++ b/src/syntax/pa_eliom_client_server.ml @@ -48,7 +48,7 @@ module Server_pass(Helpers : Pa_eliom_seed.Helpers) = struct arg_collection := []; let aux (_, arg) = let _loc = Ast.loc_of_expr arg in - <:expr< Eliom_syntax.escaped_value $arg$ >> + <:expr< Eliom_runtime.escaped_value $arg$ >> in List.map aux res in @@ -67,7 +67,7 @@ module Server_pass(Helpers : Pa_eliom_seed.Helpers) = struct let res = List.rev !arg_collection and aux (_, arg) = let _loc = Ast.loc_of_expr arg in - <:expr< Eliom_syntax.escaped_value $arg$ >> + <:expr< Eliom_runtime.escaped_value $arg$ >> in arg_ids := []; arg_collection := []; @@ -125,7 +125,7 @@ module Server_pass(Helpers : Pa_eliom_seed.Helpers) = struct let _loc = Loc.ghost in <:str_item< let () = - Eliom_syntax.close_server_section + Eliom_runtime.close_server_section $str:Helpers.file_hash loc$ >> @@ -147,7 +147,7 @@ module Server_pass(Helpers : Pa_eliom_seed.Helpers) = struct in <:str_item< let () = - Eliom_syntax.close_client_section + Eliom_runtime.close_client_section $str:Helpers.file_hash loc$ $injection_list$ >> @@ -198,7 +198,7 @@ module Server_pass(Helpers : Pa_eliom_seed.Helpers) = struct flush_escaped_bindings () in <:expr@loc< - (Eliom_syntax.client_value + (Eliom_runtime.fragment ~pos:($Helpers.position _loc$) $str:gen_id$ $Helpers.expr_tuple l$ : $typ$ Eliom_client_value.t) >> ;; @@ -222,7 +222,7 @@ module Server_pass(Helpers : Pa_eliom_seed.Helpers) = struct <:expr@loc< Eliom_shared.Value.create $orig_expr$ - (Eliom_syntax.client_value + (Eliom_runtime.fragment ~pos:($Helpers.position _loc$) $str:gen_id$ $Helpers.expr_tuple (flush_escaped_bindings ())$ @@ -251,7 +251,7 @@ module Server_pass(Helpers : Pa_eliom_seed.Helpers) = struct let implem loc sil = let _loc = Loc.ghost in let set_global b = - <:str_item< let () = Eliom_syntax.set_global $`bool:b$ >> + <:str_item< let () = Eliom_runtime.set_global $`bool:b$ >> in set_global true :: sil @ [ set_global false ] diff --git a/src/syntax/pa_eliom_type_filter.ml b/src/syntax/pa_eliom_type_filter.ml index 73a884a870..c68b1bc1a8 100644 --- a/src/syntax/pa_eliom_type_filter.ml +++ b/src/syntax/pa_eliom_type_filter.ml @@ -98,7 +98,7 @@ module Type_pass(Helpers : Pa_eliom_seed.Helpers) = struct let _loc = loc in <:expr< begin $flush_typing_expr ()$; - $lid:gen_tid$ := Some (Eliom_syntax.client_value "" 0 : $typ$ Eliom_client_value.t); + $lid:gen_tid$ := Some (Eliom_runtime.fragment "" 0 : $typ$ Eliom_client_value.t); match ! $lid:gen_tid $ with | Some x -> (x : _ Eliom_client_value.t) | None -> assert false @@ -116,7 +116,7 @@ module Type_pass(Helpers : Pa_eliom_seed.Helpers) = struct begin $flush_typing_expr ()$; $lid:gen_tid$ := - Some (Eliom_syntax.client_value "" 0 : + Some (Eliom_runtime.fragment "" 0 : $typ$ Eliom_client_value.t); match ! $lid:gen_tid $ with | Some x -> x From b5d9ee7f83e7628b230b9c822c01a47b1a745e75 Mon Sep 17 00:00:00 2001 From: Drup Date: Mon, 1 Aug 2016 18:46:45 +0200 Subject: [PATCH 04/23] Remove set_global from the camlp4 syntax extension. --- src/syntax/pa_eliom_client_server.ml | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/syntax/pa_eliom_client_server.ml b/src/syntax/pa_eliom_client_server.ml index e005aeb1ae..d7fd8c8a63 100644 --- a/src/syntax/pa_eliom_client_server.ml +++ b/src/syntax/pa_eliom_client_server.ml @@ -248,12 +248,7 @@ module Server_pass(Helpers : Pa_eliom_seed.Helpers) = struct let _loc = Ast.loc_of_expr orig_expr in <:expr< $lid:gen_id$ >> - let implem loc sil = - let _loc = Loc.ghost in - let set_global b = - <:str_item< let () = Eliom_runtime.set_global $`bool:b$ >> - in - set_global true :: sil @ [ set_global false ] + let implem _ sil = sil let shared_sig_items _ items = Ast.sgSem_of_list items let server_sig_items _ items = Ast.sgSem_of_list items From 5128db71db9f75f04a1d58d76f7ad880b9aea031 Mon Sep 17 00:00:00 2001 From: Drup Date: Mon, 1 Aug 2016 19:55:08 +0200 Subject: [PATCH 05/23] Start working on the ocamlbuild plugin. --- src/ocamlbuild/ocamlbuild_eliom.ml | 323 ++++++++++++++-------------- src/ocamlbuild/ocamlbuild_eliom.mli | 1 - 2 files changed, 156 insertions(+), 168 deletions(-) diff --git a/src/ocamlbuild/ocamlbuild_eliom.ml b/src/ocamlbuild/ocamlbuild_eliom.ml index 13084bb28d..284be56dcd 100644 --- a/src/ocamlbuild/ocamlbuild_eliom.ml +++ b/src/ocamlbuild/ocamlbuild_eliom.ml @@ -1,9 +1,137 @@ open Ocamlbuild_plugin module Pack = Ocamlbuild_pack +let init () = + let module Eliom_rules = struct +open Pack ;; + +(* Copy of the rules in ocamlbuild ocaml_specific.ml. + We only copy the one that involves .ml and .mli files. +*) + +rule "eliom: eliomi -> cmi" + ~prod:"%.cmi" + ~deps:["%.eliomi"; "%.eliomi.depends"] + (Ocaml_compiler.compile_ocaml_interf "%.eliomi" "%.cmi") ;; + +rule "eliom: mlpack & cmo* & cmi -> cmo" + ~prod:"%.cmo" + ~deps:["%.eliomi"; "%.cmi"; "%.mlpack"] + ~doc:"If foo.mlpack contains a list of capitalized module names, \ + the target foo.cmo will produce a packed module containing \ + those modules as submodules. You can also have a foo.eliomi file \ + to restrict the interface of the resulting module. + +\ + Warning: to produce a native foo.cmx out of a foo.mlpack, you must \ + manually tag the included compilation units with for-pack(foo). \ + See the documentation of the corresponding rules for more details. + +\ + The modules named in the .mlpack \ + will be dynamic dependencies of the compilation action. \ + You cannot give the .mlpack the same name as one of the module \ + it contains, as this would create a circular dependency." + (Ocaml_compiler.byte_pack_mlpack "%.mlpack" "%.cmo");; + +rule "eliom: eliom & cmi -> d.cmo" + ~prod:"%.d.cmo" + ~deps:["%.eliomi"(* This one is inserted to force this rule to be skiped when + a .eliom is provided without a .eliomi *); "%.eliom"; "%.eliom.depends"; "%.cmi"] + ~doc:"The foo.d.cmo target compiles foo.eliom with the 'debug' tag enabled (-g).\ + See also foo.d.byte. + +\ + For technical reason, .d.cmx and .d.native are not yet supported, \ + so you should explicitly add the 'debug' tag \ + to native targets (both compilation and linking)." + (Ocaml_compiler.byte_compile_ocaml_implem ~tag:"debug" "%.eliom" "%.d.cmo");; + +rule "eliom: eliom & cmi -> cmo" + ~prod:"%.cmo" + ~deps:["%.eliomi"(* This one is inserted to force this rule to be skiped when + a .eliom is provided without a .eliomi *); "%.eliom"; "%.eliom.depends"; "%.cmi"] + (Ocaml_compiler.byte_compile_ocaml_implem "%.eliom" "%.cmo");; + +rule "eliom: eliom & cmi -> cmx & o" + ~prods:["%.cmx"; "%" -.- !Options.ext_obj] + ~deps:["%.eliom"; "%.eliom.depends"; "%.cmi"] + (Ocaml_compiler.native_compile_ocaml_implem "%.eliom");; + +rule "eliom: eliom -> d.cmo & cmi" + ~prods:["%.d.cmo"] + ~deps:["%.eliom"; "%.eliom.depends"; "%.cmi"] + (Ocaml_compiler.byte_compile_ocaml_implem ~tag:"debug" "%.eliom" "%.d.cmo");; + +rule "eliom: eliom -> cmo & cmi" + ~prods:["%.cmo"; "%.cmi"] + ~deps:["%.eliom"; "%.eliom.depends"] + ~doc:"This rule allows to produce a .cmi from a .eliom file \ + when the corresponding .eliomi is missing. + +\ + Note: you are strongly encourage to have a .eliomi file \ + for each of your .eliom module, as it is a good development \ + practice which also simplifies the way build systems work, \ + as it avoids producing .cmi files as a silent side-effect of \ + another compilation action." + (Ocaml_compiler.byte_compile_ocaml_implem "%.eliom" "%.cmo");; + +rule "eliom dependencies" + ~prod:"%.eliom.depends" + ~dep:"%.eliom" + ~doc:"OCamlbuild will use ocamldep to approximate dependencies \ + of a source file. The ocamldep tool being purely syntactic, \ + it only computes an over-approximation of the dependencies. + +\ + If you manipulate a module Foo that is in fact a submodule Bar.Foo \ + (after 'open Bar'), ocamldep may believe that your module depends \ + on foo.eliom -- when such a file also exists in your project. This can \ + lead to spurious circular dependencies. In that case, you can use \ + OCamlbuild_plugin.non_dependency in your myocamlbuild.eliom \ + to manually remove the spurious dependency. See the plugins API." + (Ocaml_tools.ocamldep_command "%.eliom" "%.eliom.depends");; + +rule "eliom dependencies eliomi" + ~prod:"%.eliomi.depends" + ~dep:"%.eliomi" + (Ocaml_tools.ocamldep_command "%.eliomi" "%.eliomi.depends");; + +rule "eliom: eliomi -> odoc" + ~prod:"%.odoc" + ~deps:["%.eliomi"; "%.eliomi.depends"] + ~doc:".odoc are intermediate files storing the result of ocamldoc processing \ + on a source file. See the various .docdir/... targets for ocamldoc." + (Ocaml_tools.document_ocaml_interf "%.eliomi" "%.odoc");; + +rule "eliom: eliom -> odoc" + ~prod:"%.odoc" + ~deps:["%.eliom"; "%.eliom.depends"] + (Ocaml_tools.document_ocaml_implem "%.eliom" "%.odoc");; + +rule "eliom: eliom & eliom.depends & *cmi -> .inferred.eliomi" + ~prod:"%.inferred.eliomi" + ~deps:["%.eliom"; "%.eliom.depends"] + ~doc:"The target foo.inferred.eliomi will produce a .eliomi that exposes all the \ + declarations in foo.eliom, as obtained by direct invocation of `ocamlc -i`." + (Ocaml_tools.infer_interface "%.eliom" "%.inferred.eliomi");; + +flag ["ocaml"; "client"] (A "-client");; +flag ["ocaml"; "server"] (A "-server");; + +pflag [ "ocaml"; "compile"] "server-I" (fun x -> S[A"-server-I"; A x]);; +pflag [ "ocaml"; "infer_interface"] "server-I" (fun x -> S[A"-server-I"; A x]);; +pflag [ "ocaml"; "doc"] "server-I" (fun x -> S[A"-server-I"; A x]);; + +pflag [ "ocaml"; "compile"] "client-I" (fun x -> S[A"-client-I"; A x]);; +pflag [ "ocaml"; "infer_interface"] "client-I" (fun x -> S[A"-client-I"; A x]);; +pflag [ "ocaml"; "doc"] "client-I" (fun x -> S[A"-client-I"; A x]);; + + end in () + module type ELIOM = sig val server_dir : Ocamlbuild_plugin.Pathname.t - val type_dir : Ocamlbuild_plugin.Pathname.t val client_dir : Ocamlbuild_plugin.Pathname.t end @@ -13,42 +141,21 @@ module type INTERNALS = sig end module MakeIntern (I : INTERNALS)(Eliom : ELIOM) = struct - (* WARNING: if you change this, also change inferred_type_prefix in - ppx/ppx_eliom_utils.ml and tools/eliomc.ml *) - let inferred_type_prefix = "eliom_inferred_type_" - - let sed_rule name ~dep ~prod scripts = - rule name ~dep ~prod - (fun env build -> - let dep = env dep and prod = env prod in - let script_args = List.map (fun script -> S[A"-e"; A script]) scripts in - Cmd (S[A"sed"; S script_args; P dep; Sh">"; Px prod])) - - let copy_with_header src prod = - let contents = Pathname.read src in - (* we need an empty line to keep the comments : weird camlp4 *) - let header = "# 0 \"" ^ src ^ "\"\n\n" in - Pack.Shell.mkdir_p (Filename.dirname prod); - Echo ([header; contents], prod) - - let copy_rule_with_header f name ?(deps=[]) src prod = + + let copy_rule f name ?(deps=[]) src prod = rule name ~deps:(src :: deps) ~prod (fun env _ -> let prod = env prod in let src = env src in f env (Pathname.dirname prod) (Pathname.basename prod) src prod; - copy_with_header src prod + Pack.Shell.mkdir_p (Filename.dirname prod); + cp src prod ) let syntaxes_p4 = [I.with_package "eliom.syntax.predef"] let no_extra_syntaxes = "no_extra_syntaxes" - let eliom_ppx = "eliom_ppx" - - let use_ppx src = - Tags.mem eliom_ppx (tags_of_pathname src) - let tag_file_inside_rule file tags = tag_file file tags; Pack.Param_tags.partial_init "Eliom plugin" (Tags.of_list tags) @@ -59,124 +166,35 @@ module MakeIntern (I : INTERNALS)(Eliom : ELIOM) = struct else not (Tags.mem no_extra_syntaxes (tags_of_pathname src)) - let get_eliom_syntax_p4 = function - | `Client -> - "eliom.syntax.client" - | `Server -> - "eliom.syntax.server" - | `Type -> - "eliom.syntax.type" - - let get_eliom_syntax_ppx = function - | `Client -> - "eliom.ppx.client" - | `Server -> - "eliom.ppx.server" - | `Type -> - "eliom.ppx.type" - - let get_syntaxes_p4 with_eliom_syntax eliom_syntax src = - let eliom_syntax = get_eliom_syntax_p4 eliom_syntax in - let s = if use_all_syntaxes src then syntaxes_p4 else [] in - let s = - if with_eliom_syntax then - I.with_package eliom_syntax :: s - else - s - in - let s = if s = [] then [] else "thread" :: "syntax(camlp4o)" :: s in - s @ Tags.elements (tags_of_pathname src) - - let get_syntaxes_ppx with_eliom_syntax eliom_syntax src = - if with_eliom_syntax then - [I.with_package (get_eliom_syntax_ppx eliom_syntax)] - else - [] - - let get_syntaxes with_eliom_syntax eliom_syntax src = - (if use_ppx src then get_syntaxes_ppx else get_syntaxes_p4) - with_eliom_syntax eliom_syntax src - - (* A variant of flag_and_dep which recurse into Quote. *) - let dflag tags x = - let rec aux = function - | Quote x -> aux x - | S xs -> List.iter aux xs - | P path -> dep tags [path] - | N | A _ | Sh _ | V _ | T _ | Px _ -> () - in - aux x; flag tags x - - let flag_infer ~file ~name ~path eliom_syntax = - let type_inferred = - Pathname.concat - (Pathname.concat path Eliom.type_dir) - (Pathname.update_extension "inferred_gen.mli" name) - in - let ppflags, ppflags_notype = - if use_ppx file then - match I.with_eliom_ppx with - | None -> - let pkg = get_eliom_syntax_ppx eliom_syntax in - (S [A"-ppxopt"; A (pkg ^ ",-type," ^ type_inferred)], - S [A"-ppxopt"; A (pkg ^ ",-notype")]) - | Some f -> - let ppx = f eliom_syntax in - (S [A"-ppx"; Quote (S [P ppx; A"-type"; P type_inferred])], - S [A"-ppx"; Quote (S [P ppx; A"-notype"])]) - else - (S [A "-ppopt"; A "-type"; A "-ppopt"; P type_inferred], - S [A "-ppopt"; A "-notype"]) - in - let file_tag = "file:" ^ file in - dflag ["ocaml"; "ocamldep"; file_tag] ppflags; - dflag ["ocaml"; "compile"; file_tag] ppflags; - dflag ["ocaml"; "infer_interface"; file_tag] ppflags; - dflag ["ocaml"; "doc"; file_tag] ppflags_notype - - let copy_rule_server ?(eliom=true) = - copy_rule_with_header + let copy_rule_server = + copy_rule (fun env dir name src file -> let path = env "%(path)" in - tag_file_inside_rule file - ( I.with_package "eliom.server" - :: get_syntaxes eliom `Server src - ); - if eliom then flag_infer ~file ~name ~path `Server; + tag_file_inside_rule file [ + I.with_package "eliom.server" ; + Printf.sprintf "server-I(%s)" Eliom.server_dir ; + ]; Pathname.define_context dir [path]; Pathname.define_context path [dir]; ) - let copy_rule_client ?(eliom=true) = - copy_rule_with_header + let copy_rule_client = + copy_rule (fun env dir name src file -> let path = env "%(path)" in - tag_file_inside_rule file - ( I.with_package "eliom.client" - :: get_syntaxes eliom `Client src - ); - if eliom then flag_infer ~file ~name ~path `Client; + tag_file_inside_rule file [ + I.with_package "eliom.client" ; + Printf.sprintf "client-I(%s)" Eliom.client_dir ; + ]; Pathname.define_context dir [path]; ) - let copy_rule_type = - copy_rule_with_header - (fun env dir name src file -> - let path = env "%(path)" in - let server_dir = Pathname.concat path Eliom.server_dir in - let server_file = Pathname.concat server_dir name in - tag_file_inside_rule file - ( I.with_package "eliom.server" - :: get_syntaxes true `Type src - @ Tags.elements (tags_of_pathname server_file) - ); - Pathname.define_context dir [path; server_dir]; - ) + + let init = function | After_rules -> mark_tag_used no_extra_syntaxes; - mark_tag_used eliom_ppx; sed_rule ".inferred.mli -> .inferred_gen.mli" ~dep:"%(path)/%(file).inferred.mli" @@ -185,53 +203,24 @@ module MakeIntern (I : INTERNALS)(Eliom : ELIOM) = struct Printf.sprintf "s/'\\(_[a-z0-9_]*\\)/'%s\\1/g" inferred_type_prefix]; (* eliom files *) - copy_rule_server "*.eliom -> **/_server/*.ml" - ~deps:["%(path)/" ^ Eliom.type_dir ^ "/%(file).inferred_gen.mli"] - "%(path)/%(file).eliom" - ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).ml"); - copy_rule_server "*.eliomi -> **/_server/*.mli" - "%(path)/%(file).eliomi" - ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).mli"); - copy_rule_type "*.eliom -> **/_type/*.ml" - "%(path)/%(file).eliom" - ("%(path)/" ^ Eliom.type_dir ^ "/%(file:<*>).ml"); - copy_rule_client "*.eliom -> **/_client/*.ml" - ~deps:["%(path)/" ^ Eliom.type_dir ^ "/%(file).inferred_gen.mli"] - "%(path)/%(file).eliom" - ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).ml"); - copy_rule_client "*.eliomi -> **/_client/*.mli" - "%(path)/%(file).eliomi" - ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).mli"); - - copy_rule_server "*.eliom -> _server/*.ml" - ~deps:[Eliom.type_dir ^ "/%(file).inferred_gen.mli"] - "%(file).eliom" (Eliom.server_dir ^ "/%(file:<*>).ml"); - copy_rule_server "*.eliomi -> _server/*.mli" - "%(file).eliomi" (Eliom.server_dir ^ "/%(file:<*>).mli"); - copy_rule_type "*.eliom -> _type/*.ml" - "%(file).eliom" (Eliom.type_dir ^ "/%(file:<*>).ml"); - copy_rule_client "*.eliom -> _client/*.ml" - ~deps:[Eliom.type_dir ^ "/%(file).inferred_gen.mli"] - "%(file).eliom" (Eliom.client_dir ^ "/%(file:<*>).ml"); - copy_rule_client "*.eliomi -> _client/*.mli" - "%(file).eliomi" (Eliom.client_dir ^ "/%(file:<*>).mli"); + init () ; (* copy {shared,client,server}.ml rules *) - copy_rule_client ~eliom:false "client.ml -> .ml" + copy_rule_client "client.ml -> .ml" "%(path)/%(file).client.ml" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).ml"); - copy_rule_client ~eliom:false "client.mli -> .mli" + copy_rule_client "client.mli -> .mli" "%(path)/%(file).client.mli" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).mli"); - copy_rule_client ~eliom:false "shared.ml -> client.ml" + copy_rule_client "shared.ml -> client.ml" "%(path)/%(file).shared.ml" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).ml"); - copy_rule_client ~eliom:false "shared -> client.mli" + copy_rule_client "shared -> client.mli" "%(path)/%(file).shared.mli" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).mli"); - copy_rule_server ~eliom:false "server.ml -> .ml" + copy_rule_server "server.ml -> .ml" "%(path)/%(file).server.ml" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).ml"); - copy_rule_server ~eliom:false "server.mli -> .mli" + copy_rule_server "server.mli -> .mli" "%(path)/%(file).server.mli" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).mli"); - copy_rule_server ~eliom:false "shared.ml -> server.ml" + copy_rule_server "shared.ml -> server.ml" "%(path)/%(file).shared.ml" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).ml"); - copy_rule_server ~eliom:false "shared.ml -> server.mli" + copy_rule_server "shared.ml -> server.mli" "%(path)/%(file).shared.mli" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).mli"); | _ -> () diff --git a/src/ocamlbuild/ocamlbuild_eliom.mli b/src/ocamlbuild/ocamlbuild_eliom.mli index adbf2898d6..7908922280 100644 --- a/src/ocamlbuild/ocamlbuild_eliom.mli +++ b/src/ocamlbuild/ocamlbuild_eliom.mli @@ -1,7 +1,6 @@ (** The paths to each eliom directories *) module type ELIOM = sig val server_dir : Ocamlbuild_plugin.Pathname.t - val type_dir : Ocamlbuild_plugin.Pathname.t val client_dir : Ocamlbuild_plugin.Pathname.t end From e905cdb42f63e934d18157f9fff8bfa91f445db0 Mon Sep 17 00:00:00 2001 From: Drup Date: Thu, 22 Sep 2016 18:53:47 +0200 Subject: [PATCH 06/23] More modifications to the build system. --- src/_tags | 41 ++++++--------- src/ocamlbuild/ocamlbuild_eliom.ml | 80 ++++++++++++++++++++---------- 2 files changed, 71 insertions(+), 50 deletions(-) diff --git a/src/_tags b/src/_tags index b9e3957f9f..3af681025f 100644 --- a/src/_tags +++ b/src/_tags @@ -1,33 +1,26 @@ <{lib,tools,ocamlbuild,syntax}/**/*>:warn(+A-4-6-7-9-27-32-33-34-37-40-42-44-48) true:keep_locs -:eliom_ppx,thread -:package(js_of_ocaml.deriving.ppx,lwt.ppx) -:package(js_of_ocaml.ppx) +: \ + thread, \ + package(lwt,lwt.ppx,react,tyxml.functor), \ + server-package(lwt,ocsigenserver,ocsigenserver.ext), \ + client-package(js_of_ocaml.ppx,js_of_ocaml.deriving.ppx), \ + client-package(js_of_ocaml.log), \ + client-package(ocsigenserver.cookies,ocsigenserver.polytables,ocsigenserver.baselib.base), \ + client-package(deriving.runtime,js_of_ocaml.deriving), \ + client-package(lwt.react,js_of_ocaml.tyxml), \ + client-package(js_of_ocaml,reactiveData) -:eliom_ppx -:package(js_of_ocaml.deriving.ppx,lwt.ppx) -:package(js_of_ocaml.ppx) - -:thread -:package(lwt,ocsigenserver,ocsigenserver.ext,tyxml.functor) -:package(react,js_of_ocaml) - -:package(js_of_ocaml.deriving.ppx) - -:eliom_ppx +:package(reactiveData) -:eliom_ppx -:package(js_of_ocaml.deriving.ppx,lwt.ppx,js_of_ocaml.log) -:package(js_of_ocaml.ppx) +:client,I(src/lib) +:client,client-I(src/lib/client) -: eliom_ppx -:package(ocsigenserver.cookies,ocsigenserver.polytables,ocsigenserver.baselib.base) -:package(deriving.runtime,js_of_ocaml.deriving) -:package(lwt.react,tyxml.functor,js_of_ocaml.tyxml) -:package(react,js_of_ocaml,reactiveData) +:server,I(src/lib) +:server,server-I(src/lib/server) -:package(js_of_ocaml.deriving.ppx) +:eliom, package(eliomlang.ppx) :package(lwt.ppx) :thread @@ -56,5 +49,3 @@ true:keep_locs : manpage,man_ext(3o),apiref <**/api.wikidocdir/index.wiki>: apiref, wikidoc - -:package(reactiveData) diff --git a/src/ocamlbuild/ocamlbuild_eliom.ml b/src/ocamlbuild/ocamlbuild_eliom.ml index 284be56dcd..af2a93a077 100644 --- a/src/ocamlbuild/ocamlbuild_eliom.ml +++ b/src/ocamlbuild/ocamlbuild_eliom.ml @@ -117,16 +117,43 @@ rule "eliom: eliom & eliom.depends & *cmi -> .inferred.eliomi" declarations in foo.eliom, as obtained by direct invocation of `ocamlc -i`." (Ocaml_tools.infer_interface "%.eliom" "%.inferred.eliomi");; -flag ["ocaml"; "client"] (A "-client");; -flag ["ocaml"; "server"] (A "-server");; +let compile_tags = [ + ["ocaml"; "byte"; "compile"]; + ["ocaml"; "native"; "compile"]; + ["ocaml"; "infer_interface"]; +] in +let link_tags = [ + ["ocaml"; "byte"; "link"]; + ["ocaml"; "native"; "link"]; +] in +let other_tags = [ + ["ocaml"; "ocamldep"]; + ["ocaml"; "doc"]; +] in + +List.iter (fun tags -> + pflag tags "server-package" (fun pkg -> S [A "-server-package"; A pkg]); + pflag tags "client-package" (fun pkg -> S [A "-client-package"; A pkg]); +) (compile_tags @ link_tags) ; +List.iter (fun tags -> + pflag tags "server-I" (fun x -> S[A"-server-I"; A x]); + pflag tags "server-I" (fun x -> S[A"-server-I"; A x]); + pflag tags "server-I" (fun x -> S[A"-server-I"; A x]); +) (compile_tags @ link_tags); +List.iter (fun tags -> + flag ("client"::tags) (S [A "-passopt" ; A "-mode"; A "-passopt" ; A "client"]); + flag ("server"::tags) (S [A "-passopt" ; A "-mode"; A "-passopt" ; A "server"]); + flag ("eliom"::tags) (S [A "-passopt" ; A "-mode"; A "-passopt" ; A "eliom"]); +) (compile_tags @ link_tags @ other_tags) ;; + +(* pflag [ "ocaml"; "compile"] "server-I" (fun x -> S[A"-server-I"; A x]);; *) +(* pflag [ "ocaml"; "infer_interface"] "server-I" (fun x -> S[A"-server-I"; A x]);; *) +(* pflag [ "ocaml"; "doc"] "server-I" (fun x -> S[A"-server-I"; A x]);; *) + +(* pflag [ "ocaml"; "compile"] "client-I" (fun x -> S[A"-client-I"; A x]);; *) +(* pflag [ "ocaml"; "infer_interface"] "client-I" (fun x -> S[A"-client-I"; A x]);; *) +(* pflag [ "ocaml"; "doc"] "client-I" (fun x -> S[A"-client-I"; A x]);; *) -pflag [ "ocaml"; "compile"] "server-I" (fun x -> S[A"-server-I"; A x]);; -pflag [ "ocaml"; "infer_interface"] "server-I" (fun x -> S[A"-server-I"; A x]);; -pflag [ "ocaml"; "doc"] "server-I" (fun x -> S[A"-server-I"; A x]);; - -pflag [ "ocaml"; "compile"] "client-I" (fun x -> S[A"-client-I"; A x]);; -pflag [ "ocaml"; "infer_interface"] "client-I" (fun x -> S[A"-client-I"; A x]);; -pflag [ "ocaml"; "doc"] "client-I" (fun x -> S[A"-client-I"; A x]);; end in () @@ -206,22 +233,25 @@ module MakeIntern (I : INTERNALS)(Eliom : ELIOM) = struct init () ; (* copy {shared,client,server}.ml rules *) - copy_rule_client "client.ml -> .ml" - "%(path)/%(file).client.ml" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).ml"); - copy_rule_client "client.mli -> .mli" - "%(path)/%(file).client.mli" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).mli"); - copy_rule_client "shared.ml -> client.ml" - "%(path)/%(file).shared.ml" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).ml"); - copy_rule_client "shared -> client.mli" - "%(path)/%(file).shared.mli" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).mli"); - copy_rule_server "server.ml -> .ml" - "%(path)/%(file).server.ml" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).ml"); - copy_rule_server "server.mli -> .mli" - "%(path)/%(file).server.mli" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).mli"); - copy_rule_server "shared.ml -> server.ml" - "%(path)/%(file).shared.ml" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).ml"); - copy_rule_server "shared.ml -> server.mli" - "%(path)/%(file).shared.mli" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).mli"); + (* copy_rule_client "client.ml -> .ml" *) + (* "%(path)/%(file).client.ml" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).ml"); *) + (* copy_rule_client "client.mli -> .mli" *) + (* "%(path)/%(file).client.mli" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).mli"); *) + + (* copy_rule_client "shared.ml -> client.ml" *) + (* "%(path)/%(file).shared.ml" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).ml"); *) + (* copy_rule_client "shared -> client.mli" *) + (* "%(path)/%(file).shared.mli" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).mli"); *) + + (* copy_rule_server "server.ml -> .ml" *) + (* "%(path)/%(file).server.ml" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).ml"); *) + (* copy_rule_server "server.mli -> .mli" *) + (* "%(path)/%(file).server.mli" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).mli"); *) + + (* copy_rule_server "shared.ml -> server.ml" *) + (* "%(path)/%(file).shared.ml" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).ml"); *) + (* copy_rule_server "shared.ml -> server.mli" *) + (* "%(path)/%(file).shared.mli" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).mli"); *) | _ -> () From 73944b47c7b43b77435fa3a6fd9c707341b9764e Mon Sep 17 00:00:00 2001 From: Drup Date: Fri, 23 Sep 2016 18:27:39 +0200 Subject: [PATCH 07/23] Progress on the build system front. --- build/build.ml | 2 ++ src/_tags | 18 +++++++++++++++++- src/ocamlbuild/ocamlbuild_eliom.ml | 10 ++++++++++ 3 files changed, 29 insertions(+), 1 deletion(-) diff --git a/build/build.ml b/build/build.ml index 34fb034299..66235a79f7 100644 --- a/build/build.ml +++ b/build/build.ml @@ -67,5 +67,7 @@ let _ = Options.make_links:=false; Options.plugin := false; Options.use_ocamlfind := true; + Pack.Log.classic_display := true; + Pack.Log.level := 4; Ocamlbuild_unix_plugin.setup (); Ocamlbuild_pack.Main.main () diff --git a/src/_tags b/src/_tags index 3af681025f..8a4ad0d2b8 100644 --- a/src/_tags +++ b/src/_tags @@ -1,10 +1,26 @@ <{lib,tools,ocamlbuild,syntax}/**/*>:warn(+A-4-6-7-9-27-32-33-34-37-40-42-44-48) true:keep_locs -: \ +"lib/client":include +: \ + package(js_of_ocaml.ppx,js_of_ocaml.deriving.ppx), \ + package(js_of_ocaml.log), \ + package(ocsigenserver.cookies,ocsigenserver.polytables,ocsigenserver.baselib.base), \ + package(deriving.runtime,js_of_ocaml.deriving), \ + package(lwt.react,js_of_ocaml.tyxml), \ + package(js_of_ocaml,reactiveData) + +"lib/server":include +: \ + package(lwt,ocsigenserver,ocsigenserver.ext) + +"lib":include +: \ thread, \ package(lwt,lwt.ppx,react,tyxml.functor), \ + server-package(eliomlang.runtime.server), \ server-package(lwt,ocsigenserver,ocsigenserver.ext), \ + client-package(eliomlang.runtime.client), \ client-package(js_of_ocaml.ppx,js_of_ocaml.deriving.ppx), \ client-package(js_of_ocaml.log), \ client-package(ocsigenserver.cookies,ocsigenserver.polytables,ocsigenserver.baselib.base), \ diff --git a/src/ocamlbuild/ocamlbuild_eliom.ml b/src/ocamlbuild/ocamlbuild_eliom.ml index af2a93a077..db62e783f9 100644 --- a/src/ocamlbuild/ocamlbuild_eliom.ml +++ b/src/ocamlbuild/ocamlbuild_eliom.ml @@ -117,6 +117,16 @@ rule "eliom: eliom & eliom.depends & *cmi -> .inferred.eliomi" declarations in foo.eliom, as obtained by direct invocation of `ocamlc -i`." (Ocaml_tools.infer_interface "%.eliom" "%.inferred.eliomi");; +rule "eliom: splitted files" + ~prod:"%(name:<*> and not <*.client> and not <*.server>).cmi" + ~deps:["%(name).client.cmi";"%(name).server.cmi"] + (fun _ _ -> Nop);; + +rule "eliom: splitted files, rules 2" + ~prod:"%(name:<**/*> and not <**/*.client> and not <**/*.server>).cmi" + ~deps:["%(name).client.cmi";"%(name).server.cmi"] + (fun _ _ -> Nop);; + let compile_tags = [ ["ocaml"; "byte"; "compile"]; ["ocaml"; "native"; "compile"]; From 04d89e61d3658ca20df9a58a669cec529d5ce3ac Mon Sep 17 00:00:00 2001 From: Drup Date: Wed, 28 Sep 2016 20:07:48 +0200 Subject: [PATCH 08/23] Implement copy rules properly and remove old stuff. --- src/ocamlbuild/ocamlbuild_eliom.ml | 109 ++++++----------------------- 1 file changed, 23 insertions(+), 86 deletions(-) diff --git a/src/ocamlbuild/ocamlbuild_eliom.ml b/src/ocamlbuild/ocamlbuild_eliom.ml index db62e783f9..dd0c8f7a0c 100644 --- a/src/ocamlbuild/ocamlbuild_eliom.ml +++ b/src/ocamlbuild/ocamlbuild_eliom.ml @@ -1,6 +1,16 @@ open Ocamlbuild_plugin module Pack = Ocamlbuild_pack +let copy_rule name src prod = + rule name ~dep:src ~prod + (fun env _ -> + let prod = env prod in + let src = env src in + (* f env (Pathname.dirname prod) (Pathname.basename prod) src prod; *) + Pack.Shell.mkdir_p (Filename.dirname prod); + cp src prod + ) + let init () = let module Eliom_rules = struct open Pack ;; @@ -117,12 +127,12 @@ rule "eliom: eliom & eliom.depends & *cmi -> .inferred.eliomi" declarations in foo.eliom, as obtained by direct invocation of `ocamlc -i`." (Ocaml_tools.infer_interface "%.eliom" "%.inferred.eliomi");; -rule "eliom: splitted files" +rule "eliom: {server,client}.cmi -> cmi" ~prod:"%(name:<*> and not <*.client> and not <*.server>).cmi" ~deps:["%(name).client.cmi";"%(name).server.cmi"] (fun _ _ -> Nop);; -rule "eliom: splitted files, rules 2" +rule "eliom: {server,client}.cmi -> cmi | in subdir" ~prod:"%(name:<**/*> and not <**/*.client> and not <**/*.server>).cmi" ~deps:["%(name).client.cmi";"%(name).server.cmi"] (fun _ _ -> Nop);; @@ -165,6 +175,16 @@ List.iter (fun tags -> (* pflag [ "ocaml"; "doc"] "client-I" (fun x -> S[A"-client-I"; A x]);; *) +copy_rule "shared.ml -> client.ml" + "%(path)/%(file).shared.ml" "%(path)/%(file).client.ml";; +copy_rule "shared.mli -> client.mli" + "%(path)/%(file).shared.mli" "%(path)/%(file).client.mli";; + +copy_rule "shared.mli -> server.ml" + "%(path)/%(file).shared.ml" "%(path)/%(file).server.ml";; +copy_rule "shared.mli -> server.mli" + "%(path)/%(file).shared.mli" "%(path)/%(file).server.mli";; + end in () module type ELIOM = sig @@ -178,91 +198,8 @@ module type INTERNALS = sig end module MakeIntern (I : INTERNALS)(Eliom : ELIOM) = struct - - let copy_rule f name ?(deps=[]) src prod = - rule name ~deps:(src :: deps) ~prod - (fun env _ -> - let prod = env prod in - let src = env src in - f env (Pathname.dirname prod) (Pathname.basename prod) src prod; - Pack.Shell.mkdir_p (Filename.dirname prod); - cp src prod - ) - - let syntaxes_p4 = [I.with_package "eliom.syntax.predef"] - - let no_extra_syntaxes = "no_extra_syntaxes" - - let tag_file_inside_rule file tags = - tag_file file tags; - Pack.Param_tags.partial_init "Eliom plugin" (Tags.of_list tags) - - let use_all_syntaxes src = - if Filename.check_suffix src ".eliomi" then - false - else - not (Tags.mem no_extra_syntaxes (tags_of_pathname src)) - - let copy_rule_server = - copy_rule - (fun env dir name src file -> - let path = env "%(path)" in - tag_file_inside_rule file [ - I.with_package "eliom.server" ; - Printf.sprintf "server-I(%s)" Eliom.server_dir ; - ]; - Pathname.define_context dir [path]; - Pathname.define_context path [dir]; - ) - - let copy_rule_client = - copy_rule - (fun env dir name src file -> - let path = env "%(path)" in - tag_file_inside_rule file [ - I.with_package "eliom.client" ; - Printf.sprintf "client-I(%s)" Eliom.client_dir ; - ]; - Pathname.define_context dir [path]; - ) - - - - let init = function - | After_rules -> - mark_tag_used no_extra_syntaxes; - - sed_rule ".inferred.mli -> .inferred_gen.mli" - ~dep:"%(path)/%(file).inferred.mli" - ~prod:"%(path)/%(file).inferred_gen.mli" - ["s/_\\[\\([<>]\\)/[\\1/g"; - Printf.sprintf "s/'\\(_[a-z0-9_]*\\)/'%s\\1/g" inferred_type_prefix]; - - (* eliom files *) - init () ; - - (* copy {shared,client,server}.ml rules *) - (* copy_rule_client "client.ml -> .ml" *) - (* "%(path)/%(file).client.ml" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).ml"); *) - (* copy_rule_client "client.mli -> .mli" *) - (* "%(path)/%(file).client.mli" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).mli"); *) - - (* copy_rule_client "shared.ml -> client.ml" *) - (* "%(path)/%(file).shared.ml" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).ml"); *) - (* copy_rule_client "shared -> client.mli" *) - (* "%(path)/%(file).shared.mli" ("%(path)/" ^ Eliom.client_dir ^ "/%(file:<*>).mli"); *) - - (* copy_rule_server "server.ml -> .ml" *) - (* "%(path)/%(file).server.ml" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).ml"); *) - (* copy_rule_server "server.mli -> .mli" *) - (* "%(path)/%(file).server.mli" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).mli"); *) - - (* copy_rule_server "shared.ml -> server.ml" *) - (* "%(path)/%(file).shared.ml" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).ml"); *) - (* copy_rule_server "shared.ml -> server.mli" *) - (* "%(path)/%(file).shared.mli" ("%(path)/" ^ Eliom.server_dir ^ "/%(file:<*>).mli"); *) - + | After_rules -> init () ; | _ -> () let dispatcher ?oasis_executables hook = From b82e0f8ff3e1745344a916bfb7adf06f111c219c Mon Sep 17 00:00:00 2001 From: Drup Date: Thu, 29 Sep 2016 20:48:02 +0200 Subject: [PATCH 09/23] Fix the family of I tags. --- build/build.ml | 7 +------ src/ocamlbuild/ocamlbuild_eliom.ml | 8 +++++--- 2 files changed, 6 insertions(+), 9 deletions(-) diff --git a/build/build.ml b/build/build.ml index 66235a79f7..45ef811d98 100644 --- a/build/build.ml +++ b/build/build.ml @@ -36,11 +36,6 @@ let _ = dispatch (fun x -> rule (Printf.sprintf "%s -> %s" source dest) ~dep:source ~prod:dest (fun env _ -> Cmd (S [A"ln"; A"-f";P (env source); P (env dest)])) in - (* add I pflag *) - pflag [ "ocaml"; "compile"] "I" (fun x -> S[A"-I"; A x]); - pflag [ "ocaml"; "infer_interface"] "I" (fun x -> S[A"-I"; A x]); - pflag [ "ocaml"; "doc"] "I" (fun x -> S[A"-I"; A x]); - (* add syntax extension *) let add_syntax name path = let bytes_dep = Findlib.(link_flags_byte [query "bytes"]) in @@ -68,6 +63,6 @@ let _ = Options.plugin := false; Options.use_ocamlfind := true; Pack.Log.classic_display := true; - Pack.Log.level := 4; + Pack.Log.level := 3; Ocamlbuild_unix_plugin.setup (); Ocamlbuild_pack.Main.main () diff --git a/src/ocamlbuild/ocamlbuild_eliom.ml b/src/ocamlbuild/ocamlbuild_eliom.ml index dd0c8f7a0c..d9cda5aacb 100644 --- a/src/ocamlbuild/ocamlbuild_eliom.ml +++ b/src/ocamlbuild/ocamlbuild_eliom.ml @@ -155,11 +155,13 @@ List.iter (fun tags -> pflag tags "server-package" (fun pkg -> S [A "-server-package"; A pkg]); pflag tags "client-package" (fun pkg -> S [A "-client-package"; A pkg]); ) (compile_tags @ link_tags) ; + List.iter (fun tags -> - pflag tags "server-I" (fun x -> S[A"-server-I"; A x]); - pflag tags "server-I" (fun x -> S[A"-server-I"; A x]); - pflag tags "server-I" (fun x -> S[A"-server-I"; A x]); + pflag tags "server-I" (fun x -> S[A"-server-I"; P x]); + pflag tags "client-I" (fun x -> S[A"-client-I"; P x]); + pflag tags "I" (fun x -> S[A"-I"; P x]); ) (compile_tags @ link_tags); + List.iter (fun tags -> flag ("client"::tags) (S [A "-passopt" ; A "-mode"; A "-passopt" ; A "client"]); flag ("server"::tags) (S [A "-passopt" ; A "-mode"; A "-passopt" ; A "server"]); From 7e31fab11a6c766a2de01594a8ac1dfc7f80599f Mon Sep 17 00:00:00 2001 From: Drup Date: Thu, 29 Sep 2016 20:48:36 +0200 Subject: [PATCH 10/23] be a lot more liberal in what is included where. --- src/_tags | 49 ++++++++++++++++++++++++++++++------------------- 1 file changed, 30 insertions(+), 19 deletions(-) diff --git a/src/_tags b/src/_tags index 8a4ad0d2b8..d93a7fcf58 100644 --- a/src/_tags +++ b/src/_tags @@ -1,27 +1,29 @@ <{lib,tools,ocamlbuild,syntax}/**/*>:warn(+A-4-6-7-9-27-32-33-34-37-40-42-44-48) true:keep_locs -"lib/client":include -: \ - package(js_of_ocaml.ppx,js_of_ocaml.deriving.ppx), \ - package(js_of_ocaml.log), \ - package(ocsigenserver.cookies,ocsigenserver.polytables,ocsigenserver.baselib.base), \ - package(deriving.runtime,js_of_ocaml.deriving), \ - package(lwt.react,js_of_ocaml.tyxml), \ - package(js_of_ocaml,reactiveData) - -"lib/server":include -: \ - package(lwt,ocsigenserver,ocsigenserver.ext) +# : \ +# package(js_of_ocaml.ppx,js_of_ocaml.deriving.ppx), \ +# package(js_of_ocaml.log), \ +# package(ocsigenserver.cookies,ocsigenserver.polytables,ocsigenserver.baselib.base), \ +# package(deriving.runtime,js_of_ocaml.deriving), \ +# package(lwt.react,js_of_ocaml.tyxml), \ +# package(js_of_ocaml,reactiveData) + +# : \ +# package(lwt,ocsigenserver,ocsigenserver.ext) + +"lib/server": include +"lib/client": include "lib":include -: \ +: \ + client-I(src/lib/client), server-I(src/lib/server), \ thread, \ - package(lwt,lwt.ppx,react,tyxml.functor), \ + package(lwt,lwt.ppx,react,tyxml.functor,js_of_ocaml.deriving.ppx), \ server-package(eliomlang.runtime.server), \ server-package(lwt,ocsigenserver,ocsigenserver.ext), \ client-package(eliomlang.runtime.client), \ - client-package(js_of_ocaml.ppx,js_of_ocaml.deriving.ppx), \ + package(js_of_ocaml.ppx), \ client-package(js_of_ocaml.log), \ client-package(ocsigenserver.cookies,ocsigenserver.polytables,ocsigenserver.baselib.base), \ client-package(deriving.runtime,js_of_ocaml.deriving), \ @@ -30,14 +32,23 @@ true:keep_locs :package(reactiveData) -:client,I(src/lib) -:client,client-I(src/lib/client) +:client +:client -:server,I(src/lib) -:server,server-I(src/lib/server) +:server +:server :eliom, package(eliomlang.ppx) + + +:package(js_of_ocaml.deriving.ppx,lwt.ppx) + +:thread +:package(lwt,ocsigenserver,ocsigenserver.ext,tyxml,calendar) +:package(js_of_ocaml.deriving.ppx) +:I(src/lib/server) + :package(lwt.ppx) :thread :package(lwt,ocsigenserver,ocsigenserver.ext,tyxml,calendar) From 8701cd0f76bc92eb3d3dcfae0c45b05c35e77a32 Mon Sep 17 00:00:00 2001 From: Drup Date: Thu, 8 Dec 2016 21:35:41 +0100 Subject: [PATCH 11/23] Remove the useless functor for the ocamlbuild plugins. --- build/build.ml | 27 +--------- src/ocamlbuild/eliombuild.ml | 9 +--- src/ocamlbuild/ocamlbuild_eliom.ml | 33 +++--------- src/ocamlbuild/ocamlbuild_eliom.mli | 81 ++++++++++------------------- 4 files changed, 37 insertions(+), 113 deletions(-) diff --git a/build/build.ml b/build/build.ml index 45ef811d98..1a63cd6792 100644 --- a/build/build.ml +++ b/build/build.ml @@ -1,33 +1,8 @@ open Ocamlbuild_plugin module Pack = Ocamlbuild_pack -module Conf = struct - let server_dir = "server" - let client_dir = "client" - let type_dir = "type_dir" -end - -module Intern = struct - - let with_eliom_ppx = Some begin function - | `Client -> "src/ppx/ppx_eliom_client_ex.native" - | `Server -> "src/ppx/ppx_eliom_server_ex.native" - end - - let with_package = function - | "eliom.ppx.type" -> "pkg_ppx_eliom_types" - | "eliom.ppx.client" - | "eliom.ppx.server" - | "eliom.syntax.predef" - | "eliom.client" - | "eliom.server" -> (* do noting in this case *) "pkg_dummy" - | _ -> assert false -end - -module Eliom_plugin = Ocamlbuild_eliom.MakeIntern(Intern)(Conf) - let _ = dispatch (fun x -> - Eliom_plugin.dispatcher x; + Ocamlbuild_eliom.dispatcher x; match x with | After_rules -> Doc.init (); diff --git a/src/ocamlbuild/eliombuild.ml b/src/ocamlbuild/eliombuild.ml index 914f11de10..69f6f09c0d 100644 --- a/src/ocamlbuild/eliombuild.ml +++ b/src/ocamlbuild/eliombuild.ml @@ -1,14 +1,7 @@ open Ocamlbuild_plugin module Pack = Ocamlbuild_pack -module Conf = struct - let server_dir = "server" - let client_dir = "client" - let type_dir = "type_dir" -end - -module Eliom_plugin = Ocamlbuild_eliom.Make(Conf) -let _ = dispatch Eliom_plugin.dispatcher +let _ = dispatch Ocamlbuild_eliom.dispatcher let _ = Options.make_links:=false; diff --git a/src/ocamlbuild/ocamlbuild_eliom.ml b/src/ocamlbuild/ocamlbuild_eliom.ml index d9cda5aacb..240aa4d902 100644 --- a/src/ocamlbuild/ocamlbuild_eliom.ml +++ b/src/ocamlbuild/ocamlbuild_eliom.ml @@ -189,29 +189,10 @@ copy_rule "shared.mli -> server.mli" end in () -module type ELIOM = sig - val server_dir : Ocamlbuild_plugin.Pathname.t - val client_dir : Ocamlbuild_plugin.Pathname.t -end - -module type INTERNALS = sig - val with_eliom_ppx : ([< `Client | `Server] -> string) option - val with_package : string -> string -end -module MakeIntern (I : INTERNALS)(Eliom : ELIOM) = struct - - let init = function - | After_rules -> init () ; - | _ -> () - - let dispatcher ?oasis_executables hook = - Ocamlbuild_js_of_ocaml.dispatcher ?oasis_executables hook; - init hook -end - -module Make(Eliom : ELIOM) = MakeIntern - (struct - let with_eliom_ppx = None - let with_package = Printf.sprintf "package(%s)" - end) - (Eliom) +let init = function + | After_rules -> init () ; + | _ -> () + +let dispatcher ?oasis_executables hook = + Ocamlbuild_js_of_ocaml.dispatcher ?oasis_executables hook; + init hook diff --git a/src/ocamlbuild/ocamlbuild_eliom.mli b/src/ocamlbuild/ocamlbuild_eliom.mli index 7908922280..e9a4d832fa 100644 --- a/src/ocamlbuild/ocamlbuild_eliom.mli +++ b/src/ocamlbuild/ocamlbuild_eliom.mli @@ -1,54 +1,29 @@ -(** The paths to each eliom directories *) -module type ELIOM = sig - val server_dir : Ocamlbuild_plugin.Pathname.t - val client_dir : Ocamlbuild_plugin.Pathname.t -end -module Make (Eliom : ELIOM) : sig - (** The main dispatcher - - It calls {!Ocamlbuild_js_of_ocaml.dispatcher} first, with the same - parameters, and then initialize the plugin for eliom. - - The dispatcher should be used with {!Ocamlbuild_plugin.dispatch} as: - [Ocamlbuild_plugin.dispatch Ocamlbuild_eliom.dispatcher] - or if you use oasis it would look like: - [Ocamlbuild_plugin.dispatch - (fun hook -> - dispatch_default hook; - Ocamlbuild_js_of_ocaml.dispatcher - ~oasis_executables:["src/yourprogram.byte"] - hook; - ) - ] - - [?oasis_executables] is the paths of the executables - (having the .byte extension) you want to compile - as a javascript executable. The former executables are still compiled. - - Side note: {!Ocamlbuild_plugin.dispatch} should be used only once as - it record only one function for an ocamlbuild module. - *) - val dispatcher : - ?oasis_executables:Ocamlbuild_plugin.Pathname.t list -> - Ocamlbuild_plugin.hook -> - unit -end - - -(**/**) -module type INTERNALS = sig - val with_eliom_ppx : ([< `Client | `Server] -> string) option - (** Internally built client and server ppx executables are invoked explicitely - in order to pass the right -type arguments. Other syntax extensions are - handled by {!with_package} *) - - val with_package : string -> string -end - -module MakeIntern (I : INTERNALS)(Eliom : ELIOM) : sig - val dispatcher : - ?oasis_executables:Ocamlbuild_plugin.Pathname.t list -> - Ocamlbuild_plugin.hook -> - unit -end +(** The main dispatcher + + It calls {!Ocamlbuild_js_of_ocaml.dispatcher} first, with the same + parameters, and then initialize the plugin for eliom. + + The dispatcher should be used with {!Ocamlbuild_plugin.dispatch} as: + [Ocamlbuild_plugin.dispatch Ocamlbuild_eliom.dispatcher] + or if you use oasis it would look like: + [Ocamlbuild_plugin.dispatch + (fun hook -> + dispatch_default hook; + Ocamlbuild_js_of_ocaml.dispatcher + ~oasis_executables:["src/yourprogram.byte"] + hook; + ) + ] + + [?oasis_executables] is the paths of the executables + (having the .byte extension) you want to compile + as a javascript executable. The former executables are still compiled. + + Side note: {!Ocamlbuild_plugin.dispatch} should be used only once as + it record only one function for an ocamlbuild module. +*) +val dispatcher : + ?oasis_executables:Ocamlbuild_plugin.Pathname.t list -> + Ocamlbuild_plugin.hook -> + unit From 26f04ed2654922154e4f296e00402c87c6c1da12 Mon Sep 17 00:00:00 2001 From: Drup Date: Thu, 8 Dec 2016 21:38:27 +0100 Subject: [PATCH 12/23] Remove the ppx and the camlp4 syntax extension. --- .jenkins.sh | 3 +- Makefile | 5 +- build/build.ml | 13 - opam | 1 - pkg/META | 62 -- pkg/build.ml | 28 +- pkg/filelist.ml | 12 - src/_tags | 8 +- src/ppx/.merlin | 4 - src/ppx/_tags | 1 - src/ppx/ppx_eliom.ml | 1 - src/ppx/ppx_eliom.mli | 4 - src/ppx/ppx_eliom_client.ml | 260 -------- src/ppx/ppx_eliom_client.mli | 2 - src/ppx/ppx_eliom_client_ex.ml | 2 - src/ppx/ppx_eliom_server.ml | 211 ------ src/ppx/ppx_eliom_server.mli | 2 - src/ppx/ppx_eliom_server_ex.ml | 2 - src/ppx/ppx_eliom_type.ml | 145 ---- src/ppx/ppx_eliom_type.mli | 2 - src/ppx/ppx_eliom_types_ex.ml | 2 - src/ppx/ppx_eliom_utils.ml | 675 ------------------- src/ppx/ppx_eliom_utils.mli | 88 --- src/syntax/pa_eliom_client_client.ml | 319 --------- src/syntax/pa_eliom_client_server.ml | 259 ------- src/syntax/pa_eliom_seed.ml | 963 --------------------------- src/syntax/pa_eliom_type_filter.ml | 157 ----- 27 files changed, 5 insertions(+), 3226 deletions(-) delete mode 100644 src/ppx/.merlin delete mode 100644 src/ppx/_tags delete mode 100644 src/ppx/ppx_eliom.ml delete mode 100644 src/ppx/ppx_eliom.mli delete mode 100644 src/ppx/ppx_eliom_client.ml delete mode 100644 src/ppx/ppx_eliom_client.mli delete mode 100644 src/ppx/ppx_eliom_client_ex.ml delete mode 100644 src/ppx/ppx_eliom_server.ml delete mode 100644 src/ppx/ppx_eliom_server.mli delete mode 100644 src/ppx/ppx_eliom_server_ex.ml delete mode 100644 src/ppx/ppx_eliom_type.ml delete mode 100644 src/ppx/ppx_eliom_type.mli delete mode 100644 src/ppx/ppx_eliom_types_ex.ml delete mode 100644 src/ppx/ppx_eliom_utils.ml delete mode 100644 src/ppx/ppx_eliom_utils.mli delete mode 100644 src/syntax/pa_eliom_client_client.ml delete mode 100644 src/syntax/pa_eliom_client_server.ml delete mode 100644 src/syntax/pa_eliom_seed.ml delete mode 100644 src/syntax/pa_eliom_type_filter.ml diff --git a/.jenkins.sh b/.jenkins.sh index 1bd1b87f4f..37c2d0e2dd 100644 --- a/.jenkins.sh +++ b/.jenkins.sh @@ -5,11 +5,10 @@ opam install --verbose eliom do_build_doc () { make wikidoc cp -Rf doc/manual-wiki/*.wiki ${MANUAL_SRC_DIR} - mkdir -p ${API_DIR}/server ${API_DIR}/client ${API_DIR}/ocamlbuild ${API_DIR}/ppx + mkdir -p ${API_DIR}/server ${API_DIR}/client ${API_DIR}/ocamlbuild $ cp -Rf _build/src/lib/server/api.wikidocdir/*.wiki ${API_DIR}/server/ cp -Rf _build/src/lib/client/api.wikidocdir/*.wiki ${API_DIR}/client/ cp -Rf _build/src/ocamlbuild/api.wikidocdir/*.wiki ${API_DIR}/ocamlbuild/ - cp -Rf _build/src/ppx/api.wikidocdir/*.wiki ${API_DIR}/ppx/ cp -Rf doc/index.wiki ${API_DIR}/ } diff --git a/Makefile b/Makefile index 82122c88c4..357051e65e 100644 --- a/Makefile +++ b/Makefile @@ -15,13 +15,12 @@ $(BUILDER): $(wildcard build/*.ml) builder: $(BUILDER) ### Doc .PHONY: doc wikidoc doc man alldoc -DOCS_DIR=src/lib/client src/lib/server src/ocamlbuild src/ppx +DOCS_DIR=src/lib/client src/lib/server src/ocamlbuild DOCS_HTML=$(addsuffix /api.docdir/index.html,$(DOCS_DIR)) DOCS_WIKI=$(addsuffix /api.wikidocdir/index.wiki,$(DOCS_DIR)) DOCS_MAN= src/lib/client/api.mandocdir/man.3oc \ src/lib/server/api.mandocdir/man.3os \ - src/ocamlbuild/api.mandocdir/man.3o \ - src/ppx/api.mandocdir/man.3o + src/ocamlbuild/api.mandocdir/man.3o doc: $(BUILDER) $(BUILDER) $(DOCS_HTML) wikidoc: $(BUILDER) diff --git a/build/build.ml b/build/build.ml index 1a63cd6792..2fd8115770 100644 --- a/build/build.ml +++ b/build/build.ml @@ -11,19 +11,6 @@ let _ = dispatch (fun x -> rule (Printf.sprintf "%s -> %s" source dest) ~dep:source ~prod:dest (fun env _ -> Cmd (S [A"ln"; A"-f";P (env source); P (env dest)])) in - (* add syntax extension *) - let add_syntax name path = - let bytes_dep = Findlib.(link_flags_byte [query "bytes"]) in - (* hack : not dep when "compile" to avoid the extension syntax to be link with binaries *) - (* the dep with ocamldep make sure the extension syntax is compiled before *) - flag ["ocaml";"compile";"pkg_"^name] (S [A "-ppx" ;P (path ^ name ^ "_ex.native") ]); - flag_and_dep ["ocaml";"ocamldep";"pkg_"^name] (S [A "-ppx" ;P (path ^ name ^ "_ex.native") ]); - flag_and_dep ["ocaml";"infer_interface";"pkg_"^name] (S [A "-ppx" ;P (path ^ name ^ "_ex.native") ]); - flag_and_dep ["doc";"pkg_"^name] (S [A "-ppx" ;P (path ^ name ^ "_ex.native") ]) in - - add_syntax "ppx_eliom_utils" "src/ppx/"; - add_syntax "ppx_eliom_types" "src/ppx/"; - (* link executable aliases *) let link_exec f t = link (Printf.sprintf "src/tools/%s.byte" f) (Printf.sprintf "src/tools/%s.byte" t); diff --git a/opam b/opam index 38d4cea13c..262c2a7cfb 100644 --- a/opam +++ b/opam @@ -12,7 +12,6 @@ depends: [ "ocamlfind" "deriving" {>= "0.6"} "ppx_deriving" - "ppx_tools" {>= "0.99.3"} "js_of_ocaml" {>= "2.8.2"} "tyxml" {>= "4.0.0"} "calendar" diff --git a/pkg/META b/pkg/META index c414751261..99589b4c9f 100644 --- a/pkg/META +++ b/pkg/META @@ -60,68 +60,6 @@ package "client" ( linkopts(javascript) += "+js_of_ocaml/classlist.js" ) -package "syntax" ( - directory = "syntax" - package "common" ( - description = "Syntax extension: spliting client and server code (base)" - version = "[distributed with Eliom]" - requires = "camlp4, bytes" - requires(preprocessor, syntax, pkg_type_conv) = "type_conv" - archive(syntax, preprocessor) = "pa_eliom_seed.cmo" - ) - - package "client" ( - description = "Syntax extension: spliting client and server code (client side)" - version = "[distributed with Eliom]" - requires(syntax, preprocessor) = "eliom.syntax.common" - requires(syntax, toploop) = "eliom.syntax.common" - archive(syntax, preprocessor) = "pa_eliom_client_client.cmo" - archive(syntax, toploop) = "pa_eliom_client_client.cmo" - ) - - package "server" ( - description = "Syntax extension: spliting client and server code (server side)" - version = "[distributed with Eliom]" - requires(syntax, preprocessor) = "eliom.syntax.common" - requires(syntax, toploop) = "eliom.syntax.common" - archive(syntax, preprocessor) = "pa_eliom_client_server.cmo" - archive(syntax, toploop) = "pa_eliom_client_server.cmo" - ) - - package "type" ( - description = "Syntax extension: spliting client and server code (type inference)" - version = "[distributed with Eliom]" - requires(syntax, preprocessor) = "eliom.syntax.common" - archive(syntax, preprocessor) = "pa_eliom_type_filter.cmo" - ) - - package "predef" ( - description = "Syntax extension: predefined commonly use syntaxes" - version = "[distributed with Eliom]" - - requires(syntax, preprocessor) = "js_of_ocaml.syntax,js_of_ocaml.deriving.syntax,lwt.syntax,tyxml.syntax" - requires(syntax, toploop) = "js_of_ocaml.syntax,js_of_ocaml.deriving.syntax,lwt.syntax,tyxml.syntax" - archive(syntax, preprocessor) = "-ignore dummy" - ) - -) - -package "ppx" ( - directory = "ppx" - package "server" ( - description = "Ppx syntax extension: server side" - ppx = "ppx_eliom_server" - ) - package "client" ( - description = "Ppx syntax extension: client side" - ppx = "ppx_eliom_client" - ) - package "type" ( - description = "Ppx syntax extension: type inference" - ppx = "ppx_eliom_types" - ) -) - package "templates" ( directory = "templates" diff --git a/pkg/build.ml b/pkg/build.ml index ba03dec607..482ccec82f 100755 --- a/pkg/build.ml +++ b/pkg/build.ml @@ -11,7 +11,6 @@ let except = function | _ -> true (* END *) -let exts_syntax = List.filter except [".cmo";".cmx";".cma";".cmxa";".cmxs";".a"] let exts_modlib = List.filter except Exts.module_library let exts_lib = List.filter except Exts.library @@ -25,15 +24,7 @@ let _ = list_to_file "src/ocamlbuild/ocamlbuild.mllib" ocamlbuild_mllib; list_to_file "src/ocamlbuild/ocamlbuild.mldylib" ocamlbuild_mllib; - list_to_file "src/ocamlbuild/api.odocl" ocamlbuild_api; - - list_to_file "src/ppx/ppx.mllib" ppx_mllib; - list_to_file "src/ppx/ppx.mldylib" ppx_mllib; - list_to_file "src/ppx/api.odocl" ppx_api; - - list_to_file "src/ppx/ppx.mllib" ppx_mllib; - list_to_file "src/ppx/ppx.mldylib" ppx_mllib; - list_to_file "src/ppx/api.odocl" ppx_api + list_to_file "src/ocamlbuild/api.odocl" ocamlbuild_api let spf = Printf.sprintf @@ -62,7 +53,6 @@ let () = Pkg.man ~cond:with_man3 ~dst:"man3/%.3oc" ~target:"src/lib/client/api.mandocdir/man.3oc" "src/lib/client/api.mandocdir/%.3oc"; Pkg.man ~cond:with_man3 ~dst:"man3/%.3os" ~target:"src/lib/server/api.mandocdir/man.3os" "src/lib/server/api.mandocdir/%.3os"; Pkg.man ~cond:with_man3 ~dst:"man3/%.3o" ~target:"src/ocamlbuild/api.mandocdir/man.3o" "src/ocamlbuild/api.mandocdir/%.3o"; - Pkg.man ~cond:with_man3 ~dst:"man3/%.3o" ~target:"src/ppx/api.mandocdir/man.3o" "src/ppx/api.mandocdir/%.3o"; (* TOOLS *) Pkg.bin ~auto:true "src/tools/eliomc"; @@ -75,24 +65,8 @@ let () = Pkg.bin ~auto:true ~dst:"eliom-distillery" "src/tools/distillery"; Pkg.bin ~auto:true "src/ocamlbuild/eliombuild"; - (* SYNTAXES *) - Pkg.lib ~exts:exts_syntax ~dst:"syntax/pa_eliom_seed" "src/syntax/pa_eliom_seed"; - Pkg.lib ~exts:exts_syntax ~dst:"syntax/pa_eliom_client_client" "src/syntax/pa_eliom_client_client"; - Pkg.lib ~exts:exts_syntax ~dst:"syntax/pa_eliom_client_server" "src/syntax/pa_eliom_client_server"; - Pkg.lib ~exts:exts_syntax ~dst:"syntax/pa_eliom_type_filter" "src/syntax/pa_eliom_type_filter"; - Pkg.lib ~exts:exts_modlib ~dst:"ocamlbuild/ocamlbuild_eliom" "src/ocamlbuild/ocamlbuild_eliom"; - (* PPX *) - Pkg.lib ~exts:Exts.module_library ~dst:"ppx/ppx_eliom" "src/ppx/ppx_eliom"; - Pkg.lib ~exts:Exts.module_library ~dst:"ppx/ppx_eliom_client" "src/ppx/ppx_eliom_client"; - Pkg.lib ~exts:Exts.module_library ~dst:"ppx/ppx_eliom_type" "src/ppx/ppx_eliom_type"; - Pkg.lib ~exts:Exts.module_library ~dst:"ppx/ppx_eliom_server" "src/ppx/ppx_eliom_server"; - - Pkg.bin ~auto:true ~dst:"ppx_eliom_client" "src/ppx/ppx_eliom_client_ex" ; - Pkg.bin ~auto:true ~dst:"ppx_eliom_server" "src/ppx/ppx_eliom_server_ex" ; - Pkg.bin ~auto:true ~dst:"ppx_eliom_types" "src/ppx/ppx_eliom_types_ex" - ] @ ( (* CLIENT LIBS *) Pkg.lib ~dst:"client/client" ~exts:[".cma"] "src/lib/client/client" :: diff --git a/pkg/filelist.ml b/pkg/filelist.ml index 22448f0053..9ce1d3eaf8 100644 --- a/pkg/filelist.ml +++ b/pkg/filelist.ml @@ -146,12 +146,6 @@ let ocamlbuild = { } -let ppx = { - interface_only = []; - interface = [ "ppx_eliom" ; "ppx_eliom_client" ; "ppx_eliom_type" ; "ppx_eliom_server" ]; - internal = [ "ppx_eliom_utils" ]; -} - let (-.-) name ext = name ^ "." ^ ext let exts el sl = @@ -198,12 +192,6 @@ let ocamlbuild_extra = exts ["cmx"] (ocamlbuild.interface @ ocamlbuild.internal) let ocamlbuild_api = ocamlbuild.interface_only @ ocamlbuild.interface -let ppx_mllib = ppx.interface @ ppx.internal -let ppx_extra = - exts ["cmi"] ppx.interface @ - exts ["cmx"] (ppx.interface @ ppx.internal) -let ppx_api = ppx.interface - let templates_dir = "pkg/distillery" let templates = Array.to_list (Sys.readdir templates_dir) diff --git a/src/_tags b/src/_tags index d93a7fcf58..73865a64e5 100644 --- a/src/_tags +++ b/src/_tags @@ -1,4 +1,4 @@ -<{lib,tools,ocamlbuild,syntax}/**/*>:warn(+A-4-6-7-9-27-32-33-34-37-40-42-44-48) +<{lib,tools,ocamlbuild}/**/*>:warn(+A-4-6-7-9-27-32-33-34-37-40-42-44-48) true:keep_locs # : \ @@ -54,10 +54,6 @@ true:keep_locs :package(lwt,ocsigenserver,ocsigenserver.ext,tyxml,calendar) :I(src/lib/server) -: syntax(camlp4o),package(camlp4.quotations.o,camlp4.extend,bytes) -: I(+camlp4/Camlp4Parsers) - -: package(ppx_tools, compiler-libs.common, ppx_tools.metaquot) : package(ocamlbuild,js_of_ocaml.ocamlbuild) :package(ocamlbuild,js_of_ocaml.ocamlbuild) @@ -68,11 +64,9 @@ true:keep_locs : with_intro(doc/client.indexdoc),subproject(client) : with_intro(doc/server.indexdoc),subproject(server) : with_intro(doc/ocamlbuild.indexdoc),subproject(ocamlbuild) -: with_intro(doc/ppx.indexdoc),subproject(ppx) : manpage,man_ext(3oc),apiref : manpage,man_ext(3os),apiref : manpage,man_ext(3o),apiref -: manpage,man_ext(3o),apiref <**/api.wikidocdir/index.wiki>: apiref, wikidoc diff --git a/src/ppx/.merlin b/src/ppx/.merlin deleted file mode 100644 index 7696577005..0000000000 --- a/src/ppx/.merlin +++ /dev/null @@ -1,4 +0,0 @@ -PKG compiler-libs.common -PKG ppx_tools ppx_tools.metaquot - -REC diff --git a/src/ppx/_tags b/src/ppx/_tags deleted file mode 100644 index 989b3c6d58..0000000000 --- a/src/ppx/_tags +++ /dev/null @@ -1 +0,0 @@ -true:warn(+A-4-6-7-9-40-42-44-48) diff --git a/src/ppx/ppx_eliom.ml b/src/ppx/ppx_eliom.ml deleted file mode 100644 index d743cf2d35..0000000000 --- a/src/ppx/ppx_eliom.ml +++ /dev/null @@ -1 +0,0 @@ -(* This file is not empty. *) diff --git a/src/ppx/ppx_eliom.mli b/src/ppx/ppx_eliom.mli deleted file mode 100644 index a5a497fddb..0000000000 --- a/src/ppx/ppx_eliom.mli +++ /dev/null @@ -1,4 +0,0 @@ -(** -Eliom PPX syntax extension. For documentation, refer to -{% <>%} -*) diff --git a/src/ppx/ppx_eliom_client.ml b/src/ppx/ppx_eliom_client.ml deleted file mode 100644 index 5c13e9cb7d..0000000000 --- a/src/ppx/ppx_eliom_client.ml +++ /dev/null @@ -1,260 +0,0 @@ -open Parsetree -open Asttypes -open Ast_helper - -module AC = Ast_convenience -module AM = Ast_mapper - -open Ppx_eliom_utils - -module Pass = struct - - (** {2 Auxiliaries} *) - - (* Replace every escaped identifier [v] with - [Eliom_client_core.Syntax_helpers.get_escaped_value v] *) - let map_get_escaped_values = - let mapper = - {Ast_mapper.default_mapper with - expr = (fun mapper e -> - match e.pexp_desc with - | Pexp_ident {txt} when Mli.is_escaped_ident @@ Longident.last txt -> - [%expr Eliom_runtime.get_escaped_value [%e e] ] - [@metaloc e.pexp_loc] - | _ -> AM.default_mapper.expr mapper e - ); - } - in - fun expr -> mapper.expr mapper expr - - let push_escaped_binding, flush_escaped_bindings = - let server_arg_ids = ref [] in - let is_unknown gen_id = - List.for_all - (fun (gen_id', _) -> gen_id.txt <> gen_id'.txt) - !server_arg_ids - in - let push gen_id (expr : expression) = - if is_unknown gen_id then - server_arg_ids := (gen_id, expr) :: !server_arg_ids - in - let flush () = - let res = List.rev !server_arg_ids in - server_arg_ids := []; - res - in - push, flush - - let mark_injection, flush_injection = - let has_injection = ref false in - let mark () = has_injection := true in - let flush () = - let x = !has_injection in - has_injection := false ; - x - in - mark, flush - - let push_client_value_data, flush_client_value_datas = - let client_value_datas = ref [] in - let push gen_num gen_id expr (args : string Location.loc list) = - client_value_datas := - (gen_num, gen_id, expr, args) :: !client_value_datas - in - let flush () = - let res = List.rev !client_value_datas in - client_value_datas := []; - res - in - push, flush - - let find_escaped_ident id = - if Mli.exists () then Mli.find_escaped_ident id else [%type: _] - - let find_injected_ident id = - if Mli.exists () then Mli.find_injected_ident id else [%type: _] - - let find_fragment id = - if Mli.exists () then Mli.find_fragment id else [%type: _] - - let register_client_closures client_value_datas = - let registrations = - List.map - (fun (num, id, expr, args) -> - let typ = find_fragment id in - let args = List.map Pat.var args in - [%expr - Eliom_runtime.register_client_closure - [%e AC.str num] - (fun [%p pat_args args] -> - ([%e map_get_escaped_values expr] : [%t typ])) - ] [@metaloc expr.pexp_loc] - ) - client_value_datas - in - match registrations with - | [] -> [] - | _ -> [Str.eval (AC.sequence registrations)] - - (* We hoist the body of client fragments to enforce the correct scoping: - Identifiers declared earlier in the client section should not be - visible inside the client fragment (unless via escaped value). *) - let define_client_functions ~loc client_value_datas = - match client_value_datas with - | [] -> - [] - | _ -> - let bindings = - List.map - (fun (_num, id, expr, args) -> - let patt = Pat.var id in - let typ = find_fragment id in - let args = List.map Pat.var args in - let expr = - [%expr - fun [%p pat_args args] -> ([%e expr] : [%t typ]) - ] [@metaloc loc] - in - Vb.mk ~loc patt expr) - client_value_datas - in - [Str.value ~loc Nonrecursive bindings] - - (* For injections *) - - let close_server_section loc = - [%stri - let () = - Eliom_runtime.close_server_section - [%e eid @@ id_file_hash loc] - ][@metaloc loc] - - let may_close_server_section ~no_fragment item = - if no_fragment - then [] - else [close_server_section item.pstr_loc] - - - let open_client_section loc = - [%stri - let () = - Eliom_runtime.open_client_section - [%e eid @@ id_file_hash loc] - ][@metaloc loc] - - let may_open_client_section loc = - if flush_injection () - then [ open_client_section loc ] - else [] - - (** Syntax extension *) - - let client_str item = - let loc = item.pstr_loc in - may_open_client_section loc @ - [ item ] - - let server_str no_fragment item = - register_client_closures (flush_client_value_datas ()) @ - may_close_server_section ~no_fragment item - - let shared_str no_fragment item = - let loc = item.pstr_loc in - let client_expr_data = flush_client_value_datas () in - may_open_client_section loc @ - register_client_closures client_expr_data @ - define_client_functions loc client_expr_data @ - [ item ] @ - may_close_server_section ~no_fragment item - - let fragment ?typ:_ ~context ~num ~id expr = - - let loc = expr.pexp_loc in - let frag_eid = eid id in - let escaped_bindings = flush_escaped_bindings () in - - push_client_value_data num id expr - (List.map fst escaped_bindings); - - match context, escaped_bindings with - | `Server, _ -> - (* We are in a server fragment, this code should always be discarded. *) - Exp.extension @@ AM.extension_of_error @@ Location.errorf "Eliom: ICE" - | `Shared, [] -> - [%expr [%e frag_eid] ()][@metaloc loc] - | `Shared, _ -> - let bindings = - List.map - (fun (gen_id, expr) -> - Vb.mk ~loc:expr.pexp_loc (Pat.var gen_id) expr ) - escaped_bindings - in - let args = - format_args @@ List.map - (fun (id, _) -> eid id) - escaped_bindings - in - Exp.let_ ~loc - Nonrecursive - bindings - [%expr [%e frag_eid] [%e args]][@metaloc loc] - - - - let escape_inject ?ident ~(context:Context.escape_inject) ~id expr = - let loc = expr.pexp_loc in - let frag_eid = eid id in - - let assert_no_variables t = - let typ mapper = function - | {ptyp_desc = Ptyp_var _ } as typ -> - let attr = - AM.attribute_of_warning loc - "The type of this injected value contains a type variable \ - that could be wrongly inferred." - in - { typ with ptyp_attributes = attr :: typ.ptyp_attributes } - | typ -> AM.default_mapper.typ mapper typ - in - let m = { AM.default_mapper with typ } in - m.AM.typ m t - in - - match context with - - (* [%%server [%client ~%( ... ) ] ] *) - | `Escaped_value _section -> - let typ = find_escaped_ident id in - let typ = assert_no_variables typ in - push_escaped_binding id expr; - [%expr ([%e frag_eid] : [%t typ]) ][@metaloc loc] - - - (* [%%server ... %x ... ] *) - | `Injection _section -> - mark_injection () ; - let typ = find_injected_ident id in - let typ = assert_no_variables typ in - let ident = match ident with - | None -> [%expr None] - | Some i -> [%expr Some [%e AC.str i]] - in - let (u, d) = Mli.get_injected_ident_info id.txt in - let es = (AC.str @@ Printf.sprintf "%s%d" u d)[@metaloc id.loc] in - [%expr - (Eliom_client_core.Syntax_helpers.get_injection - ?ident:([%e ident]) - ~pos:([%e position loc]) - [%e es] - : [%t typ]) - ][@metaloc loc] - - let shared_sig item = [item] - let server_sig _ = [] - let client_sig item = [item] - - let prelude _ = [] - -end - -include Make(Pass) diff --git a/src/ppx/ppx_eliom_client.mli b/src/ppx/ppx_eliom_client.mli deleted file mode 100644 index be5a2dd400..0000000000 --- a/src/ppx/ppx_eliom_client.mli +++ /dev/null @@ -1,2 +0,0 @@ - -val mapper : string list -> Ast_mapper.mapper diff --git a/src/ppx/ppx_eliom_client_ex.ml b/src/ppx/ppx_eliom_client_ex.ml deleted file mode 100644 index 49798061b9..0000000000 --- a/src/ppx/ppx_eliom_client_ex.ml +++ /dev/null @@ -1,2 +0,0 @@ - -let () = Ast_mapper.run_main Ppx_eliom_client.mapper diff --git a/src/ppx/ppx_eliom_server.ml b/src/ppx/ppx_eliom_server.ml deleted file mode 100644 index e198f993a5..0000000000 --- a/src/ppx/ppx_eliom_server.ml +++ /dev/null @@ -1,211 +0,0 @@ -(* Ocsigen - * http://www.ocsigen.org - * Copyright (C) 2010-2011 - * Raphaël Proust, Grégoire Henry, Gabriel Radanne - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -(* This prepocessor generates the module to be loaded by Ocsigen server *) - -open Parsetree -open Asttypes -open Ast_helper - -module AC = Ast_convenience -module AM = Ast_mapper - -open Ppx_eliom_utils - -module Pass = struct - - let push_escaped_binding, flush_escaped_bindings = - let args = ref [] in - let push orig_expr id = - if List.for_all (function id', _ -> id.txt <> id'.txt) !args then - args := (id, orig_expr) :: !args; - in - let flush () = - let res = List.rev !args in - args := []; - let aux (_, arg) = - [%expr Eliom_runtime.escaped_value [%e arg ] ] - [@metaloc arg.pexp_loc] - in - List.map aux res - in - push, flush - - module SSet = Set.Make (String) - - let push_injection, flush_injections = - let buffer : (_ * _ * _) list ref = ref [] in - let gen_ids = ref SSet.empty in - let push ?ident id orig_expr = - if not (SSet.mem id !gen_ids) then - (gen_ids := SSet.add id !gen_ids; - buffer := (id, orig_expr,ident) :: !buffer) - in - let flush_all () = - let res = List.rev !buffer in - gen_ids := SSet.empty; - buffer := []; - res - in - let global_known = ref SSet.empty in - let flush () = - let all = flush_all () in - let novel = - let is_fresh (gen_id, _,_) = - not (SSet.mem gen_id !global_known) - in - List.filter is_fresh all - in - List.iter - (function gen_id, _, _ -> - global_known := SSet.add gen_id !global_known) - novel; - all - in - push, flush - - (* For every injection of $orig_expr$ as $gen_id$: - let $gen_id$ = $orig_expr$ and ... - (Necessary for injections in shared section) *) - let bind_injected_idents injections = - assert (injections <> []); - let bindings = - List.map - (fun (txt, expr,_) -> - let loc = expr.pexp_loc in - Vb.mk ~loc (Pat.var ~loc {txt;loc}) expr) - injections - in - Str.value Nonrecursive bindings - - let close_server_section loc = - [%stri - let () = - Eliom_runtime.close_server_section - [%e eid @@ id_file_hash loc] - ] [@metaloc loc] - - let may_close_server_section ~no_fragment loc = - if no_fragment - then [] - else [close_server_section loc] - - - let close_client_section loc injections = - assert (injections <> []) ; - let injection_list = - List.fold_right - (fun (txt, expr, ident) sofar -> - let loc = expr.pexp_loc in - let loc_expr = position loc in - let frag_eid = eid {txt;loc} in - let ident = match ident with - | None -> [%expr None] - | Some i -> [%expr Some [%e AC.str i ]] in - let (_, num) = Mli.get_injected_ident_info txt in - [%expr - ([%e AC.int num], - Eliom_lib.to_poly [%e frag_eid ], - [%e loc_expr], [%e ident ]) :: [%e sofar ] - ]) - injections - [%expr []] - in - [%stri - let () = - Eliom_runtime.close_client_section - [%e eid @@ id_file_hash loc ] - [%e injection_list ] - ][@metaloc loc] - - - (** Syntax extension *) - - let client_str item = - let all_injections = flush_injections () in - let loc = item.pstr_loc in - match all_injections with - | [] -> [] - | l -> - bind_injected_idents l :: - [ close_client_section loc all_injections ] - - let server_str no_fragment item = - let loc = item.pstr_loc in - item :: - may_close_server_section ~no_fragment loc - - let shared_str no_fragment item = - let all_injections = flush_injections () in - let loc = item.pstr_loc in - let cl = - item :: - may_close_server_section ~no_fragment loc - in - match all_injections with - | [] -> cl - | l -> - bind_injected_idents l :: - cl @ - [ close_client_section loc all_injections ] - - let fragment ?typ ~context:_ ~num ~id expr = - let typ = - match typ with - | Some typ -> typ - | None when not (Mli.exists ()) -> - [%type: _] - | None -> - match Mli.find_fragment id with - | { ptyp_desc = Ptyp_var _ } -> - let loc = expr.pexp_loc in - Typ.extension ~loc @@ AM.extension_of_error @@ Location.errorf ~loc - "The types of client values must be monomorphic from its usage \ - or from its type annotation" - | typ -> typ - in - let loc = expr.pexp_loc in - let e = format_args @@ flush_escaped_bindings () in - [%expr - (Eliom_runtime.fragment - ~pos:([%e position loc ]) - [%e AC.str num ] - [%e e ] - : [%t typ ] Eliom_client_value.t) - ][@metaloc loc] - - let escape_inject ?ident ~(context:Context.escape_inject) ~id expr = - match context with - | `Escaped_value _ -> - push_escaped_binding expr id; - [%expr assert false ] - | `Injection _ -> - push_injection ?ident id.txt expr; - eid id - - let prelude _loc = [] - - let shared_sig item = [item] - let server_sig item = [item] - let client_sig _ = [] - -end - -include Make(Pass) diff --git a/src/ppx/ppx_eliom_server.mli b/src/ppx/ppx_eliom_server.mli deleted file mode 100644 index be5a2dd400..0000000000 --- a/src/ppx/ppx_eliom_server.mli +++ /dev/null @@ -1,2 +0,0 @@ - -val mapper : string list -> Ast_mapper.mapper diff --git a/src/ppx/ppx_eliom_server_ex.ml b/src/ppx/ppx_eliom_server_ex.ml deleted file mode 100644 index e2e89a829b..0000000000 --- a/src/ppx/ppx_eliom_server_ex.ml +++ /dev/null @@ -1,2 +0,0 @@ - -let () = Ast_mapper.run_main Ppx_eliom_server.mapper diff --git a/src/ppx/ppx_eliom_type.ml b/src/ppx/ppx_eliom_type.ml deleted file mode 100644 index d5779ed8f0..0000000000 --- a/src/ppx/ppx_eliom_type.ml +++ /dev/null @@ -1,145 +0,0 @@ -(* Ocsigen - * http://www.ocsigen.org - * Copyright (C) 2010-2011 - * Raphaël Proust, Grégoire Henry, Gabriel Radanne - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -(* This module generates the file used to infer types (hence wrappers) of server - escaped values. - - Server-specific and escaped expression will be kept only for - type-checking. In order to export type of escaped expressions: it - generates for each escaped expression a toplevel definition that - looks like: - - let $global_id$ = ref None - - And client-side expressions are replaced by lists of initializers - (one per escaped expressions): - - $global_id$ := Some $expr$ - -*) -open Parsetree -open Asttypes -open Ast_helper - -module AC = Ast_convenience -module AM = Ast_mapper - -open Ppx_eliom_utils - -module Pass = struct - - (* accumulator, push and flush for typing expression - $gen_id := Some $orig_expr *) - let push_typing_expr, flush_typing_expr = - let typing_expr = ref [] in - let add orig_expr id = - if List.for_all (function id', _ -> id.txt <> id'.txt) !typing_expr - then - let frag_eid = eid id in - typing_expr := - (id, - [%expr [%e frag_eid] := Some [%e orig_expr]] - [@metaloc orig_expr.pexp_loc] - ) :: !typing_expr - in - let flush () = - let res = List.rev (List.map snd !typing_expr) in - typing_expr := []; - AC.sequence res - in - add, flush - - (* accumulator, push and flush for typing str - let $id = ref None - *) - let push_typing_str_item, flush_typing_str_item = - let typing_strs = ref [] in - let add orig_expr id = - if List.for_all (function id', _ -> id'.txt <> id.txt) !typing_strs - then - typing_strs := - (id, - [%stri let [%p Pat.var id] = Pervasives.ref None] - [@metaloc orig_expr.pexp_loc] - ) :: !typing_strs - in - let flush () = - let res = List.map snd !typing_strs in - typing_strs := []; - res - in - add, flush - - (** Syntax extension *) - - let client_str item = - let loc = item.pstr_loc in - flush_typing_str_item () @ - [%str let () = [%e flush_typing_expr () ] ] [@metaloc loc] - - let server_str _ item = - flush_typing_str_item () @ - [ item ] - - let shared_str _ item = - let loc = item.pstr_loc in - flush_typing_str_item () @ - [%str let () = [%e flush_typing_expr () ] ] [@metaloc loc] @ - [ item ] - - let fragment ?typ ~context:_ ~num:_ ~id expr = - let loc = expr.pexp_loc in - let frag_eid = eid id in - push_typing_str_item expr id; - let typ = match typ with - | Some typ -> typ - | None -> Typ.any ~loc () - in - [%expr - [%e flush_typing_expr () ]; - [%e frag_eid] := - Some ( Eliom_runtime.fragment "" 0 : - [%t typ] Eliom_client_value.t); - match ! [%e frag_eid] with - | Some x -> (x : _ Eliom_client_value.t) - | None -> assert false - ] - - let escape_inject ?ident:_ ~(context:Context.escape_inject) ~id expr = - push_typing_str_item expr id; - push_typing_expr expr id; - match context with - | `Escaped_value _ -> [%expr assert false] - | `Injection `Shared -> expr - | `Injection `Client -> [%expr assert false] - - let prelude loc = - let txt = - Printf.sprintf "__eliom__compilation_unit_id__%s" (file_hash loc) in - let id = Pat.var ~loc { loc ; txt } in - [%str let [%p id] = () ] - - let shared_sig _ = [] - let server_sig _ = [] - let client_sig _ = [] - -end - -include Make(Pass) diff --git a/src/ppx/ppx_eliom_type.mli b/src/ppx/ppx_eliom_type.mli deleted file mode 100644 index be5a2dd400..0000000000 --- a/src/ppx/ppx_eliom_type.mli +++ /dev/null @@ -1,2 +0,0 @@ - -val mapper : string list -> Ast_mapper.mapper diff --git a/src/ppx/ppx_eliom_types_ex.ml b/src/ppx/ppx_eliom_types_ex.ml deleted file mode 100644 index 895e1c5a57..0000000000 --- a/src/ppx/ppx_eliom_types_ex.ml +++ /dev/null @@ -1,2 +0,0 @@ - -let () = Ast_mapper.run_main Ppx_eliom_type.mapper diff --git a/src/ppx/ppx_eliom_utils.ml b/src/ppx/ppx_eliom_utils.ml deleted file mode 100644 index 20fb48901c..0000000000 --- a/src/ppx/ppx_eliom_utils.ml +++ /dev/null @@ -1,675 +0,0 @@ -open Parsetree -open Ast_helper - -module AM = Ast_mapper -module AC = Ast_convenience - -(** Various misc functions *) - -let flatmap f l = List.flatten @@ List.map f l - -let get_extension = function - | {pexp_desc= Pexp_extension ({txt},_)} -> txt - | _ -> invalid_arg "Eliom ppx: Should be an extension." - -let in_context cref c f x = - let old = !cref in - cref := c ; - let res = f x in - cref := old ; - res - -let (%) f g x = f (g x) - -let exp_add_attrs attr e = - {e with pexp_attributes = attr} - -let eid {Location. txt ; loc } = - Exp.ident ~loc { loc ; txt = Longident.Lident txt } - -let format_args = function - | [] -> AC.unit () - | [e] -> e - | l -> Exp.tuple l - -let pat_args = function - | [] -> AC.punit () - | [p] -> p - | l -> Pat.tuple l - -(* We use a strong hash (MD5) of the file name. - We only keep the first 36 bit, which should be well enough: with - 256 files, the likelihood of a collision is about one in two - millions. - These bits are encoded using an OCaml-compatible variant of Base - 64, as the hash is used to generate OCaml identifiers. *) -let file_hash loc = - let s = Digest.string loc.Location.loc_start.pos_fname in - let e = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_'" in - let o = Bytes.create 6 in - let g p = Char.code s.[p] in - for i = 0 to 5 do - let p = i * 6 / 8 in - let d = 10 - (i * 6) mod 8 in - Bytes.set o i e.[(g p lsl 8 + g (p + 1)) lsr d land 63] - done; - Bytes.to_string o - -let id_file_hash loc = - let prefix = "__eliom__compilation_unit_id__" in - {Location. loc ; txt = prefix ^ file_hash loc} - -(** [let __eliom__compilation_unit_id__HASH = "HASH"] - We hoist the file hash at the beginning of each eliom file. - This makes the generated javascript code smaller. -*) -let module_hash_declaration loc = - let id = Pat.var ~loc @@ id_file_hash loc in - Str.value ~loc Nonrecursive [Vb.mk ~loc id @@ AC.str @@ file_hash loc] - -(** The first position in a file, if it exists. - We avoid {!Location.input_name}, as it's unreliable when reading multiple files. -*) -let file_position str = match str with - | { pstr_loc } :: _ -> Location.in_file @@ pstr_loc.loc_start.pos_fname - | [] -> Location.none - -let lexing_position ~loc l = - [%expr - { Lexing.pos_fname = [%e AC.str l.Lexing.pos_fname]; - Lexing.pos_lnum = [%e AC.int @@ l.Lexing.pos_lnum]; - Lexing.pos_bol = [%e AC.int @@ l.Lexing.pos_bol]; - Lexing.pos_cnum = [%e AC.int @@ l.Lexing.pos_cnum]; } - ] [@metaloc loc] - -let position loc = - let start = loc.Location.loc_start in - let stop = loc.Location.loc_start in - Exp.tuple ~loc [ lexing_position ~loc start ; lexing_position ~loc stop ] - -let is_annotation txt l = - List.exists (fun s -> txt = s || txt = "eliom."^s) l - -(** Identifiers generation. *) -module Name = struct - - let escaped_ident_fmt : _ format6 = - "_eliom_escaped_ident_%Ld" - - let fragment_ident_fmt : _ format6 = - "_eliom_fragment_%s" - - let injected_ident_fmt : _ format6 = - "_eliom_injected_ident_%6s%d" - - (* Identifiers for the closure representing a fragment. *) - let fragment_num_count = ref 0 - let fragment_num _loc = - incr fragment_num_count; - Printf.sprintf "%s%d" (file_hash _loc) !fragment_num_count - let fragment_ident id = - Printf.sprintf fragment_ident_fmt id - - (* Globaly unique ident for escaped expression *) - (* It's used for type inference and as argument name for the - closure representing the surrounding fragment. *) - (* Inside a fragment, same ident share the global ident. *) - let escaped_idents = ref [] - let reset_escaped_ident () = escaped_idents := [] - let escaped_expr, escaped_ident = - let r = ref 0L in - let make () = - r := Int64.(add one) !r ; - Printf.sprintf escaped_ident_fmt !r - in - let for_expr loc = Location.mkloc (make ()) loc in - let for_id loc id = - let txt = - try List.assoc id !escaped_idents - with Not_found -> - let gen_id = make () in - escaped_idents := (id, gen_id) :: !escaped_idents; - gen_id - in {Location. txt ; loc } - in for_expr, for_id - - let injected_expr, injected_ident, reset_injected_ident = - let injected_idents = ref [] in - let r = ref 0 in - let gen_ident loc = - let hash = file_hash loc in - incr r; - let s = Printf.sprintf injected_ident_fmt hash !r in - {Location. txt = s ; loc } - in - let gen_injected_ident loc (s:string) = - try List.assoc s !injected_idents - with Not_found -> - let gen_id = gen_ident loc in - injected_idents := (s, gen_id) :: !injected_idents; - gen_id - and reset () = injected_idents := [] in - gen_ident, gen_injected_ident, reset - -end - -(* WARNING: if you change this, also change inferred_type_prefix in - tools/eliomc.ml and ocamlbuild/ocamlbuild_eliom.ml *) -let inferred_type_prefix = "eliom_inferred_type_" - -module Mli = struct - - let type_file = ref None - let get_type_file () = match !type_file with - | None -> Filename.chop_extension !Location.input_name ^ ".type_mli" - | Some f -> f - - let exists () = match !type_file with Some _ -> true | _ -> false - - let suppress_underscore = - let rename = - let c = ref 0 in - fun s -> incr c; Printf.sprintf "an_%s_%d" s !c - and has_pfix = - let len = String.length inferred_type_prefix in - fun s -> - String.length s >= len && - String.sub s 0 len = inferred_type_prefix - in - let typ mapper ty = match ty.ptyp_desc with - (* | Ptyp_constr (_, Ast.TyAny _, ty) *) - (* | Ptyp_constr (_, ty, Ast.TyAny _) -> ty *) - | Ptyp_var var when has_pfix var -> - mapper.AM.typ mapper - {ty with - ptyp_desc = Ptyp_var (rename var) - } - | _ -> AM.default_mapper.typ mapper ty in - let m = { AM.default_mapper with typ } in - m.AM.typ m - - let is_injected_ident id = - try Scanf.sscanf id Name.injected_ident_fmt (fun _ _ -> true) - with Scanf.Scan_failure _ -> false - - let is_escaped_ident id = - try Scanf.sscanf id Name.escaped_ident_fmt (fun _ -> true) - with Scanf.Scan_failure _ -> false - - let is_fragment_ident id = - try Scanf.sscanf id Name.fragment_ident_fmt (fun _ -> true) - with Scanf.Scan_failure _ -> false - - let get_injected_ident_info id = - Scanf.sscanf id Name.injected_ident_fmt (fun u n -> (u, n)) - - let get_fragment_type = function - | [%type: [%t? typ] Eliom_client_value.fragment ] - | [%type: [%t? typ] Eliom_client_value.t ] -> - Some typ - | _ -> None - - let get_binding sig_item = match sig_item.psig_desc with - | Psig_value { - pval_name = {txt} ; - pval_type = [%type: [%t? typ] option ref ] } -> - if is_injected_ident txt || is_escaped_ident txt then - Some (txt, suppress_underscore typ) - else if is_fragment_ident txt then - match get_fragment_type typ with - | Some typ -> Some (txt, suppress_underscore typ) - | None -> None - else - None - | _ -> None - - let load_file file = - try - let items = - Pparse.parse_interface ~tool_name:"eliom" Format.err_formatter file - in - let h = Hashtbl.create 17 in - let f item = match get_binding item with - | Some (s, typ) -> Hashtbl.add h s typ - | None -> () - in - List.iter f items ; - h - with - | Sys_error s -> - Location.raise_errorf - ~loc:(Location.in_file file) - "Eliom: Error while loading types: %s" s - - let inferred_sig = lazy (load_file (get_type_file ())) - - let find err {Location. txt ; loc } = - try Hashtbl.find (Lazy.force inferred_sig) txt with - | Not_found -> - Typ.extension ~loc @@ AM.extension_of_error @@ Location.errorf ~loc - "Error: Inferred type of %s not found. You need to regenerate %s." - err (get_type_file ()) - - let find_escaped_ident = find "escaped ident" - let find_injected_ident = find "injected ident" - let find_fragment = find "client value" - -end - -(** Context convenience module. *) -module Context = struct - - type server = [ `Server | `Shared ] - type client = [ `Client | `Shared ] - - let of_string = function - | "server" | "server.start" - | "eliom.server" | "eliom.server.start" -> `Server - | "shared" | "shared.start" - | "eliom.shared" | "eliom.shared.start" -> `Shared - | "client" | "client.start" - | "eliom.client" | "eliom.client.start" -> `Client - | _ -> invalid_arg "Eliom ppx: Not a context" - - type escape_inject = [ - | `Escaped_value of server - | `Injection of client - ] - - type t = [ - | `Server (* [%%server ... ] *) - | `Client (* [%%client ... ] *) - | `Shared (* [%%shared ... ] *) - | `Fragment of server (* [%client ... ] *) - | `Escaped_value of server (* [%shared ~%( ... ) ] *) - | `Injection of client (* [%%client ~%( ... ) ] *) - ] -end - - -let match_args = function - | [ ] -> () - | [ "-type" ; type_file ] -> Mli.type_file := Some type_file - | [ "-notype" ] -> Mli.type_file := None - | args -> Location.raise_errorf ~loc:Location.(in_file !input_name) - "Wrong arguments:@ %s" (String.concat " " args) - -(** Signature of specific code of a preprocessor. *) -module type Pass = sig - - (** How to handle "client", "shared" and "server" sections for top level structure items. *) - - val shared_str: bool -> structure_item -> structure_item list - val server_str: bool -> structure_item -> structure_item list - val client_str: structure_item -> structure_item list - - (** How to handle "client", "shared" and "server" sections for top level signature items. *) - - val shared_sig: signature_item -> signature_item list - val client_sig: signature_item -> signature_item list - val server_sig: signature_item -> signature_item list - - (** How to handle "[%client ...]" and "[%shared ...]" expr. *) - val fragment: - ?typ:core_type -> context:Context.server -> - num:string -> id:string Location.loc -> - expression -> expression - - (** How to handle escaped "~%ident" inside a fragment. *) - val escape_inject: - ?ident:string -> context:Context.escape_inject -> - id:string Location.loc -> - expression -> expression - - val prelude : loc -> structure - -end - -(** These functions try to guess if a given expression will lead to a fragment evaluation - This is not possible in general, this criteria is only syntactic - - If the expression cannot have fragments, we don't need to use sections. - Consequently, this function should *never* return false positive. -*) -module Cannot_have_fragment = struct - - let opt_forall p = function - | None -> true - | Some x -> p x - - let vb_forall p l = - let p x = p x.pvb_expr in - List.for_all p l - - let rec longident = function - | Longident.Lident _ -> true - | Longident.Ldot (x,_) -> longident x - | Longident.Lapply (_,_) -> false - - let rec expression e = match e.pexp_desc with - | Pexp_ident _ - | Pexp_constant _ - | Pexp_function _ - | Pexp_lazy _ - | Pexp_fun _ - -> true - - | Pexp_newtype (_,e) - | Pexp_assert e - | Pexp_field (e,_) - | Pexp_constraint (e,_) - | Pexp_coerce (e,_,_) - | Pexp_poly (e,_) - | Pexp_try (e,_) -> expression e - - | Pexp_ifthenelse (b,e1,e2) -> - expression b && expression e1 && opt_forall expression e2 - | Pexp_sequence (e1,e2) - | Pexp_setfield (e1,_,e2) -> expression e1 && expression e2 - | Pexp_array l - | Pexp_tuple l -> List.for_all expression l - | Pexp_record (l,e) -> - let p x = expression @@ snd x in - opt_forall expression e && List.for_all p l - - | Pexp_construct (_,e) - | Pexp_variant (_,e) -> opt_forall expression e - | Pexp_let (_,l,e) -> vb_forall expression l && expression e - | Pexp_open (_,x,e) -> longident x.txt && expression e - | Pexp_letmodule (_,me,e) -> module_expr me && expression e - - (* We could be more precise on those constructs *) - | Pexp_object _ - | Pexp_while _ - | Pexp_for _ - | Pexp_match _ - | Pexp_pack _ - -> false - - (* We can't say more using syntactic information. *) - | Pexp_extension _ - | Pexp_send _ - | Pexp_new _ - | Pexp_setinstvar _ - | Pexp_override _ - | Pexp_apply _ - | _ - -> false - - and module_expr x = match x.pmod_desc with - | Pmod_ident l -> longident l.txt - | Pmod_functor _ -> true - | Pmod_unpack e -> expression e - | Pmod_constraint (e,_) -> module_expr e - | Pmod_structure l -> List.for_all structure_item l - - | Pmod_apply _ - | _ - -> false - - and module_binding m = module_expr m.pmb_expr - - and structure_item x = match x.pstr_desc with - | Pstr_type _ - | Pstr_typext _ - | Pstr_exception _ - | Pstr_modtype _ - | Pstr_class _ - | Pstr_class_type _ - -> true - - | Pstr_eval (e,_) -> expression e - | Pstr_value (_,vb) -> vb_forall expression vb - | Pstr_primitive _ -> true - | Pstr_module mb -> module_binding mb - | Pstr_recmodule mbl -> List.for_all module_binding mbl - | Pstr_open x -> longident x.popen_lid.txt - | Pstr_include x -> module_expr x.pincl_mod - - | _ -> false - -end - -(** - Replace shared expression by the equivalent pair. - - [ [%share - let x = ... %s ... in - [%client ... %x ... ] - ] ] - ≡ - [ let x = ... s ... in - [%client ... %x ... ] - , - [%client - let x = ... %s ... in - ... x ... - ] - ] -*) -module Shared = struct - - let server_expr mapper expr = - match expr with - | [%expr [%client [%e? _ ]]] -> expr - | [%expr ~% [%e? injection_expr ]] -> injection_expr - | _ -> AM.default_mapper.expr mapper expr - let server = {AM.default_mapper with expr = server_expr} - - let client_expr context mapper expr = - match expr with - | [%expr [%client [%e? fragment_expr ]]] -> - in_context context `Fragment - (mapper.AM.expr mapper) fragment_expr - | [%expr ~% [%e? injection_expr ]] -> - begin match !context with - | `Top -> expr - | `Fragment -> injection_expr - end - | _ -> AM.default_mapper.expr mapper expr - let client = {AM.default_mapper with expr = client_expr (ref `Top)} - - let expr loc expr = - let server_expr = server.AM.expr server expr in - let client_expr = client.AM.expr client expr in - [%expr - Eliom_shared.Value.create - [%e server_expr] - [%client [%e client_expr]] - ] [@metaloc loc] -end - -module Make (Pass : Pass) = struct - - let eliom_expr (context : Context.t ref) mapper expr = - let loc = expr.pexp_loc in - let attr = expr.pexp_attributes in - match expr, !context with - | {pexp_desc = Pexp_extension ({txt},_)}, - `Client - when is_annotation txt ["client"; "shared"] -> - let side = get_extension expr in - Exp.extension @@ AM.extension_of_error @@ Location.errorf ~loc - "The syntax [%%%s ...] is not allowed inside client code." - side - | {pexp_desc = Pexp_extension ({txt},_)} - , (`Fragment _ | `Escaped_value _ | `Injection _) - when is_annotation txt ["client"; "shared"] -> - let side = get_extension expr in - Exp.extension @@ AM.extension_of_error @@ Location.errorf ~loc - "The syntax [%%%s ...] can not be nested." - side - - (* [%shared ... ] *) - | {pexp_desc = Pexp_extension ({txt},PStr [{pstr_desc = Pstr_eval (side_val,attr')}])}, - (`Server | `Shared) - when is_annotation txt ["shared"] -> - let e = Shared.expr loc side_val in - mapper.AM.expr mapper @@ exp_add_attrs (attr@attr') e - - (* [%client ... ] *) - | {pexp_desc = Pexp_extension ({txt},PStr [{pstr_desc = Pstr_eval (side_val,attr)}])}, - (`Server | `Shared as c) - when is_annotation txt ["client"] -> - Name.reset_escaped_ident () ; - let side_val, typ = match side_val with - | [%expr ([%e? cval]:[%t? typ]) ] -> (cval, Some typ) - | _ -> (side_val, None) - in - let num = Name.fragment_num side_val.pexp_loc in - let id = Location.mkloc (Name.fragment_ident num) side_val.pexp_loc in - in_context context (`Fragment c) - (Pass.fragment ?typ ~context:c ~num ~id % mapper.AM.expr mapper) - (exp_add_attrs attr side_val) - - (* ~%( ... ) ] *) - | [%expr ~% [%e? inj ]], _ -> - let ident = match inj.pexp_desc with - | Pexp_ident i -> Some (String.concat "_" @@ Longident.flatten i.txt) - | _ -> None - in - begin match !context with - | `Client | `Shared as c -> - let id = match ident with - | Some id -> Name.injected_ident loc id - | None -> Name.injected_expr loc - in - let new_context = `Injection c in - in_context context new_context - (Pass.escape_inject ?ident ~context:new_context ~id % - mapper.AM.expr mapper) - inj - | `Fragment c -> - let id = match ident with - | None -> Name.escaped_expr loc - | Some id -> Name.escaped_ident loc id - in - let new_context = `Escaped_value c in - in_context context new_context - (Pass.escape_inject ?ident ~context:new_context ~id % - mapper.AM.expr mapper) - inj - | `Server -> - Location.raise_errorf ~loc - "The syntax ~%% ... is not allowed inside server code." - | `Escaped_value _ | `Injection _ -> - Location.raise_errorf ~loc - "The syntax ~%% ... can not be nested." - end - | _ -> AM.default_mapper.expr mapper expr - - let structure_item mapper str = - let loc = str.pstr_loc in - match str.pstr_desc with - | Pstr_extension (({txt=("server"|"shared"|"client")}, _), _) -> - Location.raise_errorf ~loc - "Sections are only allowed at toplevel." - | _ -> AM.default_mapper.structure_item mapper str - - let signature_item mapper sig_ = - let loc = sig_.psig_loc in - match sig_.psig_desc with - | Psig_extension (({txt=("server"|"shared"|"client")}, _), _) -> - Location.raise_errorf ~loc "Sections are only allowed at toplevel." - | _ -> AM.default_mapper.signature_item mapper sig_ - - let eliom_mapper context = - let context = ref (context :> Context.t) in - { Ast_mapper.default_mapper - with - Ast_mapper. - - expr = eliom_expr context ; - - (* Reject sections not at toplevel. *) - structure_item ; - signature_item ; - } - - - (** Toplevel translation *) - (** Switch the current context when encountering [%%server] (resp. shared, client) - annotations. Call the eliom mapper and [Pass.server_str] (resp ..) on each - structure item. - *) - - let dispatch_str context _mapper stri = - (* We must do this before any transformation on the structure. *) - let no_fragment = Cannot_have_fragment.structure_item stri in - let f = match context with - | `Server -> Pass.server_str no_fragment - | `Shared -> Pass.shared_str no_fragment - | `Client -> Pass.client_str - in - let m = eliom_mapper context in - f @@ m.AM.structure_item m stri - - let dispatch_sig context _mapper sigi = - let f = match context with - | `Server -> Pass.server_sig - | `Shared -> Pass.shared_sig - | `Client -> Pass.client_sig - in - let m = eliom_mapper context in - f @@ m.AM.signature_item m sigi - - let toplevel_structure context mapper structs = - let f pstr = - let loc = pstr.pstr_loc - and maybe_reset_injected_idents = function - | `Client | `Shared -> - Name.reset_injected_ident (); - | _ -> - () - in - match pstr.pstr_desc with - | Pstr_extension (({txt}, PStr strs), _) - when is_annotation txt ["shared.start"; - "client.start"; - "server.start"] -> - if strs <> [] then - [ Str.extension ~loc @@ AM.extension_of_error @@ Location.errorf ~loc - "The %%%%%s extension doesn't accept arguments." txt ] - else ( - maybe_reset_injected_idents !context ; - context := Context.of_string txt ; - [] - ) - | Pstr_extension (({txt}, PStr strs), _) - when is_annotation txt ["shared"; "client" ;"server"] -> - let c = Context.of_string txt in - let l = flatmap (dispatch_str c mapper) strs in - maybe_reset_injected_idents c ; l - | _ -> - dispatch_str !context mapper pstr - in - let loc = {(file_position structs) with loc_ghost = true} in - module_hash_declaration loc :: - Pass.prelude loc @ - flatmap f structs - - let toplevel_signature context mapper sigs = - let f psig = - let loc = psig.psig_loc in - match psig.psig_desc with - | Psig_extension (({txt}, PStr strs), _) - when is_annotation txt ["shared.start"; "client.start" ;"server.start"] -> - if strs <> [] then - [ Sig.extension ~loc @@ AM.extension_of_error @@ Location.errorf ~loc - "The %%%%%s extension doesn't accept arguments." txt ] - else ( context := Context.of_string txt ; [] ) - | _ -> - dispatch_sig !context mapper psig - in - flatmap f sigs - - let mapper args = - let () = match_args args in - let c = ref `Server in - {AM.default_mapper - with - structure = toplevel_structure c ; - signature = toplevel_signature c ; - } - -end diff --git a/src/ppx/ppx_eliom_utils.mli b/src/ppx/ppx_eliom_utils.mli deleted file mode 100644 index 3ceac0ec6e..0000000000 --- a/src/ppx/ppx_eliom_utils.mli +++ /dev/null @@ -1,88 +0,0 @@ -open Parsetree - -(** {2 Various helping functions} *) - -(** Name of the variable which holds the hash of the file. *) -val id_file_hash : Location.t -> string Location.loc - -val eid : string Location.loc -> expression - -val position : Location.t -> expression - -val format_args : expression list -> expression - -val pat_args : pattern list -> pattern - -(** Context convenience module. *) -module Context : sig - - type server = [ `Server | `Shared ] - type client = [ `Client | `Shared ] - - type escape_inject = [ - | `Escaped_value of server - | `Injection of client - ] - - type t = [ - | `Server (* [%%server ... ] *) - | `Client (* [%%client ... ] *) - | `Shared (* [%%shared ... ] *) - | `Fragment of server (* [%client ... ] *) - | `Escaped_value of server (* [%%server [%client ~%( ... ) ] ] *) - | `Injection of client (* [%%client ~%( ... ) ] *) - ] -end - -module Mli : sig - - val is_escaped_ident : string -> bool - - val get_injected_ident_info : string -> (string * int) - - val exists : unit -> bool - - val find_escaped_ident : string Location.loc -> core_type - val find_injected_ident : string Location.loc -> core_type - val find_fragment : string Location.loc -> core_type - -end - -(** Signature of specific code of a preprocessor. *) -module type Pass = sig - - (** How to handle "client", "shared" and "server" sections for top level structure items. - - For shared and server, the boolean argument indicate if this - declaration can lead to evaluation of a fragment. - *) - - val shared_str: bool -> structure_item -> structure_item list - val server_str: bool -> structure_item -> structure_item list - val client_str: structure_item -> structure_item list - - (** How to handle "client", "shared" and "server" sections for top level signature items. *) - - val shared_sig: signature_item -> signature_item list - val client_sig: signature_item -> signature_item list - val server_sig: signature_item -> signature_item list - - (** How to handle "[%client ...]" and "[%shared ...]" expr. *) - val fragment: - ?typ:core_type -> context:Context.server -> - num:string -> id:string Location.loc -> - expression -> expression - - (** How to handle escaped "~%ident" inside a fragment. *) - val escape_inject: - ?ident:string -> context:Context.escape_inject -> - id:string Location.loc -> - expression -> expression - - val prelude : Location.t -> structure - -end - -module Make (P : Pass) : sig - val mapper : string list -> Ast_mapper.mapper -end diff --git a/src/syntax/pa_eliom_client_client.ml b/src/syntax/pa_eliom_client_client.ml deleted file mode 100644 index ffe92cfc5e..0000000000 --- a/src/syntax/pa_eliom_client_client.ml +++ /dev/null @@ -1,319 +0,0 @@ -(* Ocsigen - * http://www.ocsigen.org - * Copyright (C) 2010-2011 - * Raphaël Proust, Grégoire Henry, Benedikt Becker - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -(* This prepocessor generates the code to be executed by the navigator. *) - -(* BB {2 map_get_escaped_values / escape_inject generates only $lid:gen_id$} - The expression $expr$ inside a client_value will be used for for registering - the client closure (cf. [Client_pass.register_client_closures]), as well as - for creating a client-only function (cf. [Client_pass.define_client_functions]). - Only for the former it is necessary to call [Eliom_client_core.Syntax_helpers.get_escaped_value] - on the escaped identifier. - This is done post-hoc by [map_get_escaped_values] in [register_client_closures]. *) - -module Id = struct - let name = "client part" -end - -module Client_pass(Helpers : Pa_eliom_seed.Helpers) = struct - - open Helpers.Syntax - - let notyp = ref false - let _ = - Camlp4.Options.add "-notype" (Arg.Set notyp) "(not documented)" - - (* {2 Auxiliaries} *) - - (* Replace every type [t client_value] by [t]. *) - let drop_client_value_ctyp = - let ast_mapper = - Ast.map_ctyp - (fun typ -> - match Helpers.is_client_value_type typ with - | Some typ' -> typ' - | None -> typ) - in - fun typ -> ast_mapper#ctyp typ - - (* Replace every escaped identifier [v] with - [Eliom_client_core.Syntax_helpers.get_escaped_value v] *) - let map_get_escaped_values ?nested:(nested = false) = - let mapper = - Ast.map_expr - (function - | <:expr@_loc< $lid:str$ >> - when Helpers.is_escaped_indent_string str -> - <:expr< - Eliom_client_core.Syntax_helpers.get_escaped_value - $lid:str$ >> - | <:expr@_loc< $lid:str$ >> - when (Helpers.is_nested_escaped_indent_string str && - nested) -> - <:expr< - Eliom_client_core.Syntax_helpers.get_escaped_value - $lid:str$ >> - | expr -> - expr) - in - fun expr -> - mapper#expr expr - - let push_escaped_binding, flush_escaped_bindings = - let server_arg_ids = ref [] in - let is_unknown gen_id = - List.for_all - (fun (gen_id', _) -> gen_id <> gen_id') - !server_arg_ids - in - let push gen_id expr = - if is_unknown gen_id then - server_arg_ids := (gen_id, expr) :: !server_arg_ids - in - let flush () = - let res = List.rev !server_arg_ids in - server_arg_ids := []; - res - in - push, flush - - let push_escaped_binding_nested, flush_escaped_bindings_nested = - let server_arg_ids = ref [] in - let is_unknown gen_id = - List.for_all - (fun (gen_id', _) -> gen_id <> gen_id') - !server_arg_ids - in - let push gen_id expr = - if is_unknown gen_id then - server_arg_ids := (gen_id, expr) :: !server_arg_ids - and flush () = - let res = List.rev !server_arg_ids in - server_arg_ids := []; - res - in - push, flush - - let push_client_value_data, flush_client_value_datas = - let client_value_datas = ref [] in - let push gen_num gen_id expr nested args = - client_value_datas := - (gen_num, gen_id, expr, nested, args) :: !client_value_datas - in - let flush () = - let res = List.rev !client_value_datas in - client_value_datas := []; - res - in - push, flush - - let get_type f x = - if !notyp then - let _loc = Loc.ghost in - <:ctyp< _ >> - else f x - - let register_client_closures client_value_datas = - let registrations = - List.map - (fun (gen_num, _, expr, nested, args) -> - let typ = get_type Helpers.find_client_value_type gen_num in - let _loc = Ast.loc_of_expr expr in - <:expr< - Eliom_client_core.Syntax_helpers.register_client_closure - $str:gen_num$ - (fun $Helpers.patt_tuple args$ -> - ($map_get_escaped_values ~nested expr$ : $typ$)) - >>) - client_value_datas - in - let _loc = Loc.ghost in - <:str_item< let () = $Ast.exSem_of_list registrations$; () >> - - let define_client_functions client_value_datas = - let bindings = - List.map - (fun (gen_num, gen_id, expr, _, args) -> - let patt = - let _loc = Loc.ghost in - <:patt< $lid:gen_id$ >> - in - let typ = get_type Helpers.find_client_value_type gen_num in - let expr = - let _loc = Loc.ghost in - <:expr< - fun $Helpers.patt_tuple args$ -> - ($expr$ : $typ$) - >> - in - patt, expr) - client_value_datas - in - let _loc = Loc.ghost in - <:str_item< let $Ast.binding_of_pel bindings$ >> - - (* For injections *) - - let close_server_section loc = - let _loc = Loc.ghost in - <:str_item< - let () = - Eliom_client_core.Syntax_helpers.close_server_section - $str:Helpers.file_hash loc$ - >> - - let open_client_section loc = - let _loc = Loc.ghost in - <:str_item< - let () = - Eliom_client_core.Syntax_helpers.open_client_section - $str:Helpers.file_hash loc$ - >> - - (** Syntax extension *) - - let client_str_items loc items = - Ast.stSem_of_list - (open_client_section loc :: - items) - - let server_str_items loc _ = - Ast.stSem_of_list - [ register_client_closures (flush_client_value_datas ()); - close_server_section loc; ] - - let shared_str_items loc items = - let client_expr_data = flush_client_value_datas () in - Ast.stSem_of_list - (open_client_section loc :: - register_client_closures client_expr_data :: - define_client_functions client_expr_data :: - items @ - [ close_server_section loc ]) - - let client_value_expr typ context_level orig_expr gen_num gen_id loc = - - match context_level with - | `Server -> - let l = flush_escaped_bindings () in - push_client_value_data gen_num gen_id orig_expr false - (List.map fst l); - <:expr@loc< >> - | `Shared_expr _ -> - let l = flush_escaped_bindings_nested () in - push_client_value_data gen_num gen_id orig_expr true - (List.map fst l); - (* Escaped bindings can only refer to the parent client - context. To allow IDs that refer to the outer context, we - would need to determine whether an ID should be injected - by the server or not. This would require knowledge of - variable scopes. *) - let bindings = - List.map - (fun (gen_id, expr) -> - let _loc = Loc.ghost in - <:patt< $lid:gen_id$ >>, expr) - l - in - <:expr@loc< - let $Ast.binding_of_pel bindings$ in - $orig_expr$ >> - | `Shared -> - let l = flush_escaped_bindings () in - push_client_value_data gen_num gen_id orig_expr false - (List.map fst l); - let bindings = - List.map - (fun (gen_id, expr) -> - let _loc = Loc.ghost in - <:patt< $lid:gen_id$ >>, expr) - l - in - let args = - let _loc = Loc.ghost in - Helpers.expr_tuple - (List.map - (fun (gen_id, _) -> - <:expr< $lid:gen_id$ >>) - l) - in - <:expr@loc< - let $Ast.binding_of_pel bindings$ in - $lid:gen_id$ $args$ - >> ;; - - let shared_value_expr = client_value_expr - - let escape_inject context_level ?ident orig_expr gen_id = - let open Pa_eliom_seed in - let _loc = Ast.loc_of_expr orig_expr in - let assert_no_variables typ = - let f = function - | Ast.TyQuo _ as typ -> - Printf.eprintf - "%s: %s\n" - (Loc.to_string _loc) - ": Warning. The type of an injected value contains a type variable that could be wrongly inferred (to be fixed in Eliom)."; - typ - | typ -> typ - in - ignore ((Ast.map_ctyp f)#ctyp typ) - in - match context_level with - | Escaped_in_client_value_in (`Shared_expr _) -> - (* {section{ ... {shared#{ ... {{ ... }} ... }} ... }} *) - push_escaped_binding_nested gen_id orig_expr; - <:expr< $lid:gen_id$ >> - | Escaped_in_client_value_in _ - | Escaped_in_shared_value_in _ -> - (* {section{ ... {{ ... %x ... }} ... }} or - {section{ ... {shared# ... { ... %x ... }} ... }} *) - let typ = - drop_client_value_ctyp - (get_type Helpers.find_escaped_ident_type gen_id) - in - assert_no_variables typ; - push_escaped_binding gen_id orig_expr; - <:expr< ($lid:gen_id$ : $typ$) >> - | Injected_in _section -> - (* {_section{ ... %x ... }} *) - let typ = - drop_client_value_ctyp - (get_type Helpers.find_injected_ident_type gen_id) - in - assert_no_variables typ; - let ident = match ident with - | None -> <:expr> - | Some i -> <:expr> in - let (u, d) = Helpers.get_injected_ident_info gen_id in - let s = Printf.sprintf "%s%d" u d in - <:expr< - (Eliom_client_core.Syntax_helpers.get_injection ?ident:($ident$) ~pos:($Helpers.position _loc$) $str:s$ : $typ$) - >> - - let implem _ sil = sil - - let shared_sig_items _ items = Ast.sgSem_of_list items - let server_sig_items _ items = Ast.sgSem_of_list [] - let client_sig_items _ items = Ast.sgSem_of_list items - -end - -module M = Pa_eliom_seed.Register(Id)(Client_pass) diff --git a/src/syntax/pa_eliom_client_server.ml b/src/syntax/pa_eliom_client_server.ml deleted file mode 100644 index d7fd8c8a63..0000000000 --- a/src/syntax/pa_eliom_client_server.ml +++ /dev/null @@ -1,259 +0,0 @@ -(* Ocsigen - * http://www.ocsigen.org - * Copyright (C) 2010-2011 - * Raphaël Proust, Grégoire Henry - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -(* This prepocessor generates the module to be loaded by Ocsigen server *) - -module Id = struct - let name = "server part" -end - -module Server_pass(Helpers : Pa_eliom_seed.Helpers) = struct - - open Helpers.Syntax - - let notyp = ref false - let _ = - Camlp4.Options.add "-notype" (Arg.Set notyp) "(not documented)" - - let push_escaped_binding, flush_escaped_bindings = - let arg_ids = ref [] in - let arg_collection = ref [] in - let push orig_expr gen_id = - if not (List.mem gen_id !arg_ids) then begin - let _loc = Ast.loc_of_expr orig_expr in - arg_collection := (gen_id, orig_expr) :: !arg_collection; - arg_ids := gen_id :: !arg_ids - end - in - let flush () = - let res = List.rev !arg_collection in - arg_ids := []; - arg_collection := []; - let aux (_, arg) = - let _loc = Ast.loc_of_expr arg in - <:expr< Eliom_runtime.escaped_value $arg$ >> - in - List.map aux res - in - push, flush - - let push_escaped_binding_nested, - flush_escaped_bindings_nested = - let arg_ids = ref [] in - let arg_collection = ref [] in - let push orig_expr gen_id = - if not (List.mem gen_id !arg_ids) then begin - arg_collection := (gen_id, orig_expr) :: !arg_collection; - arg_ids := gen_id :: !arg_ids - end - and flush () = - let res = List.rev !arg_collection - and aux (_, arg) = - let _loc = Ast.loc_of_expr arg in - <:expr< Eliom_runtime.escaped_value $arg$ >> - in - arg_ids := []; - arg_collection := []; - List.map aux res - in - push, flush - - let push_injection, flush_injections = - let module String_set = Set.Make (String) in - let buffer : (_ * _ * _) list ref = ref [] in - let gen_ids = ref String_set.empty in - let push ?ident gen_id orig_expr = - if not (String_set.mem gen_id !gen_ids) then - (gen_ids := String_set.add gen_id !gen_ids; - buffer := (gen_id, orig_expr,ident) :: !buffer) - in - let flush_all () = - let res = List.rev !buffer in - gen_ids := String_set.empty; - buffer := []; - res - in - let global_known = ref String_set.empty in - let flush () = - let all = flush_all () in - let novel = - let is_fresh (gen_id, _,_) = - not (String_set.mem gen_id !global_known) - in - List.filter is_fresh all - in - List.iter - (function gen_id, _, _ -> - global_known := String_set.add gen_id !global_known) - novel; - all - in - push, flush - - (* For every injection of $orig_expr$ as $gen_id$: - let $gen_id$ = $orig_expr$ and ... - (Necessary for injections in shared section) *) - let bind_injected_idents injections = - let _loc = Loc.ghost in - let bindings = - List.map - (fun (gen_id, orig_expr,_) -> - <:patt< $lid:gen_id$ >>, - orig_expr) - injections - in - <:str_item< let $Ast.binding_of_pel bindings$ >> - - let close_server_section loc = - let _loc = Loc.ghost in - <:str_item< - let () = - Eliom_runtime.close_server_section - $str:Helpers.file_hash loc$ - >> - - let close_client_section loc injections = - let _loc = Loc.ghost in - let injection_list = - List.fold_right - (fun (gen_id, expr, ident) sofar -> - let loc1 = Ast.loc_of_expr expr in - let loc1_expr = Helpers.position loc1 in - let ident = match ident with - | None -> <:expr> - | Some i -> <:expr< Some $str:i$>> in - let num = - string_of_int (snd (Helpers.get_injected_ident_info gen_id)) in - <:expr< ($int:num$, Eliom_lib.to_poly $lid:gen_id$, - $loc1_expr$, $ident$) :: $sofar$ >>) - injections <:expr< [] >> - in - <:str_item< - let () = - Eliom_runtime.close_client_section - $str:Helpers.file_hash loc$ - $injection_list$ - >> - - - (** Syntax extension *) - - let client_str_items loc _ = - let all_injections = flush_injections () in - Ast.stSem_of_list - [bind_injected_idents all_injections; - close_client_section loc all_injections] - - let server_str_items loc items = - Ast.stSem_of_list - (items @ - [ close_server_section loc ]) - - let shared_str_items loc items = - let all_injections = flush_injections () in - Ast.stSem_of_list - (bind_injected_idents all_injections :: - items @ - [ close_server_section loc; - close_client_section loc all_injections ]) - - let client_value_expr typ context_level orig_expr gen_id _ loc = - let typ = - match typ with - | Some typ -> typ - | None -> - if !notyp then - let _loc = Loc.ghost in <:ctyp< _ >> - else - match Helpers.find_client_value_type gen_id with - | Ast.TyQuo _ -> - Helpers.raise_syntax_error loc - "The types of client values must be monomorphic from its usage \ - or from its type annotation" - | typ -> typ - in - let _loc = Ast.loc_of_expr orig_expr - and l = - match context_level with - | `Shared_expr _ -> - flush_escaped_bindings_nested () - | _ -> - flush_escaped_bindings () - in - <:expr@loc< - (Eliom_runtime.fragment - ~pos:($Helpers.position _loc$) - $str:gen_id$ $Helpers.expr_tuple l$ - : $typ$ Eliom_client_value.t) >> ;; - - let shared_value_expr typ _ orig_expr gen_id _ loc = - let typ = - match typ with - | Some typ -> typ - | None -> - if !notyp then - let _loc = Loc.ghost in <:ctyp< _ >> - else - match Helpers.find_client_value_type gen_id with - | Ast.TyQuo _ -> - Helpers.raise_syntax_error loc - "The types of shared values must be monomorphic from its usage \ - or from its type annotation" - | typ -> typ - in - let _loc = Ast.loc_of_expr orig_expr in - <:expr@loc< - Eliom_shared.Value.create - $orig_expr$ - (Eliom_runtime.fragment - ~pos:($Helpers.position _loc$) - $str:gen_id$ - $Helpers.expr_tuple (flush_escaped_bindings ())$ - : $typ$ Eliom_client_value.t) - >> - - let escape_inject context_level ?ident orig_expr gen_id = - let open Pa_eliom_seed in - match context_level with - | Escaped_in_client_value_in (`Shared_expr _) -> - push_escaped_binding_nested orig_expr gen_id; - let _loc = Loc.ghost in - <:expr< >> - | Escaped_in_shared_value_in _ -> - push_escaped_binding orig_expr gen_id; - orig_expr - | Escaped_in_client_value_in _ -> - push_escaped_binding orig_expr gen_id; - let _loc = Loc.ghost in - <:expr< >> - | Injected_in _ -> - push_injection ?ident gen_id orig_expr; - let _loc = Ast.loc_of_expr orig_expr in - <:expr< $lid:gen_id$ >> - - let implem _ sil = sil - - let shared_sig_items _ items = Ast.sgSem_of_list items - let server_sig_items _ items = Ast.sgSem_of_list items - let client_sig_items _ items = Ast.sgSem_of_list [] - -end - -module M = Pa_eliom_seed.Register(Id)(Server_pass) diff --git a/src/syntax/pa_eliom_seed.ml b/src/syntax/pa_eliom_seed.ml deleted file mode 100644 index 6c8a222a63..0000000000 --- a/src/syntax/pa_eliom_seed.ml +++ /dev/null @@ -1,963 +0,0 @@ -(* Ocsigen - * http://www.ocsigen.org - * Copyright (C) 2010-2011 - * Raphaël Proust, Grégoire Henry - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -(* Eliom's syntax extension implements five kinds of quotations: - - - a toplevel structure item "{client{ ... }}" for client side code ; - - a toplevel structure item "{server{ ... }}" (optional) for server side code ; - - a toplevel structure item "{shared{ ... }}" for code that will be used - both for the server and the client ; - - an expression "{{ ... }}" for client side code inside server side expressions ; - - an expression "{shared# ... { ... }}" for shared code inside - server side expressions ; - - an escaped expression "%ident" for referencing server value from - client side code expressions. - - - == Compilation of Eliom source generates: - - - a .cmo (or a .cmx) to be loaded by the ocsigen server ; - - a .js to be executed by the client. - - The {client{... }} sections are ignored on the server side. - The {server{... }} sections are ignored on the client side. - - '{{ ... }}' are compiled on the client as a function - parameterized by the values of escaped expressions. On the - server-side, '{{ ... }}' are compiled as a distant call. To keep - the link, each '{{ ... }}' is associated unique string (see - gen_closure_id). - - In order to type-check escaped-value with the same type on both - sides, compilation of Eliom sources infers the static type of - escaped values on the server-side and adds static type constraint - on the client-side. Inferred types also permits to specialize - marshaling (on the server-side) and unmarshalling (on the - client-side) of escaped values. - - == Compilation of Eliom is implemented in three steps: - - a) infers types of escaped values on the server-side code - b) generate the source file for the server-side - c) generate the source file for the client-side - - Each compilation step is based an a specific preprocessor: - - a) pa_eliom_type_inference - b) pa_eliom_client_server - c) pa_eliom_client_client - - This module define code shared by the three preprocessors. - -*) - -(** Helpers for pa_eliom_client_server and pa_eliom_client_client. *) - -module type Helpers = sig - - module Syntax : Camlp4.Sig.Camlp4Syntax - open Syntax - - (** find inferred type for escaped expr *) - val find_client_value_type: string -> Ast.ctyp - - (** find inferred type for escaped expr *) - val find_escaped_ident_type: string -> Ast.ctyp - - (** find inferred type for injected ident *) - val find_injected_ident_type: string -> Ast.ctyp - - val get_injected_ident_info: string -> string * int - - val is_client_value_type : Ast.ctyp -> Ast.ctyp option - - val raise_syntax_error : Ast.Loc.t -> string -> _ - - val is_escaped_indent_string: string -> bool - - val is_nested_escaped_indent_string: string -> bool - - val patt_tuple : string list -> Ast.patt - val expr_tuple : Ast.expr list -> Ast.expr - - val string_of_ident : Ast.ident -> string option - val position : Ast.Loc.t -> Ast.expr - - val file_hash : Ast.Loc.t -> string -end - -type shared_value_context = [ `Server | `Shared ] -let shared_value_context_to_string = function - | `Server -> "server" - | `Shared -> "shared" - -type client_value_context = - [ `Server - | `Shared - | `Shared_expr of shared_value_context ] -let client_value_context_to_string = function - | `Server -> "server" - | `Shared -> "shared" - | `Shared_expr c -> - "shared expr on " ^ (shared_value_context_to_string c) - -type injection_context = [ `Client | `Shared ] -let injection_context_to_string = function - | `Client -> "client" - | `Shared -> "shared" - -type escape_inject = - | Escaped_in_client_value_in of client_value_context - | Escaped_in_shared_value_in of shared_value_context - | Injected_in of injection_context - -(** Signature of specific code of a preprocessor. *) - -module type Pass = functor (Helpers: Helpers) -> sig - - open Helpers.Syntax - - (** How to handle "{shared{ ... }}" str_item. *) - val shared_str_items: Ast.Loc.t -> Ast.str_item list -> Ast.str_item - - (** How to handle "{server{ ... }}" str_item and toplevel str_item. *) - val server_str_items: Ast.Loc.t -> Ast.str_item list -> Ast.str_item - - (** How to handle "{client{ ... }}" str_item. *) - val client_str_items: Ast.Loc.t -> Ast.str_item list -> Ast.str_item - - val shared_sig_items: Ast.Loc.t -> Ast.sig_item list -> Ast.sig_item - val client_sig_items: Ast.Loc.t -> Ast.sig_item list -> Ast.sig_item - val server_sig_items: Ast.Loc.t -> Ast.sig_item list -> Ast.sig_item - - (** How to handle "{{ ... }}" expr. *) - val client_value_expr: Ast.ctyp option -> client_value_context -> Ast.expr -> string -> string -> Ast.Loc.t -> Ast.expr - - (** How to handle "{shared# ... { ... }}" expr. *) - val shared_value_expr: - Ast.ctyp option -> shared_value_context -> Ast.expr -> - string -> string -> Ast.Loc.t -> Ast.expr - - (** How to handle escaped "%ident" inside "{{ ... }}". *) - val escape_inject: escape_inject -> ?ident: string -> Ast.expr -> string -> Ast.expr - - val implem : Ast.Loc.t -> Ast.str_item list -> Ast.str_item list - -end - -let fst_3 (x, _, _) = x -let snd_3 (_, x, _) = x -let trd_3 (_, _, x) = x - -module Register(Id : sig val name: string end)(Pass : Pass) = struct - - module Make(Syntax : Camlp4.Sig.Camlp4Syntax) = struct - - include Syntax - - (* Syntax error exception *) - module Syntax_error = struct - type t = string - exception E of t - let print fmt msg = - Format.fprintf fmt "Error: %s" msg - let to_string msg = - ignore(Format.flush_str_formatter ()); - print Format.str_formatter msg; - Format.flush_str_formatter () - let raise _loc msg = - Loc.raise _loc (E msg) - end - - module Helpers = struct - - (* Anything easier than Camlp4? Create a parser for OCaml which - shares the Token, AST, etc with those of the [Syntax] - argument in the above functor [Make], but with an independent - Grammar, because we want the to parse the .type_mli without - the grammar modifications in made for the .eliomi files. *) - module Syntax = - Camlp4OCamlParser.Make - (Camlp4OCamlRevisedParser.Make - (Camlp4.OCamlInitSyntax.Make - (Syntax.Ast) - (Camlp4.Struct.Grammar.Static.Make - (Camlp4.Struct.Lexer.Make (Syntax.Token))) - (Syntax.Quotation))) - - let raise_syntax_error _loc msg = - Syntax_error.raise _loc msg - - (** MLI READER ***) - - (* Here we define a set of functions for mli reading. This is used - to peek at the type inferred by the first pass.*) - - let type_file = ref "" - let _ = - Camlp4.Options.add "-type" (Arg.Set_string type_file) "type inference file" - - let get_type_file () = match !type_file with - | "" -> Filename.chop_extension !Camlp4_config.current_input_file - ^ ".type_mli" - | f -> f - - let suppress_underscore = - let c = ref 0 in - let uid () = incr c ; !c in - fun ty -> - let pfix = Printf.sprintf "__eliom_inferred_type_%d" (uid ()) in - let map ty = match ty with - | Ast.TyApp (_, Ast.TyAny _, ty) - | Ast.TyApp (_, ty, Ast.TyAny _) -> ty - | Ast.TyQuo (x, var) when var.[0] = '_' -> - Ast.TyQuo (x, (String.sub var 1 (String.length var - 1)) ^ pfix) - | ty -> ty in - (Ast.map_ctyp map)#ctyp ty - - let rec string_of_ident = - function - | <:ident< $lid:s$ >> -> Some s - | <:ident< $uid:s$ >> -> Some s - | <:ident< $i1$.$i2$ >> -> - begin match (string_of_ident i1), (string_of_ident i2) with - | Some s1,Some s2 -> Some (s1 ^ "." ^ s2) - | _ -> None end - | _ -> None - - let lexing_position l = - let _loc = Loc.ghost in - <:expr< - { Lexing.pos_fname = $str:l.Lexing.pos_fname$; - Lexing.pos_lnum = $int:string_of_int l.Lexing.pos_lnum$; - Lexing.pos_bol = $int:string_of_int l.Lexing.pos_bol$; - Lexing.pos_cnum = $int:string_of_int l.Lexing.pos_cnum$; }>> - - let position _loc = - let start = Loc.start_pos _loc in - let stop = Loc.stop_pos _loc in - <:expr< ($lexing_position start$ , $lexing_position stop$) >> - - let escaped_ident_prefix = "__eliom__escaped_ident__reserved_name__" - let escaped_ident_prefix_len = String.length escaped_ident_prefix - let is_escaped_indent_string id = - String.length id > escaped_ident_prefix_len && - String.sub id 0 escaped_ident_prefix_len = escaped_ident_prefix - let is_escaped_ident = function - (* | <:sig_item< val $id$ : $t$ >> -> *) - | Ast.SgVal (_loc, id, t) -> - is_escaped_indent_string id - | si -> false - - (* separate set of IDs for client values inside shared values *) - let nested_escaped_ident_prefix = "__eliom__cv_in_sv__reserved_name__" - let nested_escaped_ident_prefix_len = - String.length nested_escaped_ident_prefix - let is_nested_escaped_indent_string id = - String.length id > nested_escaped_ident_prefix_len && - String.sub id 0 nested_escaped_ident_prefix_len = - nested_escaped_ident_prefix - - let injected_ident_fmt () = - format_of_string "__eliom__injected_ident__reserved_name__%6s__%d" - let is_injected_ident = function - (* | <:sig_item< val $id$ : $t$ >> -> *) - | Ast.SgVal (_loc, id, t) -> - (try - Scanf.sscanf id (injected_ident_fmt ()) (fun _ _ -> true) - with Scanf.Scan_failure _ -> - false) - | si -> false - - let client_value_ident_prefix = "__eliom__client_value__reserved_name__" - let client_value_ident_prefix_len = String.length client_value_ident_prefix - let is_client_value_ident = function - (* | <:sig_item< val $id$ : $t$ >> -> *) - | Ast.SgVal (_loc, id, t) -> - String.length id > client_value_ident_prefix_len && - String.sub id 0 client_value_ident_prefix_len = client_value_ident_prefix - | si -> false - - let is_client_value_type = function - | <:ctyp< $typ$ Eliom_client_value.t >> -> Some typ - | _ -> None - - let extract_escaped_ident_type = function - (* | <:sig_item< val $id$ : ($t$ option ref) >> -> *) - | Ast.SgVal (_loc, id, <:ctyp< ($t$ option ref) >>) -> - let len = String.length id - escaped_ident_prefix_len in - int_of_string (String.sub id escaped_ident_prefix_len len), - suppress_underscore t - | _ -> failwith "extract_escaped_ident_type" - let extract_injected_ident_type = function - (* | <:sig_item< val $id$ : ($t$ option ref) >> -> *) - | Ast.SgVal (_loc, id, <:ctyp< ($t$ option ref) >>) -> - Scanf.sscanf id (injected_ident_fmt ()) (fun _filehash n -> n), - suppress_underscore t - | _ -> failwith "extract_injected_ident_type" - let extract_client_value_type = function - (* | <:sig_item< val $id$ : ($t$ option ref) >> -> *) - | Ast.SgVal (_, id, <:ctyp< $typ$ option ref>>) -> - (match is_client_value_type typ with - | Some t -> - let len = String.length id - client_value_ident_prefix_len in - String.sub id client_value_ident_prefix_len len, - suppress_underscore t - | None -> - Printf.ksprintf failwith - "extract_client_value_type: Not a client value %S" id) - | _ -> failwith "extract_client_value_type" - - let load_file f = - try - let ic = open_in f in - let s = Stream.of_channel ic in - let item = Syntax.parse_interf (Loc.mk f) s in - let items = Ast.list_of_sig_item item [] in - close_in ic; - List.map extract_escaped_ident_type (List.filter is_escaped_ident items), - List.map extract_injected_ident_type (List.filter is_injected_ident items), - List.map extract_client_value_type (List.filter is_client_value_ident items) - with - | Sys_error _ -> - Printf.eprintf "Error: File type not found (%s)\n" (get_type_file ()); - exit 1 - | Loc.Exc_located(loc,exn) -> - Printf.eprintf "%s:\n Exception (%s)\n" - (Loc.to_string loc) (Printexc.to_string exn); - exit 1 - - let inferred_sig = lazy (load_file (get_type_file ())) - - let find_escaped_ident_type id = - try - let len = String.length id - escaped_ident_prefix_len in - let id = int_of_string (String.sub id escaped_ident_prefix_len len) in - List.assoc id (fst_3 (Lazy.force inferred_sig)) - with Not_found -> - Printf.eprintf "Error: Infered type of escaped ident not found (%s). \ - You need to regenerate %s.\n" - id (get_type_file ()); - exit 1 - - let get_injected_ident_info id = - Scanf.sscanf id (injected_ident_fmt ()) (fun u n -> (u, n)) - - let find_injected_ident_type id = - try - let (_, id) = get_injected_ident_info id in - List.assoc id (snd_3 (Lazy.force inferred_sig)) - with Not_found -> - Printf.eprintf "Error: Infered type of injected ident not found (%s). \ - You need to regenerate %s.\n" - id (get_type_file ()); - exit 1 - - let find_client_value_type id = - try - List.assoc id (trd_3 (Lazy.force inferred_sig)) - with Not_found -> - Printf.eprintf "Error: Infered type client value not found (%s). \ - You need to regenerate %s.\n" - id (get_type_file ()); - exit 1 - - (* Convert a list of patterns to a tuple of pattern, one single pattern, or (). *) - let patt_tuple = - let _loc = Loc.ghost in - let patt_of_id id = - <:patt< $lid:id$ >> - in function - | [] -> <:patt< () >> - | [id] -> patt_of_id id - | ps -> <:patt< $tup:Ast.paCom_of_list (List.map patt_of_id ps)$ >> - - (* Convert a list of expressions to a tuple, one expression, or (). *) - let expr_tuple = - let _loc = Loc.ghost in function - | [] -> <:expr< () >> - | [e] -> e - | es -> <:expr< $tup:Ast.exCom_of_list es$ >> - - let file_hash loc = - let s = Digest.string (Ast.Loc.file_name loc) in - let e = - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_'" in - let o = Bytes.create 6 in - let g p = Char.code s.[p] in - for i = 0 to 5 do - let p = i * 6 / 8 in - let d = 10 - (i * 6) mod 8 in - Bytes.set o i e.[(g p lsl 8 + g (p + 1)) lsr d land 63] - done; - Bytes.to_string o - - end (* End of Helpers *) - - - - (** Extend LEXER ***) - - (* Add keywords: "{{", "{shared{", "{server{", "{client{" et "}}" *) - - let merge_locs l ls = List.fold_left Token.Loc.merge ls l - - open Camlp4.Sig (* for KEYWORD, LIDENT and SYMBOL *) - - let rec filter = parser - | [< '(KEYWORD "{", loc0); next >] -> - (match next with parser - | [< '(KEYWORD "{", loc1); nnext >] -> (* {{ *) - [< '(KEYWORD "{{", merge_locs [loc0] loc1); filter nnext >] - - | [< '(LIDENT "shared", loc1); nnnext >] -> - (match nnnext with parser - | [< '(KEYWORD "#", loc2); nnnnext >] -> (* {shared# *) - [< '(KEYWORD ("{shared#"), merge_locs [loc0; loc1] loc2); - filter nnnnext - >] - - | [< '(KEYWORD "{", loc2); nnnnext >] -> (* {shared{ *) - [< '(KEYWORD ("{shared{"), merge_locs [loc0; loc1] loc2); - filter nnnnext - >] - - | [< 'other; nnnnext >] -> (* back *) - [< '(KEYWORD "{", loc0); '(LIDENT "shared", loc1); 'other; - filter nnnnext - >] - ) - - | [< '(LIDENT ("client"|"server" as s), loc1); nnnext >] -> - (match nnnext with parser - | [< '(KEYWORD "{", loc2); nnnnext >] -> (* {smthg{ *) - [< '(KEYWORD ("{"^s^"{"), merge_locs [loc0; loc1] loc2); - filter nnnnext - >] - - | [< 'other; nnnnext >] -> (* back *) - [< '(KEYWORD "{", loc0); '(LIDENT s, loc1); 'other; - filter nnnnext - >] - ) - - | [< 'other; nnext >] -> (* back *) - [< '(KEYWORD "{", loc0); 'other; filter nnext >] - ) - - | [< '(KEYWORD "}", loc0); next >] -> - (match next with parser - | [< '(KEYWORD "}", loc1); nnext >] -> - [< '(KEYWORD "}}", merge_locs [loc0] loc1); filter nnext >] - - | [< 'other; nnext >] -> (* back *) - [< '(KEYWORD "}", loc0); 'other; filter nnext >] - ) - - | [< 'other; next >] -> - let is_left_delimitor str = List.mem str.[0] ['('; '['; '{'] in - let ends_with_percent_sign str = str.[String.length str-1] = '%' in - match other with - | (* Allow %-sign to for injection directly after left delimitors *) - SYMBOL str, loc0 - when String.length str > 0 && - is_left_delimitor str && - ends_with_percent_sign str -> - let left = String.sub str 0 (String.length str - 1) in - let loc_left = Loc.move `stop (-1) loc0 in - let loc_right = Loc.move `start (String.length str - 1) loc0 in - [< '(KEYWORD left, loc_left); '(SYMBOL "%", loc_right); filter next >] - | _ -> [< 'other; filter next >] - - let () = - Token.Filter.define_filter - (Gram.get_filter ()) - (fun old_filter stream -> old_filter (filter stream)) - - - - (** Extend Parser **) - - module Pass = Pass(Helpers) - - (* State of the parser: for checking syntax imbrication. *) - type parsing_level = - | Toplevel - | Toplevel_module_expr - | Server_item - | Client_item - | Shared_item - | Module_expr - | Hole_expr of client_value_context - | Shared_expr of shared_value_context - | Escaped_expr of client_value_context - | Escaped_expr_in_shared of shared_value_context - | Injected_expr of injection_context - let level_to_string = function - | Toplevel -> "toplevel" - | Toplevel_module_expr -> "toplevel module expr" - | Server_item -> "server section" - | Client_item -> "client section" - | Shared_item -> "shared section" - | Module_expr -> "module expr" - | Shared_expr c -> - "shared expr in" ^ (shared_value_context_to_string c) - | Hole_expr client_value_context -> - "client value expr in " ^ client_value_context_to_string client_value_context - | Escaped_expr client_value_context -> - "escaped expression in " ^ client_value_context_to_string client_value_context - | Escaped_expr_in_shared shared_value_context -> - "escaped expression inside shared expression in " ^ - shared_value_context_to_string shared_value_context - | Injected_expr injection_context -> - "injected expression in " ^ injection_context_to_string injection_context - (* [client_value_context] captures where [client_value_expr]s are allowed. *) - let client_value_context = function - | Server_item | Toplevel | Toplevel_module_expr -> `Server - | Shared_item -> `Shared - | Shared_expr c -> `Shared_expr c - | Client_item | Hole_expr _ | Escaped_expr _ - | Escaped_expr_in_shared _ | Injected_expr _ - | Module_expr as context -> - failwith ("client_value_context: " ^ level_to_string context) - let injection_context_to_parsing_level : injection_context -> parsing_level = function - | `Client -> Client_item - | `Shared -> Shared_item - let current_level = ref Toplevel - let set_current_level level = - current_level := level - - (* [shared_value_context] captures where [shared_value_expr]s are allowed. *) - let shared_value_context = function - | Server_item | Toplevel | Toplevel_module_expr -> `Server - | Shared_item -> `Shared - | Client_item | Hole_expr _ | Shared_expr _ | Escaped_expr _ - | Escaped_expr_in_shared _ | Injected_expr _ - | Module_expr as context -> - failwith ("shared_value_context: " ^ level_to_string context) - - (* Identifiers for the closure representing "Hole_expr". *) - let gen_closure_num_count = ref 0 - let gen_closure_id _loc = - incr gen_closure_num_count; - Format.sprintf "%s%d" (Helpers.file_hash _loc) !gen_closure_num_count - let gen_closure_escaped_ident id = - Helpers.client_value_ident_prefix ^ id - - (* Globaly unique ident for escaped expression *) - (* It's used for type inference and as argument name for the - closure representing the surrounding "Hole_expr". *) - (* Inside a "Hole_expr", same ident share the global ident. *) - let escaped_idents = ref [] - let reset_escaped_ident () = escaped_idents := [] - let gen_escaped_expr_ident, gen_escaped_ident = - let r = ref 0 in - (fun () -> - incr r; - Helpers.escaped_ident_prefix ^ string_of_int !r), - (fun id -> - let id = (Ast.map_loc (fun _ -> Loc.ghost))#ident id in - try List.assoc id !escaped_idents - with Not_found -> - incr r; let gen_id = Helpers.escaped_ident_prefix ^ string_of_int !r in - escaped_idents := (id, gen_id) :: !escaped_idents; - gen_id) - - let nested_escaped_idents = ref [] - let reset_nested_escaped_ident () = nested_escaped_idents := [] - let gen_nested_escaped_expr_ident, - gen_nested_escaped_ident = - let r = ref 0 in - (fun () -> - incr r; - Helpers.nested_escaped_ident_prefix ^ string_of_int !r), - (fun id -> - let id = (Ast.map_loc (fun _ -> Loc.ghost))#ident id in - try List.assoc id !nested_escaped_idents - with Not_found -> - incr r; - let gen_id = - Helpers.nested_escaped_ident_prefix ^ string_of_int !r in - nested_escaped_idents := (id, gen_id) :: !nested_escaped_idents; - gen_id) - - let - gen_injected_expr_ident , - gen_injected_ident , - reset_injected_ident = - let injected_idents = ref [] in - let r = ref 0 in - let gen_ident loc = - let hash = Helpers.file_hash loc in - incr r; - Printf.sprintf (Helpers.injected_ident_fmt ()) hash !r - in - let gen_injected_ident loc id = - let id = (Ast.map_loc (fun _ -> Loc.ghost))#ident id in - try List.assoc id !injected_idents - with Not_found -> - let gen_id = gen_ident loc in - injected_idents := (id, gen_id) :: !injected_idents; - gen_id - and reset () = injected_idents := [] in - gen_ident, gen_injected_ident, reset - - - (* BBB Before the syntax error was thrown in the productions dummy_set_*. This - resulted in wrong error locations. The solution is to let the dummy productions - return an option and raise the syntax error in the enclosing production. *) - let from_some_or_raise opt loc f fmt = - match opt with - | Some x -> - Printf.ksprintf (fun _ -> f x) fmt - | None -> - Printf.ksprintf (Syntax_error.raise loc) fmt - - module E2 = Camlp4.ErrorHandler.Register(Syntax_error) ;; - - try - DELETE_RULE Gram expr: "{"; TRY [label_expr_list; "}"] END - with Camlp4.Struct.Grammar.Delete.Rule_not_found _ -> - (let test_record_field = - Gram.Entry.of_parser "record_field" (fun strm -> - let rec loop = function - | [] -> () - | (UIDENT _, _) :: (KEYWORD ".", _) :: rest -> loop rest - | (LIDENT _, _) :: (KEYWORD "=", _) :: _ -> () - | (LIDENT _, _) :: (KEYWORD ";", _) :: _ -> () - | [LIDENT _, _] -> () - | _ -> raise Stream.Failure - in - loop (Stream.npeek 100 strm)) - in - DELETE_RULE Gram expr: - "{"; test_record_field; label_expr_list; "}" END) ;; - - DELETE_RULE Gram expr: "{"; TRY [expr LEVEL "."; "with"]; label_expr_list; "}" END; - - (* Extending syntax *) - EXTEND Gram - GLOBAL: str_item sig_item expr module_expr module_binding0 str_items sig_items implem interf; - - (* Dummy rules: for level management and checking. *) - dummy_set_level_shared: - [[ -> - begin match !current_level with - | Toplevel -> set_current_level Shared_item; Some () - | _ -> None - end - ]]; - dummy_set_level_server: - [[ -> match !current_level with - | Toplevel -> set_current_level Server_item; Some () - | _ -> None - ]]; - dummy_set_level_client: - [[ -> - match !current_level with - | Toplevel -> set_current_level Client_item; Some () - | _ -> None - ]]; - dummy_set_level_client_value_expr: - [[ -> reset_escaped_ident (); reset_nested_escaped_ident (); - match !current_level with - | Toplevel | Toplevel_module_expr | Server_item - | Shared_item | (Shared_expr _) as old -> - set_current_level (Hole_expr (client_value_context old)); - Some old - | Client_item | Hole_expr _ | Escaped_expr _ - | Escaped_expr_in_shared _ | Injected_expr _ - | Module_expr -> - None - ]]; - dummy_set_level_shared_value_expr: - [[ -> reset_escaped_ident (); - match !current_level with - | Toplevel | Toplevel_module_expr | Server_item as old -> - set_current_level (Shared_expr `Server); - Some old - | Shared_item -> - set_current_level (Shared_expr `Shared); - Some Shared_item - | Client_item | Shared_expr _ | Hole_expr _ - | Escaped_expr _ | Escaped_expr_in_shared _ - | Injected_expr _ | Module_expr -> - None - ]]; - dummy_check_level_escaped_ident: - [[ -> match !current_level with - | Hole_expr context -> - Some (Escaped_in_client_value_in context) - | Shared_expr context -> - Some (Escaped_in_shared_value_in context) - | Client_item -> - Some (Injected_in `Client) - | Shared_item -> - Some (Injected_in `Shared) - | _ -> None - ]]; - dummy_set_level_escaped_expr: - [[ -> match !current_level with - | Hole_expr context -> - set_current_level (Escaped_expr context); - Some (Escaped_in_client_value_in context) - | Shared_expr context -> - set_current_level (Escaped_expr_in_shared context); - Some (Escaped_in_shared_value_in context) - | Client_item -> - set_current_level (Injected_expr `Client); - Some (Injected_in `Client) - | Shared_item -> - set_current_level (Injected_expr `Shared); - Some (Injected_in `Shared) - | _ -> None - ]]; - dummy_set_level_module_expr: - [[ -> match !current_level with - | Toplevel -> - set_current_level Toplevel_module_expr; - Toplevel - | lvl -> lvl ]]; - - str_items: FIRST - [[ lvl = dummy_set_level_module_expr; - me = SELF -> set_current_level lvl; me ]]; - - sig_items: FIRST - [[ lvl = dummy_set_level_module_expr; me = SELF -> - set_current_level lvl; me ]]; - - (* Duplicated from camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml *) - module_expr: BEFORE "top" - [[ "functor"; "("; i = a_UIDENT; ":"; t = module_type; ")"; "->"; - lvl = dummy_set_level_module_expr; - me = SELF -> - set_current_level lvl; <:module_expr< functor ( $i$ : $t$ ) -> $me$ >> ]]; - - (* Duplicated from camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml *) - module_binding0: FIRST - [ RIGHTA - [ "("; m = a_UIDENT; ":"; mt = module_type; ")"; - lvl = dummy_set_level_module_expr; mb = SELF -> - set_current_level lvl; <:module_expr< functor ( $m$ : $mt$ ) -> $mb$ >> ]]; - - sig_item: BEFORE "top" - [ "eliom" - [ KEYWORD "{shared{" ; opt = dummy_set_level_shared ; es = LIST0 sig_item ; KEYWORD "}}" -> - from_some_or_raise opt _loc - (fun () -> - set_current_level Toplevel; - Pass.shared_sig_items _loc es) - "The syntax {shared{ ... }} is only allowed at toplevel" - | KEYWORD "{server{" ; opt = dummy_set_level_server ; es = LIST0 sig_item ; KEYWORD "}}" -> - from_some_or_raise opt _loc - (fun () -> - set_current_level Toplevel; - Pass.server_sig_items _loc es) - "The syntax {server{ ... }} is only allowed at toplevel" - | KEYWORD "{client{" ; opt = dummy_set_level_client ; es = LIST0 sig_item ; KEYWORD "}}" -> - from_some_or_raise opt _loc - (fun () -> - set_current_level Toplevel; - Pass.client_sig_items _loc es) - "The syntax {client{ ... }} is only allowed at toplevel" - | si = sig_item LEVEL "top" -> - if !current_level = Toplevel then - Pass.server_sig_items _loc [si] - else - si - ]]; - - - (* To str_item we add {client{ ... }}, {server{ ... }} and {shared{ ... }} *) - str_item: BEFORE "top" - - [ "eliom" - - [ KEYWORD "{shared{" ; opt = dummy_set_level_shared ; es = LIST0 str_item ; KEYWORD "}}" -> - from_some_or_raise opt _loc - (fun () -> - set_current_level Toplevel; - let v = Pass.shared_str_items _loc es in - reset_injected_ident () ; v) - "The syntax {shared{ ... }} is only allowed at toplevel" - - | KEYWORD "{server{" ; opt = dummy_set_level_server ; es = LIST0 str_item ; KEYWORD "}}" -> - from_some_or_raise opt _loc - (fun () -> - set_current_level Toplevel; - Pass.server_str_items _loc es) - "The syntax {server{ ... }} is only allowed at toplevel" - - | KEYWORD "{client{" ; opt = dummy_set_level_client ; es = LIST0 str_item ; KEYWORD "}}" -> - from_some_or_raise opt _loc - (fun () -> - set_current_level Toplevel; - let v = Pass.client_str_items _loc es in - reset_injected_ident () ; v) - "The syntax {client{ ... }} is only allowed at toplevel" - - | si = str_item LEVEL "top" -> - - if !current_level = Toplevel then - Pass.server_str_items _loc [si] - else - si - - ]]; - - (* To expr we add {{ ... }} and %IDENT *) - - expr: LEVEL "simple" - - [ [ KEYWORD "{"; lel = TRY [lel = label_expr_list; "}" -> lel] -> - Ast.ExRec (_loc, lel, Ast.ExNil _loc) - | KEYWORD "{shared#"; - typ = TRY [ typ = OPT ctyp; KEYWORD "{" -> typ]; - opt_lvl = dummy_set_level_shared_value_expr ; - e = expr; KEYWORD "}}" -> - from_some_or_raise opt_lvl _loc - (fun lvl -> - set_current_level lvl; - let id = gen_closure_id _loc in - Pass.shared_value_expr typ (shared_value_context lvl) e - id (gen_closure_escaped_ident id) _loc) - "The syntax {shared# type{ ... } is not allowed in %s." - (level_to_string !current_level) - | KEYWORD "{"; typ = TRY [ typ = OPT ctyp; KEYWORD "{" -> typ]; opt_lvl = dummy_set_level_client_value_expr ; e = expr; KEYWORD "}}" -> - from_some_or_raise opt_lvl _loc - (fun lvl -> - set_current_level lvl; - let id = gen_closure_id _loc in - Pass.client_value_expr typ (client_value_context lvl) e - id (gen_closure_escaped_ident id) _loc) - "The syntax {type{ ... } is not allowed in %s." - (level_to_string !current_level) - | KEYWORD "{"; e = TRY [e = expr LEVEL "."; "with" -> e]; lel = label_expr_list; "}" -> - <:expr< { ($e$) with $lel$ } >> - | KEYWORD "{{"; opt_lvl = dummy_set_level_client_value_expr ; e = expr; KEYWORD "}}" -> - from_some_or_raise opt_lvl _loc - (fun lvl -> - set_current_level lvl; - let id = gen_closure_id _loc in - Pass.client_value_expr None (client_value_context lvl) e - id (gen_closure_escaped_ident id) _loc) - "The syntax {{ ... }} is not allowed in %s." - (level_to_string !current_level) - ] ]; - - expr: BEFORE "simple" - - [ [ SYMBOL "%" ; id = ident ; opt_context = dummy_check_level_escaped_ident -> - from_some_or_raise opt_context _loc - (fun context -> - let gen_id = - match context with - | Escaped_in_client_value_in (`Shared_expr _) -> - gen_nested_escaped_ident id - | Escaped_in_client_value_in _ - | Escaped_in_shared_value_in _ -> - gen_escaped_ident id - | Injected_in _ -> - gen_injected_ident _loc id - in - Pass.escape_inject context ?ident:(Helpers.string_of_ident id) <:expr< $id:id$ >> gen_id) - "The syntax \"%%ident\" is not allowed in %s." - (level_to_string !current_level) - - | SYMBOL "%" ; KEYWORD "(" ; opt_context = dummy_set_level_escaped_expr ; e = SELF ; KEYWORD ")" -> - from_some_or_raise opt_context _loc - (fun context -> - set_current_level - (match context with - | Escaped_in_client_value_in context -> Hole_expr context - | Escaped_in_shared_value_in context -> Shared_expr context - | Injected_in context -> injection_context_to_parsing_level context); - let gen_id = - match context with - | Escaped_in_client_value_in (`Shared_expr _) -> - gen_nested_escaped_expr_ident () - | Escaped_in_client_value_in _ - | Escaped_in_shared_value_in _ -> - gen_escaped_expr_ident () - | Injected_in _ -> - gen_injected_expr_ident _loc - in - Pass.escape_inject context e gen_id) - "The syntax \"%%(...)\" is not allowed in %s." - (level_to_string !current_level) - ]]; - - (* Cf. Camlp4OCamlRevisedParser *) - implem: - [[ si = str_item; semi; (sil, stopped) = SELF -> - (Pass.implem _loc (si :: sil), stopped) - | `EOI -> ([], None) - ]]; - - interf: - [[ si = sig_item; semi; (sil, stopped) = SELF -> - (si :: sil, stopped) - | `EOI -> ([], None) ]]; - - - END - - end - - (** Register syntax extension *) - - module Id : Camlp4.Sig.Id = struct - let name = "Eliom source file syntax ("^ Id.name ^")" - let version = "3.0+alpha" - end - - module M = Camlp4.Register.OCamlSyntaxExtension(Id)(Make) - -end - - -module Make(Syntax : Camlp4.Sig.Camlp4Syntax) = struct - - include Syntax - - (* Extending syntax *) - EXTEND Gram - GLOBAL: implem interf; - - implem: FIRST - [[ (sil, stopped) = implem LEVEL "top" -> - ( sil , stopped) ] - | "top" [] ]; - - interf: FIRST - [[ (sil, stopped) = interf LEVEL "top" -> - ( sil , stopped) ] - | "top" [] ]; - - END -end - -module Id : Camlp4.Sig.Id = struct - let name = "Eliom source file syntax (common)" - let version = "3.0" -end - -module M = Camlp4.Register.OCamlSyntaxExtension(Id)(Make) diff --git a/src/syntax/pa_eliom_type_filter.ml b/src/syntax/pa_eliom_type_filter.ml deleted file mode 100644 index c68b1bc1a8..0000000000 --- a/src/syntax/pa_eliom_type_filter.ml +++ /dev/null @@ -1,157 +0,0 @@ -(* Ocsigen - * http://www.ocsigen.org - * Copyright (C) 2010-2011 - * Raphaël Proust, Grégoire Henry - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -(* This module generates the file used to infer types (hence wrappers) of server - escaped values. - - Server-specific and escaped expression will be kept only for - type-checking. In order to export type of escaped expressions: it - generates for each escaped expression a toplevel definition that - looks like: - - let $global_id$ = ref None - - And client-side expressions are replaced by lists of initializers - (one per escaped expressions): - - $global_id$ := Some $expr$ - -*) - -module Id = struct - let name = "type-inference" -end - -module Type_pass(Helpers : Pa_eliom_seed.Helpers) = struct - - open Helpers.Syntax - - (* accumulator, push and flush for typing expression - <:expr< $gen_id$ := Some $orig_expr$ >> *) - let push_typing_expr, flush_typing_expr = - let typing_expr = ref [] in - let add orig_expr gen_id = - let _loc = Ast.loc_of_expr orig_expr in - if List.for_all (function gen_id', _ -> gen_id <> gen_id') !typing_expr then - typing_expr := (gen_id, <:expr< $lid:gen_id$ := Some $orig_expr$ >>) :: !typing_expr - in - let flush () = - let res = List.rev (List.map snd !typing_expr) in - typing_expr := []; - Ast.exSem_of_list res - in - add, flush - - (* accumulator, push and flush for typing str_items - <:str_item< let $gen_id$ = ref None >> *) - let push_typing_str_item, flush_typing_str_item = - let typing_strs = ref [] in - let add orig_expr gen_id = - let _loc = Ast.loc_of_expr orig_expr in - if List.for_all (function gen_id', _ -> gen_id' <> gen_id) !typing_strs then - typing_strs := (gen_id, <:str_item< let $lid:gen_id$ = Pervasives.ref None >>) :: !typing_strs - in - let flush () = - let res = List.map snd !typing_strs in - typing_strs := []; - Ast.stSem_of_list res - in - add, flush - - (** Syntax extension *) - - let client_str_items _loc items = - Ast.stSem_of_list [ - flush_typing_str_item (); - (let _loc = Loc.ghost in - <:str_item< let () = begin $flush_typing_expr ()$ end >>); - ] - - let server_str_items _loc items = - Ast.stSem_of_list (flush_typing_str_item () :: items) - - let shared_str_items = server_str_items - - let client_value_expr typ context_level orig_expr gen_id gen_tid loc = - push_typing_str_item orig_expr gen_tid; - let typ = match typ with - | Some typ -> typ - | None -> let _loc = Loc.ghost in <:ctyp< _ >> - in - let _loc = loc in - <:expr< begin - $flush_typing_expr ()$; - $lid:gen_tid$ := Some (Eliom_runtime.fragment "" 0 : $typ$ Eliom_client_value.t); - match ! $lid:gen_tid $ with - | Some x -> (x : _ Eliom_client_value.t) - | None -> assert false - end >> - - let shared_value_expr typ _ orig_expr gen_id gen_tid loc = - push_typing_str_item orig_expr gen_tid; - let typ = match typ with - | Some typ -> typ - | None -> let _loc = Loc.ghost in <:ctyp< _ >> - in - let _loc = loc in - <:expr< - Eliom_shared.Value.create $orig_expr$ - begin - $flush_typing_expr ()$; - $lid:gen_tid$ := - Some (Eliom_runtime.fragment "" 0 : - $typ$ Eliom_client_value.t); - match ! $lid:gen_tid $ with - | Some x -> x - | None -> assert false - end >> - - let escape_inject context_level ?ident orig_expr gen_id = - let open Pa_eliom_seed in - push_typing_str_item orig_expr gen_id; - push_typing_expr orig_expr gen_id; - match context_level with - | Escaped_in_shared_value_in _ -> - orig_expr - | Escaped_in_client_value_in _ -> - let _loc = Ast.loc_of_expr orig_expr in - <:expr< >> - | Injected_in `Shared -> - orig_expr - | Injected_in `Client -> - let _loc = Ast.loc_of_expr orig_expr in - <:expr< >> - - let implem loc sil = - let _loc = Loc.ghost in - let debug_compilation_unit_name = - let name = Printf.sprintf "__eliom__compilation_unit_id__%s" - (Helpers.file_hash loc) in - <:str_item< let $lid:name$ = () >> - in - debug_compilation_unit_name :: sil - - let shared_sig_items _ _ = let _loc = Loc.ghost in <:sig_item< >> - let server_sig_items _ _ = let _loc = Loc.ghost in <:sig_item< >> - let client_sig_items _ _ = let _loc = Loc.ghost in <:sig_item< >> - -end - -module M = Pa_eliom_seed.Register(Id)(Type_pass) From af90858877f20e31a62902363d11b0f05adbb383 Mon Sep 17 00:00:00 2001 From: Drup Date: Thu, 15 Dec 2016 19:35:41 +0100 Subject: [PATCH 13/23] Move eliommod_parameters to the main dir. --- .../eliommod_parameters.ml => eliommod_parameters.client.ml} | 0 .../eliommod_parameters.ml => eliommod_parameters.server.ml} | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename src/lib/{client/eliommod_parameters.ml => eliommod_parameters.client.ml} (100%) rename src/lib/{server/eliommod_parameters.ml => eliommod_parameters.server.ml} (100%) diff --git a/src/lib/client/eliommod_parameters.ml b/src/lib/eliommod_parameters.client.ml similarity index 100% rename from src/lib/client/eliommod_parameters.ml rename to src/lib/eliommod_parameters.client.ml diff --git a/src/lib/server/eliommod_parameters.ml b/src/lib/eliommod_parameters.server.ml similarity index 100% rename from src/lib/server/eliommod_parameters.ml rename to src/lib/eliommod_parameters.server.ml From 8343aaa88b0a8bd0872e403686cd4d9c4ee418c6 Mon Sep 17 00:00:00 2001 From: Drup Date: Thu, 15 Dec 2016 19:36:34 +0100 Subject: [PATCH 14/23] Add [@client] paremeters and avoid dep to the minimal runtime. --- src/_tags | 2 -- src/lib/eliom_client_value.client.ml | 2 +- src/lib/eliom_client_value.client.mli | 2 +- src/lib/eliom_client_value.server.ml | 2 +- src/lib/eliom_client_value.server.mli | 2 +- src/lib/eliom_runtime.client.ml | 2 ++ src/lib/eliom_runtime.client.mli | 2 ++ src/lib/eliom_runtime.server.ml | 1 + src/lib/eliom_runtime.server.mli | 2 ++ src/lib/eliom_serial.shared.ml | 2 +- src/lib/eliom_serial.shared.mli | 2 +- 11 files changed, 13 insertions(+), 8 deletions(-) diff --git a/src/_tags b/src/_tags index 73865a64e5..7e85dbcad0 100644 --- a/src/_tags +++ b/src/_tags @@ -20,9 +20,7 @@ true:keep_locs client-I(src/lib/client), server-I(src/lib/server), \ thread, \ package(lwt,lwt.ppx,react,tyxml.functor,js_of_ocaml.deriving.ppx), \ - server-package(eliomlang.runtime.server), \ server-package(lwt,ocsigenserver,ocsigenserver.ext), \ - client-package(eliomlang.runtime.client), \ package(js_of_ocaml.ppx), \ client-package(js_of_ocaml.log), \ client-package(ocsigenserver.cookies,ocsigenserver.polytables,ocsigenserver.baselib.base), \ diff --git a/src/lib/eliom_client_value.client.ml b/src/lib/eliom_client_value.client.ml index daf8b14426..dc20883541 100644 --- a/src/lib/eliom_client_value.client.ml +++ b/src/lib/eliom_client_value.client.ml @@ -20,7 +20,7 @@ exception False exception Exception_on_server of string -type 'a t = 'a +type ('a[@client]) t = 'a type injection_datum = Eliom_serial.injection_datum diff --git a/src/lib/eliom_client_value.client.mli b/src/lib/eliom_client_value.client.mli index 4f6df55afd..db546d1857 100644 --- a/src/lib/eliom_client_value.client.mli +++ b/src/lib/eliom_client_value.client.mli @@ -25,7 +25,7 @@ (** An ['a] client value on the client is just an ['a]. See also {% <> %}. *) -type 'a t = 'a +type ('a[@client]) t = 'a (** This exception is raised (in Lwt) on the client if a call to a server function {% < Eliom_serial.escaped_value + +type ('a[@client]) fragment = 'a Eliom_client_value.t diff --git a/src/lib/eliom_serial.shared.ml b/src/lib/eliom_serial.shared.ml index 8f35d39294..1cf465f75a 100644 --- a/src/lib/eliom_serial.shared.ml +++ b/src/lib/eliom_serial.shared.ml @@ -27,7 +27,7 @@ module Client_value_server_repr = struct instance_id: int; unwrapper: Eliom_wrap.unwrapper } - type 'a t = u + type ('a[@client]) t = u let create ?loc ~instance_id ~unwrapper = { instance_id; loc; unwrapper } let instance_id cv = cv.instance_id diff --git a/src/lib/eliom_serial.shared.mli b/src/lib/eliom_serial.shared.mli index c5de87683d..6796b640f8 100644 --- a/src/lib/eliom_serial.shared.mli +++ b/src/lib/eliom_serial.shared.mli @@ -26,7 +26,7 @@ {% <> %}. *) module Client_value_server_repr : sig - type +'a t + type (+'a[@client]) t (** instance_id is zero for local client values, unique for global client values *) From 4bf9171b7128c6e473d708033898c3568caf92d4 Mon Sep 17 00:00:00 2001 From: Drup Date: Sun, 1 Jan 2017 19:13:17 +0100 Subject: [PATCH 15/23] Add a special hook to build the runtime before any .eliom file. --- build/build.ml | 6 +++++- src/ocamlbuild/ocamlbuild_eliom.ml | 15 +++++++++------ src/ocamlbuild/ocamlbuild_eliom.mli | 6 ++++++ 3 files changed, 20 insertions(+), 7 deletions(-) diff --git a/build/build.ml b/build/build.ml index 2fd8115770..5b64780b40 100644 --- a/build/build.ml +++ b/build/build.ml @@ -2,7 +2,11 @@ open Ocamlbuild_plugin module Pack = Ocamlbuild_pack let _ = dispatch (fun x -> - Ocamlbuild_eliom.dispatcher x; + let runtime = + expand_module ["src/lib"] "Eliom_runtime" + ["server.cmo"; "server.cmi" ; "client.cmo"; "client.cmi"] + in + Ocamlbuild_eliom.dispatcher ~runtime x; match x with | After_rules -> Doc.init (); diff --git a/src/ocamlbuild/ocamlbuild_eliom.ml b/src/ocamlbuild/ocamlbuild_eliom.ml index 240aa4d902..f8fdd54ca2 100644 --- a/src/ocamlbuild/ocamlbuild_eliom.ml +++ b/src/ocamlbuild/ocamlbuild_eliom.ml @@ -10,8 +10,7 @@ let copy_rule name src prod = Pack.Shell.mkdir_p (Filename.dirname prod); cp src prod ) - -let init () = +let init ?runtime () = let module Eliom_rules = struct open Pack ;; @@ -176,6 +175,10 @@ List.iter (fun tags -> (* pflag [ "ocaml"; "infer_interface"] "client-I" (fun x -> S[A"-client-I"; A x]);; *) (* pflag [ "ocaml"; "doc"] "client-I" (fun x -> S[A"-client-I"; A x]);; *) +begin match runtime with + | Some l -> dep ["extension:eliom"] l + | None -> () +end ; copy_rule "shared.ml -> client.ml" "%(path)/%(file).shared.ml" "%(path)/%(file).client.ml";; @@ -189,10 +192,10 @@ copy_rule "shared.mli -> server.mli" end in () -let init = function - | After_rules -> init () ; +let init ?runtime = function + | After_rules -> init ?runtime () ; | _ -> () -let dispatcher ?oasis_executables hook = +let dispatcher ?runtime ?oasis_executables hook = Ocamlbuild_js_of_ocaml.dispatcher ?oasis_executables hook; - init hook + init ?runtime hook diff --git a/src/ocamlbuild/ocamlbuild_eliom.mli b/src/ocamlbuild/ocamlbuild_eliom.mli index e9a4d832fa..accbf30060 100644 --- a/src/ocamlbuild/ocamlbuild_eliom.mli +++ b/src/ocamlbuild/ocamlbuild_eliom.mli @@ -22,8 +22,14 @@ Side note: {!Ocamlbuild_plugin.dispatch} should be used only once as it record only one function for an ocamlbuild module. + + [?runtime] allows to use a custom version of the eliom runtime. + Typically used with + [expand_module ["src"] "Eliom_runtime" + ["server.cmo"; "server.cmi" ; "client.cmo"; "client.cmi"]] *) val dispatcher : + ?runtime:Ocamlbuild_plugin.Pathname.t list -> ?oasis_executables:Ocamlbuild_plugin.Pathname.t list -> Ocamlbuild_plugin.hook -> unit From 529df503456376495b5bf850608a1f506c16735a Mon Sep 17 00:00:00 2001 From: Drup Date: Sun, 1 Jan 2017 19:14:11 +0100 Subject: [PATCH 16/23] Small cleanup of build stuff. --- src/_tags | 1 - src/ocamlbuild/ocamlbuild_eliom.ml | 11 ++--------- 2 files changed, 2 insertions(+), 10 deletions(-) diff --git a/src/_tags b/src/_tags index 7e85dbcad0..d5c2dd694b 100644 --- a/src/_tags +++ b/src/_tags @@ -17,7 +17,6 @@ true:keep_locs "lib":include : \ - client-I(src/lib/client), server-I(src/lib/server), \ thread, \ package(lwt,lwt.ppx,react,tyxml.functor,js_of_ocaml.deriving.ppx), \ server-package(lwt,ocsigenserver,ocsigenserver.ext), \ diff --git a/src/ocamlbuild/ocamlbuild_eliom.ml b/src/ocamlbuild/ocamlbuild_eliom.ml index f8fdd54ca2..e64bf48986 100644 --- a/src/ocamlbuild/ocamlbuild_eliom.ml +++ b/src/ocamlbuild/ocamlbuild_eliom.ml @@ -1,15 +1,8 @@ +[@@@ocaml.warning "-29"] + open Ocamlbuild_plugin module Pack = Ocamlbuild_pack -let copy_rule name src prod = - rule name ~dep:src ~prod - (fun env _ -> - let prod = env prod in - let src = env src in - (* f env (Pathname.dirname prod) (Pathname.basename prod) src prod; *) - Pack.Shell.mkdir_p (Filename.dirname prod); - cp src prod - ) let init ?runtime () = let module Eliom_rules = struct open Pack ;; From 87d7a90bed53846b75945d7d852c38ca02846fff Mon Sep 17 00:00:00 2001 From: Drup Date: Sun, 1 Jan 2017 19:15:29 +0100 Subject: [PATCH 17/23] Add new rules for .client/server.cmi files alone. --- src/ocamlbuild/ocamlbuild_eliom.ml | 33 ++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/src/ocamlbuild/ocamlbuild_eliom.ml b/src/ocamlbuild/ocamlbuild_eliom.ml index e64bf48986..f713a897a1 100644 --- a/src/ocamlbuild/ocamlbuild_eliom.ml +++ b/src/ocamlbuild/ocamlbuild_eliom.ml @@ -119,14 +119,47 @@ rule "eliom: eliom & eliom.depends & *cmi -> .inferred.eliomi" declarations in foo.eliom, as obtained by direct invocation of `ocamlc -i`." (Ocaml_tools.infer_interface "%.eliom" "%.inferred.eliomi");; + +(* TODO + This set of rule make incremental compilation of ocamlbuild very confused +*) + rule "eliom: {server,client}.cmi -> cmi" + ~insert:`top ~prod:"%(name:<*> and not <*.client> and not <*.server>).cmi" ~deps:["%(name).client.cmi";"%(name).server.cmi"] + ~stamp:"%(name).cmi.stamp" (fun _ _ -> Nop);; rule "eliom: {server,client}.cmi -> cmi | in subdir" + ~insert:`top ~prod:"%(name:<**/*> and not <**/*.client> and not <**/*.server>).cmi" ~deps:["%(name).client.cmi";"%(name).server.cmi"] + ~stamp:"%(name).cmi.stamp" + (fun _ _ -> Nop);; + +rule "eliom: server.cmi -> cmi" + ~prod:"%(name:<*> and not <*.client> and not <*.server>).cmi" + ~deps:["%(name).server.cmi"] + ~stamp:"%(name).cmi.stamp" + (fun _ _ -> Nop);; + +rule "eliom: server.cmi -> cmi | in subdir" + ~prod:"%(name:<**/*> and not <**/*.client> and not <**/*.server>).cmi" + ~deps:["%(name).server.cmi"] + ~stamp:"%(name).cmi.stamp" + (fun _ _ -> Nop);; + +rule "eliom: client.cmi -> cmi" + ~prod:"%(name:<*> and not <*.client> and not <*.server>).cmi" + ~deps:["%(name).client.cmi"] + ~stamp:"%(name).cmi.stamp" + (fun _ _ -> Nop);; + +rule "eliom: client.cmi -> cmi | in subdir" + ~prod:"%(name:<**/*> and not <**/*.client> and not <**/*.server>).cmi" + ~deps:["%(name).client.cmi"] + ~stamp:"%(name).cmi.stamp" (fun _ _ -> Nop);; let compile_tags = [ From 91249d0723aa1d41270200a55a6b28e120b129d5 Mon Sep 17 00:00:00 2001 From: Drup Date: Sun, 1 Jan 2017 19:17:15 +0100 Subject: [PATCH 18/23] Replace some .ml files by eliom files. --- ...ontent.client.mli => eliom_content.eliomi} | 478 ++++++++++++++++- src/lib/eliom_content.server.mli | 492 ------------------ ...gs.shared.mli => eliom_shared_sigs.eliomi} | 0 3 files changed, 475 insertions(+), 495 deletions(-) rename src/lib/{eliom_content.client.mli => eliom_content.eliomi} (67%) delete mode 100644 src/lib/eliom_content.server.mli rename src/lib/{eliom_shared_sigs.shared.mli => eliom_shared_sigs.eliomi} (100%) diff --git a/src/lib/eliom_content.client.mli b/src/lib/eliom_content.eliomi similarity index 67% rename from src/lib/eliom_content.client.mli rename to src/lib/eliom_content.eliomi index 287190c4a8..438272c0cc 100644 --- a/src/lib/eliom_content.client.mli +++ b/src/lib/eliom_content.eliomi @@ -17,9 +17,6 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* ocamldoc/camlp4 hack ? : need an open first ? *) -open Eliom_lib - (** This module provides the creation of valid XML content, i.e. XML, SVG, and (X)HTML5. @@ -32,6 +29,8 @@ open Eliom_lib *) +[%%client.start] + (** Low-level XML manipulation. *) module Xml : module type of Eliom_content_core.Xml @@ -900,3 +899,476 @@ val wrap_client_fun : The default handler throws an exception (via [Lwt.fail_with]). *) val set_form_error_handler : (unit -> bool Lwt.t) -> unit + + +[%%server.start] +(** + XML tree manipulation within Eliom is based on the TyXML library + but Eliom is using a custom representation for XML values (see + {!Xml}). Then, [Eliom_content] redefines the two high level + interfaces ({!Svg}, {!Html}) that are provided by + TyXML for valid XML tree creation and printing. + + - If you want to generate typed HTML, use {!Eliom_content.Html}, + - If you want to write untyped html, use {!Eliom_content.Html_text}, + - If you want to generate typed svg, use {!Eliom_content.Svg}. + + Modules {!Eliom_content.Html}, {!Eliom_content.Svg} contain two + sub-modules: {!Eliom_content.Html.F}, {!Eliom_content.Html.D} + corresponding to tow different semantics. + They also contain a module {!Eliom_content.Html.C} that allows to + inject client-side content into server-side content. + + {5 Functional semantics} + + The [F] modules provides functions to create elements with {e f}unctional + semantics: they are standard OCaml values. + + Use this module: + - if your application does not have a client-side part + (server-side generated Web site) + - or if the client-side is not written with Eliom, + - or if you do not need to use this node from the client-side program + (no injection [%n] on this node) + and want to avoid the extra attributes added by module [D]. + + If you use a [F]-node [n] in an injection ([%n]), + it is considered as any OCaml value, NOT precisely the copy you (possibly) + inserted in the page. For example, [To_dom.of_element %n] will not refer + to the element in the page, but create a new DOM node. + + + {5 DOM semantics} + + The [D] module provides functions to create elements with {e D}OM semantics: + Firstly, they behave like DOM nodes, e.g. they can only be added once to the + DOM tree even when appended several times. + Secondly, those values have an identifier, + which means they can be referred to + on client side (by [%variable]) or used with the functions in + {% <> %} and + {% <> %}. + + In case of doubt, always use [D]-nodes when you are writing a + client-server Eliom app. You can also mix F-nodes and D-nodes. + + {5 Client-side value injection} + + The [C] modules provides functions to inject client-side elements and attributes + into server-side content. + + {b Please read + {% <>%} + to learn how to generate HTML. } + + *) + +(** Low-level XML manipulation. *) +module Xml : sig + + (** {2 Base functions} + See {% <> %}. *) + + include Xml_sigs.Iterable + with type 'a wrap = 'a + and type 'a list_wrap = 'a list + and type event_handler = + (Dom_html.event Js.t -> unit) Eliom_client_value.t + and type mouse_event_handler = + (Dom_html.mouseEvent Js.t -> unit) Eliom_client_value.t + and type keyboard_event_handler = + (Dom_html.keyboardEvent Js.t -> unit) Eliom_client_value.t + + (** {2 Unique nodes } *) + + (** Unique nodes are XML nodes that are manipulated 'by reference' + when sent to the client part of an Eliom-application: the + created element is allocated only one time in each instance of + an application. See {% <>%} for more + details. *) + + (** {2 Event handlers } *) + + (** Values of type [caml_event_handler] represents event handler + build with the [{{ ... }}] syntax (see the Eliom manual for more + information on {% <>%}). Such values are + expected by functions like {!Eliom_content.Html.a_onclick}. *) + type caml_event_handler + + (**/**) + + val make_process_node : ?id:string -> elt -> elt + val make_request_node : ?reset:bool -> elt -> elt + + val uri_of_fun: (unit -> string) -> uri + + (* Concrete on client-side only. *) + type node_id + val get_node_id : elt -> node_id + val make_event_handler_table : elt -> Eliom_serial.RawXML.event_handler_table + val make_client_attrib_table : elt -> Eliom_serial.RawXML.client_attrib_table + + val caml_event_handler : + (Dom_html.event Js.t -> unit) Eliom_client_value.t -> + caml_event_handler + + type racontent = + | RA of acontent + | RAReact of acontent option React.signal + | RACamlEventHandler of caml_event_handler + | RALazyStr of string Eliom_lazy.request + | RALazyStrL of separator * string Eliom_lazy.request list + | RAClient of string * attrib option * Eliom_lib.poly + (* attrib client_value *) + val racontent : attrib -> racontent + + val lazy_node : ?a:(attrib list) -> ename -> elt list Eliom_lazy.request -> elt + + (**/**) + + (** [Eliom_content.Xml.wrap page v] is like [Eliom_wrap.wrap v] but + it makes sure that all [elt]s in [v] which are included in + [page] are sent with empty content. This is safe because such + elements will be taken from the DOM on the client either + ways. *) + val wrap : elt -> 'a -> 'a Eliom_wrap.wrapped_value + +end + +module Xml_shared : Xml_sigs.T + with type 'a W.t = 'a Eliom_shared.React.S.t + and type 'a W.tlist = 'a Eliom_shared.ReactiveData.RList.t + and type event_handler = + (Dom_html.event Js.t -> unit) Eliom_client_value.t + and type mouse_event_handler = + (Dom_html.mouseEvent Js.t -> unit) Eliom_client_value.t + and type keyboard_event_handler = + (Dom_html.keyboardEvent Js.t -> unit) Eliom_client_value.t + +(** Building and pretty-printing valid SVG tree. +Information about Svg api can be found at {% <> %}*) +module Svg : sig + + (** See the Eliom manual for more information on{% <> %} for SVG tree manipulated by client/server + application. *) + + type +'a elt + type +'a attrib + type 'a wrap = 'a + type 'a list_wrap = 'a list + type uri = Xml.uri + + (** Typed interface for building valid SVG tree (functional + semantics). See {% <> %}. *) + module F : sig + + (** See {% <> %}. *) + module Raw : Svg_sigs.Make(Xml).T + with type +'a elt = 'a elt + and type +'a attrib = 'a attrib + + include module type of Raw + + end + + (** Typed interface for building valid SVG tree (DOM semantics). See + {% <> %}. *) + module D : sig + + (** See {% <> %}. *) + module Raw : Svg_sigs.Make(Xml).T + with type +'a elt = 'a elt + and type +'a attrib = 'a attrib + + include module type of Raw + + end + + (** Creation of SVG content from shared reactive signals and data + ({% <> %}). + For the operations provided, see + {% <> %}. *) + module R : sig + + module Raw : Svg_sigs.Make(Xml_shared).T + with type 'a elt = 'a elt + and type 'a attrib = 'a attrib + + include module type of Raw + + (** [pcdata] is not implemented reactively for SVG. *) + val pcdata : string Xml.W.t -> [> `Unimplemented ] + + (** [node s] produces an ['a elt] out of the shared reactive + signal [s]. *) + val node : 'a elt Eliom_shared.React.S.t -> 'a elt + + end + + (** Creation of content from client-side values. This makes + possible to insert in server side generated pages some nodes + that will be computed on client side (for example reactive + nodes). *) + module C : sig + + val node : ?init:'a elt -> 'a Html.elt Eliom_client_value.t -> 'a elt + (** [node e] is a server-side node corresponding to the + client-side node [e] . [node e] can be used like any other + server-side node. + + The implementation uses an initial placeholder node that is + later replaced by the client node. By default, the placeholder + node is [span]. The [~init] argument can be used to provide a + custom placeholder node (e.g., one with the same tag as the + client node). This can be useful in contexts where [span] is + not allowed. *) + + val attr : ?init:'a attrib -> 'a Html.attrib Eliom_client_value.t -> 'a attrib + + end + + (** Node identifiers. *) + module Id : sig + + (** The type of global SVG element identifier. *) + type +'a id + + (** The function [new_elt_id ()] creates a new HTML5 element + identifier. (see the Eliom manual for more information on {% + <>%}).*) + val new_elt_id: ?global:bool -> unit -> 'a id + + (** The function [create_named_elt ~id elt] create a copy of the + element [elt] that will be accessible through the name [id]. *) + val create_named_elt: id:'a id -> 'a elt -> 'a elt + + (** The function [create_named_elt elt] is equivalent to + [create_named_elt ~id:(new_elt_id ()) elt]. *) + val create_global_elt: 'a elt -> 'a elt + + (** [create_request_elt ?reset elt] creates a referable copy of + [elt]. If [~reset = true] is provided (default: false), a new + ID is created even if [elt] has an ID already. *) + val create_request_elt: ?reset:bool -> 'a elt -> 'a elt + + end + + (** SVG printer. See + {% <> %}. *) + module Printer : Xml_sigs.Typed_pp + with type +'a elt := 'a elt + and type doc := F.doc + +end + + + + + +(** Building and printing valid HTML5 tree. + Information about Html api can be found at + {% <> %} .*) +module Html : sig + + (** See {% <> %} in Eliom's manual + for HTML5 tree manipulated by client/server application. *) + + type +'a elt + type +'a attrib + type uri = Xml.uri + type 'a form_param + + (** Creation of {b F}unctional HTML5 content (copy-able but not + referable, see also {% <> %}). *) + module F : sig + + (** {2 Content creation} + + See {% <> %}. + If you want to create an untyped form, you will have to use {% + <> %} otherwise, use + Eliom form widgets. For more information, see + {{:http://ocsigen.org/howto/forms/}"how to make forms"} *) + + (** See {% <> %}. *) + module Raw : Html_sigs.Make(Xml)(Svg.F.Raw).T + with type +'a elt = 'a elt + and type +'a attrib = 'a attrib + + include module type of Raw + + include Eliom_content_sigs.LINKS_AND_FORMS + with type +'a elt := 'a elt + and type +'a attrib := 'a attrib + and type uri := uri + and type ('a, 'b, 'c) star := ('a, 'b, 'c) star + and type 'a form_param := 'a form_param + + end + + (** Creation of HTML content with {b D}OM semantics (referable, see + also {% <> %}). *) + module D : sig + + (** {2 Content creation} + + See {% <> %}. + If you want to create an untyped form, you will have to use {% + <> %} otherwise, use + Eliom form widgets. For more information, see + {{:http://ocsigen.org/howto/forms/}"how to make forms"} *) + + (** See {% <> %}. *) + module Raw : Html_sigs.Make(Xml)(Svg.D.Raw).T + with type +'a elt = 'a elt + and type +'a attrib = 'a attrib + + include module type of Raw + + include Eliom_content_sigs.LINKS_AND_FORMS + with type +'a elt := 'a elt + and type +'a attrib := 'a attrib + and type uri := uri + and type ('a, 'b, 'c) star := ('a, 'b, 'c) star + and type 'a form_param := 'a form_param + + end + + (** Creation of HTML content from client-side values. This makes + possible to insert in server side generated pages some nodes + that will be computed on client side (for example reactive + nodes). *) + module C : sig + + (** {2 Content injection} *) + + (** See Eliom manual for more detail on {% <>%}. *) + + (** [node e] is a server-side node corresponding to the + client-side node [e] . [node e] can be used like any other + server-side node. + + The implementation uses an initial placeholder node that is + later replaced by the client node. By default, the placeholder + node is [span]. The [~init] argument can be used to provide a + custom placeholder node (e.g., one with the same tag as the + client node). This can be useful in contexts where [span] is + not allowed. *) + val node : + ?init:'a elt -> 'a Html.elt Eliom_client_value.t -> 'a elt + + val attr : + ?init:'a attrib -> 'a Html.attrib Eliom_client_value.t -> 'a attrib + + end + + (** Node identifiers *) + module Id : sig + + (** The type of global HTML element identifier. *) + type +'a id + + (** The function [new_elt_id ()] creates a new global HTML element + identifier (see the Eliom manual for more information on {% + <>%}).*) + val new_elt_id: ?global:bool -> unit -> 'a id + + (** The function [create_named_elt ~id elt] create a copy of the + element [elt] that will be sent to client with the reference + [id]. *) + val create_named_elt: id:'a id -> 'a elt -> 'a elt + + (** The function [create_named_elt elt] is equivalent to + [create_named_elt ~id:(new_elt_id ()) elt]. *) + val create_global_elt: 'a elt -> 'a elt + + (** [create_request_elt ?reset elt] creates a referable copy of + [elt]. If [~reset = true] is provided (default: false), a new + ID is created even if [elt] has an ID already. *) + val create_request_elt: ?reset:bool -> 'a elt -> 'a elt + + (* XXX: This function must be hidden in documentation but hidden rest of + * file *) + val have_id: 'a id -> 'b elt -> bool + + end + + (** Creation of HTML content from shared reactive signals and data + ({% <> %}). + For the operations provided, see + {% <> %}. *) + module R : sig + + include Html_sigs.Make(Xml_shared)(Svg.R.Raw).T + with type 'a elt = 'a elt + and type 'a attrib = 'a attrib + + (** [pcdata s] produces a node of type + [\[> Html_types.span\] elt] + out of the string signal [s]. *) + val pcdata : + string Eliom_shared.React.S.t -> [> Html_types.span] elt + + (** [node s] produces an ['a elt] out of the shared reactive + signal [s]. *) + val node : 'a elt Eliom_shared.React.S.t -> 'a elt + + (** [filter_attrib a b] amounts to the attribute [a] while [b] is + [true], and to no attribute while [b] is [false]. *) + val filter_attrib : + 'a attrib -> bool Eliom_shared.React.S.t -> 'a attrib + + end + + (** Type-safe custom data for HTML. + See the {% <> %}. *) + module Custom_data : sig + + (** Custom data with values of type ['a]. *) + type 'a t + + (** Create a custom data field by providing string conversion functions. + If the [default] is provided, calls to {% <> %} return that instead of throwing an + exception [Not_found]. *) + val create : name:string -> ?default:'a -> to_string:('a -> string) -> of_string:(string -> 'a) -> unit -> 'a t + + (** Create a custom data from a Json-deriving type. *) + val create_json : name:string -> ?default:'a -> 'a Deriving_Json.t -> 'a t + + (** [attrib my_data value ] creates a HTML attribute for the custom-data + type [my_data] with value [value] for injecting it into an a HTML tree + ({% <> %}). *) + val attrib : 'a t -> 'a -> [> | `User_data ] attrib + + end + + (** {{:http://dev.w3.org/html5/html-xhtml-author-guide/}"Polyglot"} + HTML printer. See + {% <> %}. *) + module Printer : Xml_sigs.Typed_pp + with type +'a elt := 'a elt + and type doc := F.doc + +end + +(**/**) + +val set_client_fun : + ?app:string -> + service:('a, 'b, _, _, _, _, _, _, _, _, _) Eliom_service.t -> + ('a -> 'b -> unit Lwt.t) Eliom_client_value.t -> + unit diff --git a/src/lib/eliom_content.server.mli b/src/lib/eliom_content.server.mli deleted file mode 100644 index dba7ef08c2..0000000000 --- a/src/lib/eliom_content.server.mli +++ /dev/null @@ -1,492 +0,0 @@ -(* Ocsigen - * http://www.ocsigen.org - * Copyright (C) 2012 Vincent Balat, Benedikt Becker - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, with linking exception; - * either version 2.1 of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - *) - -(** This module allows creating valid HTML content, or other XML formats. *) - - -(** - XML tree manipulation within Eliom is based on the TyXML library - but Eliom is using a custom representation for XML values (see - {!Xml}). Then, [Eliom_content] redefines the two high level - interfaces ({!Svg}, {!Html}) that are provided by - TyXML for valid XML tree creation and printing. - - - If you want to generate typed HTML, use {!Eliom_content.Html}, - - If you want to write untyped html, use {!Eliom_content.Html_text}, - - If you want to generate typed svg, use {!Eliom_content.Svg}. - - Modules {!Eliom_content.Html}, {!Eliom_content.Svg} contain two - sub-modules: {!Eliom_content.Html.F}, {!Eliom_content.Html.D} - corresponding to tow different semantics. - They also contain a module {!Eliom_content.Html.C} that allows to - inject client-side content into server-side content. - - {5 Functional semantics} - - The [F] modules provides functions to create elements with {e f}unctional - semantics: they are standard OCaml values. - - Use this module: - - if your application does not have a client-side part - (server-side generated Web site) - - or if the client-side is not written with Eliom, - - or if you do not need to use this node from the client-side program - (no injection [%n] on this node) - and want to avoid the extra attributes added by module [D]. - - If you use a [F]-node [n] in an injection ([%n]), - it is considered as any OCaml value, NOT precisely the copy you (possibly) - inserted in the page. For example, [To_dom.of_element %n] will not refer - to the element in the page, but create a new DOM node. - - - {5 DOM semantics} - - The [D] module provides functions to create elements with {e D}OM semantics: - Firstly, they behave like DOM nodes, e.g. they can only be added once to the - DOM tree even when appended several times. - Secondly, those values have an identifier, - which means they can be referred to - on client side (by [%variable]) or used with the functions in - {% <> %} and - {% <> %}. - - In case of doubt, always use [D]-nodes when you are writing a - client-server Eliom app. You can also mix F-nodes and D-nodes. - - {5 Client-side value injection} - - The [C] modules provides functions to inject client-side elements and attributes - into server-side content. - - {b Please read - {% <>%} - to learn how to generate HTML. } - - *) - -(** Low-level XML manipulation. *) -module Xml : sig - - (** {2 Base functions} - See {% <> %}. *) - - include Xml_sigs.Iterable - with type 'a wrap = 'a - and type 'a list_wrap = 'a list - and type event_handler = - (Dom_html.event Js.t -> unit) Eliom_client_value.t - and type mouse_event_handler = - (Dom_html.mouseEvent Js.t -> unit) Eliom_client_value.t - and type keyboard_event_handler = - (Dom_html.keyboardEvent Js.t -> unit) Eliom_client_value.t - - (** {2 Unique nodes } *) - - (** Unique nodes are XML nodes that are manipulated 'by reference' - when sent to the client part of an Eliom-application: the - created element is allocated only one time in each instance of - an application. See {% <>%} for more - details. *) - - (** {2 Event handlers } *) - - (** Values of type [caml_event_handler] represents event handler - build with the [{{ ... }}] syntax (see the Eliom manual for more - information on {% <>%}). Such values are - expected by functions like {!Eliom_content.Html.a_onclick}. *) - type caml_event_handler - - (**/**) - - val make_process_node : ?id:string -> elt -> elt - val make_request_node : ?reset:bool -> elt -> elt - - val uri_of_fun: (unit -> string) -> uri - - (* Concrete on client-side only. *) - type node_id - val get_node_id : elt -> node_id - val make_event_handler_table : elt -> Eliom_serial.RawXML.event_handler_table - val make_client_attrib_table : elt -> Eliom_serial.RawXML.client_attrib_table - - val caml_event_handler : - (Dom_html.event Js.t -> unit) Eliom_client_value.t -> - caml_event_handler - - type racontent = - | RA of acontent - | RAReact of acontent option React.signal - | RACamlEventHandler of caml_event_handler - | RALazyStr of string Eliom_lazy.request - | RALazyStrL of separator * string Eliom_lazy.request list - | RAClient of string * attrib option * Eliom_lib.poly - (* attrib client_value *) - val racontent : attrib -> racontent - - val lazy_node : ?a:(attrib list) -> ename -> elt list Eliom_lazy.request -> elt - - (**/**) - - (** [Eliom_content.Xml.wrap page v] is like [Eliom_wrap.wrap v] but - it makes sure that all [elt]s in [v] which are included in - [page] are sent with empty content. This is safe because such - elements will be taken from the DOM on the client either - ways. *) - val wrap : elt -> 'a -> 'a Eliom_wrap.wrapped_value - -end - -module Xml_shared : Xml_sigs.T - with type 'a W.t = 'a Eliom_shared.React.S.t - and type 'a W.tlist = 'a Eliom_shared.ReactiveData.RList.t - and type event_handler = - (Dom_html.event Js.t -> unit) Eliom_client_value.t - and type mouse_event_handler = - (Dom_html.mouseEvent Js.t -> unit) Eliom_client_value.t - and type keyboard_event_handler = - (Dom_html.keyboardEvent Js.t -> unit) Eliom_client_value.t - -(** Building and pretty-printing valid SVG tree. -Information about Svg api can be found at {% <> %}*) -module Svg : sig - - (** See the Eliom manual for more information on{% <> %} for SVG tree manipulated by client/server - application. *) - - type +'a elt - type +'a attrib - type 'a wrap = 'a - type 'a list_wrap = 'a list - type uri = Xml.uri - - (** Typed interface for building valid SVG tree (functional - semantics). See {% <> %}. *) - module F : sig - - (** See {% <> %}. *) - module Raw : Svg_sigs.Make(Xml).T - with type +'a elt = 'a elt - and type +'a attrib = 'a attrib - - include module type of Raw - - end - - (** Typed interface for building valid SVG tree (DOM semantics). See - {% <> %}. *) - module D : sig - - (** See {% <> %}. *) - module Raw : Svg_sigs.Make(Xml).T - with type +'a elt = 'a elt - and type +'a attrib = 'a attrib - - include module type of Raw - - end - - (** Creation of SVG content from shared reactive signals and data - ({% <> %}). - For the operations provided, see - {% <> %}. *) - module R : sig - - module Raw : Svg_sigs.Make(Xml_shared).T - with type 'a elt = 'a elt - and type 'a attrib = 'a attrib - - include module type of Raw - - (** [pcdata] is not implemented reactively for SVG. *) - val pcdata : string Xml.W.t -> [> `Unimplemented ] - - (** [node s] produces an ['a elt] out of the shared reactive - signal [s]. *) - val node : 'a elt Eliom_shared.React.S.t -> 'a elt - - end - - (** Creation of content from client-side values. This makes - possible to insert in server side generated pages some nodes - that will be computed on client side (for example reactive - nodes). *) - module C : sig - - val node : ?init:'a elt -> 'a elt Eliom_client_value.t -> 'a elt - (** [node e] is a server-side node corresponding to the - client-side node [e] . [node e] can be used like any other - server-side node. - - The implementation uses an initial placeholder node that is - later replaced by the client node. By default, the placeholder - node is [span]. The [~init] argument can be used to provide a - custom placeholder node (e.g., one with the same tag as the - client node). This can be useful in contexts where [span] is - not allowed. *) - - val attr : ?init:'a attrib -> 'a attrib Eliom_client_value.t -> 'a attrib - - end - - (** Node identifiers. *) - module Id : sig - - (** The type of global SVG element identifier. *) - type +'a id - - (** The function [new_elt_id ()] creates a new HTML5 element - identifier. (see the Eliom manual for more information on {% - <>%}).*) - val new_elt_id: ?global:bool -> unit -> 'a id - - (** The function [create_named_elt ~id elt] create a copy of the - element [elt] that will be accessible through the name [id]. *) - val create_named_elt: id:'a id -> 'a elt -> 'a elt - - (** The function [create_named_elt elt] is equivalent to - [create_named_elt ~id:(new_elt_id ()) elt]. *) - val create_global_elt: 'a elt -> 'a elt - - (** [create_request_elt ?reset elt] creates a referable copy of - [elt]. If [~reset = true] is provided (default: false), a new - ID is created even if [elt] has an ID already. *) - val create_request_elt: ?reset:bool -> 'a elt -> 'a elt - - end - - (** SVG printer. See - {% <> %}. *) - module Printer : Xml_sigs.Typed_pp - with type +'a elt := 'a elt - and type doc := F.doc - -end - - - - - -(** Building and printing valid HTML5 tree. - Information about Html api can be found at - {% <> %} .*) -module Html : sig - - (** See {% <> %} in Eliom's manual - for HTML5 tree manipulated by client/server application. *) - - type +'a elt - type +'a attrib - type uri = Xml.uri - type 'a form_param - - (** Creation of {b F}unctional HTML5 content (copy-able but not - referable, see also {% <> %}). *) - module F : sig - - (** {2 Content creation} - - See {% <> %}. - If you want to create an untyped form, you will have to use {% - <> %} otherwise, use - Eliom form widgets. For more information, see - {{:http://ocsigen.org/howto/forms/}"how to make forms"} *) - - (** See {% <> %}. *) - module Raw : Html_sigs.Make(Xml)(Svg.F.Raw).T - with type +'a elt = 'a elt - and type +'a attrib = 'a attrib - - include module type of Raw - - include Eliom_content_sigs.LINKS_AND_FORMS - with type +'a elt := 'a elt - and type +'a attrib := 'a attrib - and type uri := uri - and type ('a, 'b, 'c) star := ('a, 'b, 'c) star - and type 'a form_param := 'a form_param - - end - - (** Creation of HTML content with {b D}OM semantics (referable, see - also {% <> %}). *) - module D : sig - - (** {2 Content creation} - - See {% <> %}. - If you want to create an untyped form, you will have to use {% - <> %} otherwise, use - Eliom form widgets. For more information, see - {{:http://ocsigen.org/howto/forms/}"how to make forms"} *) - - (** See {% <> %}. *) - module Raw : Html_sigs.Make(Xml)(Svg.D.Raw).T - with type +'a elt = 'a elt - and type +'a attrib = 'a attrib - - include module type of Raw - - include Eliom_content_sigs.LINKS_AND_FORMS - with type +'a elt := 'a elt - and type +'a attrib := 'a attrib - and type uri := uri - and type ('a, 'b, 'c) star := ('a, 'b, 'c) star - and type 'a form_param := 'a form_param - - end - - (** Creation of HTML content from client-side values. This makes - possible to insert in server side generated pages some nodes - that will be computed on client side (for example reactive - nodes). *) - module C : sig - - (** {2 Content injection} *) - - (** See Eliom manual for more detail on {% <>%}. *) - - (** [node e] is a server-side node corresponding to the - client-side node [e] . [node e] can be used like any other - server-side node. - - The implementation uses an initial placeholder node that is - later replaced by the client node. By default, the placeholder - node is [span]. The [~init] argument can be used to provide a - custom placeholder node (e.g., one with the same tag as the - client node). This can be useful in contexts where [span] is - not allowed. *) - val node : - ?init:'a elt -> 'a elt Eliom_client_value.t -> 'a elt - - val attr : - ?init:'a attrib -> 'a attrib Eliom_client_value.t -> 'a attrib - - end - - (** Node identifiers *) - module Id : sig - - (** The type of global HTML element identifier. *) - type +'a id - - (** The function [new_elt_id ()] creates a new global HTML element - identifier (see the Eliom manual for more information on {% - <>%}).*) - val new_elt_id: ?global:bool -> unit -> 'a id - - (** The function [create_named_elt ~id elt] create a copy of the - element [elt] that will be sent to client with the reference - [id]. *) - val create_named_elt: id:'a id -> 'a elt -> 'a elt - - (** The function [create_named_elt elt] is equivalent to - [create_named_elt ~id:(new_elt_id ()) elt]. *) - val create_global_elt: 'a elt -> 'a elt - - (** [create_request_elt ?reset elt] creates a referable copy of - [elt]. If [~reset = true] is provided (default: false), a new - ID is created even if [elt] has an ID already. *) - val create_request_elt: ?reset:bool -> 'a elt -> 'a elt - - (* XXX: This function must be hidden in documentation but hidden rest of - * file *) - val have_id: 'a id -> 'b elt -> bool - - end - - (** Creation of HTML content from shared reactive signals and data - ({% <> %}). - For the operations provided, see - {% <> %}. *) - module R : sig - - include Html_sigs.Make(Xml_shared)(Svg.R.Raw).T - with type 'a elt = 'a elt - and type 'a attrib = 'a attrib - - (** [pcdata s] produces a node of type - [\[> Html_types.span\] elt] - out of the string signal [s]. *) - val pcdata : - string Eliom_shared.React.S.t -> [> Html_types.span] elt - - (** [node s] produces an ['a elt] out of the shared reactive - signal [s]. *) - val node : 'a elt Eliom_shared.React.S.t -> 'a elt - - (** [filter_attrib a b] amounts to the attribute [a] while [b] is - [true], and to no attribute while [b] is [false]. *) - val filter_attrib : - 'a attrib -> bool Eliom_shared.React.S.t -> 'a attrib - - end - - (** Type-safe custom data for HTML. - See the {% <> %}. *) - module Custom_data : sig - - (** Custom data with values of type ['a]. *) - type 'a t - - (** Create a custom data field by providing string conversion functions. - If the [default] is provided, calls to {% <> %} return that instead of throwing an - exception [Not_found]. *) - val create : name:string -> ?default:'a -> to_string:('a -> string) -> of_string:(string -> 'a) -> unit -> 'a t - - (** Create a custom data from a Json-deriving type. *) - val create_json : name:string -> ?default:'a -> 'a Deriving_Json.t -> 'a t - - (** [attrib my_data value ] creates a HTML attribute for the custom-data - type [my_data] with value [value] for injecting it into an a HTML tree - ({% <> %}). *) - val attrib : 'a t -> 'a -> [> | `User_data ] attrib - - end - - (** {{:http://dev.w3.org/html5/html-xhtml-author-guide/}"Polyglot"} - HTML printer. See - {% <> %}. *) - module Printer : Xml_sigs.Typed_pp - with type +'a elt := 'a elt - and type doc := F.doc - -end - -(**/**) - -val set_client_fun : - ?app:string -> - service:('a, 'b, _, _, _, _, _, _, _, _, _) Eliom_service.t -> - ('a -> 'b -> unit Lwt.t) Eliom_client_value.t -> - unit diff --git a/src/lib/eliom_shared_sigs.shared.mli b/src/lib/eliom_shared_sigs.eliomi similarity index 100% rename from src/lib/eliom_shared_sigs.shared.mli rename to src/lib/eliom_shared_sigs.eliomi From 5b01a27799273d841059479a35371985eeff595c Mon Sep 17 00:00:00 2001 From: Drup Date: Sun, 1 Jan 2017 19:18:50 +0100 Subject: [PATCH 19/23] Remove some unused sideness annotations. --- src/lib/eliom_client_value.client.mli | 2 +- src/lib/eliom_runtime.client.ml | 2 +- src/lib/eliom_runtime.client.mli | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/lib/eliom_client_value.client.mli b/src/lib/eliom_client_value.client.mli index db546d1857..4f6df55afd 100644 --- a/src/lib/eliom_client_value.client.mli +++ b/src/lib/eliom_client_value.client.mli @@ -25,7 +25,7 @@ (** An ['a] client value on the client is just an ['a]. See also {% <> %}. *) -type ('a[@client]) t = 'a +type 'a t = 'a (** This exception is raised (in Lwt) on the client if a call to a server function {% < Date: Sun, 1 Jan 2017 19:20:01 +0100 Subject: [PATCH 20/23] TEMP: Comment out eliom_shared. --- pkg/filelist.ml | 16 ++--- src/lib/eliom_content.eliomi | 90 +++++++++++++-------------- src/lib/eliom_content_.server.ml | 14 ++--- src/lib/eliom_content_core.server.mli | 12 ++-- 4 files changed, 66 insertions(+), 66 deletions(-) diff --git a/pkg/filelist.ml b/pkg/filelist.ml index 9ce1d3eaf8..74ee4894ee 100644 --- a/pkg/filelist.ml +++ b/pkg/filelist.ml @@ -11,7 +11,7 @@ let server = { "eliom_parameter_sigs"; "eliom_registration_sigs"; "eliom_service_sigs"; - "eliom_shared_sigs"; + (* "eliom_shared_sigs"; *) ]; interface = [ "eliom_bus"; @@ -29,8 +29,8 @@ let server = { "eliom_notif"; "eliom_parameter"; "eliom_react"; - "eliom_shared"; - "eliom_cscache"; + (* "eliom_shared"; *) + (* "eliom_cscache"; *) "eliom_reference"; "eliom_registration"; "eliom_request_info"; @@ -57,7 +57,7 @@ let server = { "eliom_service_base"; "eliom_route"; "eliom_route_base"; - "eliom_shared_content"; + (* "eliom_shared_content"; *) "eliom_types_base"; "eliommod"; "eliommod_cli"; @@ -81,7 +81,7 @@ let client = { "eliom_parameter_sigs"; "eliom_registration_sigs"; "eliom_service_sigs"; - "eliom_shared_sigs"; + (* "eliom_shared_sigs"; *) ]; interface = [ "eliom_bus"; @@ -96,8 +96,8 @@ let client = { "eliom_lib"; "eliom_parameter"; "eliom_react"; - "eliom_shared"; - "eliom_cscache"; + (* "eliom_shared"; *) + (* "eliom_cscache"; *) "eliom_registration"; "eliom_service"; "eliom_tools"; @@ -121,7 +121,7 @@ let client = { "eliom_service_base"; "eliom_route"; "eliom_route_base"; - "eliom_shared_content"; + (* "eliom_shared_content"; *) "eliom_types_base"; "eliommod_cookies"; "eliommod_dom"; diff --git a/src/lib/eliom_content.eliomi b/src/lib/eliom_content.eliomi index 438272c0cc..3aa9c4fbc1 100644 --- a/src/lib/eliom_content.eliomi +++ b/src/lib/eliom_content.eliomi @@ -1037,15 +1037,15 @@ module Xml : sig end -module Xml_shared : Xml_sigs.T - with type 'a W.t = 'a Eliom_shared.React.S.t - and type 'a W.tlist = 'a Eliom_shared.ReactiveData.RList.t - and type event_handler = - (Dom_html.event Js.t -> unit) Eliom_client_value.t - and type mouse_event_handler = - (Dom_html.mouseEvent Js.t -> unit) Eliom_client_value.t - and type keyboard_event_handler = - (Dom_html.keyboardEvent Js.t -> unit) Eliom_client_value.t +(* module Xml_shared : Xml_sigs.T *) +(* with type 'a W.t = 'a Eliom_shared.React.S.t *) +(* and type 'a W.tlist = 'a Eliom_shared.ReactiveData.RList.t *) +(* and type event_handler = *) +(* (Dom_html.event Js.t -> unit) Eliom_client_value.t *) +(* and type mouse_event_handler = *) +(* (Dom_html.mouseEvent Js.t -> unit) Eliom_client_value.t *) +(* and type keyboard_event_handler = *) +(* (Dom_html.keyboardEvent Js.t -> unit) Eliom_client_value.t *) (** Building and pretty-printing valid SVG tree. Information about Svg api can be found at {% <> %}*) @@ -1089,26 +1089,26 @@ module Svg : sig end - (** Creation of SVG content from shared reactive signals and data - ({% <> %}). - For the operations provided, see - {% <> %}. *) - module R : sig + (* (\** Creation of SVG content from shared reactive signals and data *) + (* ({% <> %}). *) + (* For the operations provided, see *) + (* {% <> %}. *\) *) + (* module R : sig *) - module Raw : Svg_sigs.Make(Xml_shared).T - with type 'a elt = 'a elt - and type 'a attrib = 'a attrib + (* module Raw : Svg_sigs.Make(Xml_shared).T *) + (* with type 'a elt = 'a elt *) + (* and type 'a attrib = 'a attrib *) - include module type of Raw + (* include module type of Raw *) - (** [pcdata] is not implemented reactively for SVG. *) - val pcdata : string Xml.W.t -> [> `Unimplemented ] + (* (\** [pcdata] is not implemented reactively for SVG. *\) *) + (* val pcdata : string Xml.W.t -> [> `Unimplemented ] *) - (** [node s] produces an ['a elt] out of the shared reactive - signal [s]. *) - val node : 'a elt Eliom_shared.React.S.t -> 'a elt + (* (\** [node s] produces an ['a elt] out of the shared reactive *) + (* signal [s]. *\) *) + (* val node : 'a elt Eliom_shared.React.S.t -> 'a elt *) - end + (* end *) (** Creation of content from client-side values. This makes possible to insert in server side generated pages some nodes @@ -1305,32 +1305,32 @@ module Html : sig end - (** Creation of HTML content from shared reactive signals and data - ({% <> %}). - For the operations provided, see - {% <> %}. *) - module R : sig + (* (\** Creation of HTML content from shared reactive signals and data *) + (* ({% <> %}). *) + (* For the operations provided, see *) + (* {% <> %}. *\) *) + (* module R : sig *) - include Html_sigs.Make(Xml_shared)(Svg.R.Raw).T - with type 'a elt = 'a elt - and type 'a attrib = 'a attrib + (* include Html_sigs.Make(Xml_shared)(Svg.R.Raw).T *) + (* with type 'a elt = 'a elt *) + (* and type 'a attrib = 'a attrib *) - (** [pcdata s] produces a node of type - [\[> Html_types.span\] elt] - out of the string signal [s]. *) - val pcdata : - string Eliom_shared.React.S.t -> [> Html_types.span] elt + (* (\** [pcdata s] produces a node of type *) + (* [\[> Html_types.span\] elt] *) + (* out of the string signal [s]. *\) *) + (* val pcdata : *) + (* string Eliom_shared.React.S.t -> [> Html_types.span] elt *) - (** [node s] produces an ['a elt] out of the shared reactive - signal [s]. *) - val node : 'a elt Eliom_shared.React.S.t -> 'a elt + (* (\** [node s] produces an ['a elt] out of the shared reactive *) + (* signal [s]. *\) *) + (* val node : 'a elt Eliom_shared.React.S.t -> 'a elt *) - (** [filter_attrib a b] amounts to the attribute [a] while [b] is - [true], and to no attribute while [b] is [false]. *) - val filter_attrib : - 'a attrib -> bool Eliom_shared.React.S.t -> 'a attrib + (* (\** [filter_attrib a b] amounts to the attribute [a] while [b] is *) + (* [true], and to no attribute while [b] is [false]. *\) *) + (* val filter_attrib : *) + (* 'a attrib -> bool Eliom_shared.React.S.t -> 'a attrib *) - end + (* end *) (** Type-safe custom data for HTML. See the {% < 'a -> 'a Eliom_wrap.wrapped_value - val client_attrib : - ?init:attrib -> attrib Eliom_client_value.t -> attrib + (* val client_attrib : *) + (* ?init:attrib -> attrib Eliom_client_value.t -> attrib *) end @@ -108,8 +108,8 @@ module Svg : sig include module type of Raw - val client_attrib : - ?init:'a attrib -> 'a attrib Eliom_client_value.t -> 'a attrib + (* val client_attrib : *) + (* ?init:'a attrib -> 'a attrib Eliom_client_value.t -> 'a attrib *) end @@ -179,8 +179,8 @@ module Html : sig include module type of Raw - val client_attrib : - ?init:'a attrib -> 'a attrib Eliom_client_value.t -> 'a attrib + (* val client_attrib : *) + (* ?init:'a attrib -> 'a attrib Eliom_client_value.t -> 'a attrib *) (**/**) type ('a, 'b, 'c) lazy_star = From 6d85f0ca8355fc8a0bc999c89d37dca1264fe19d Mon Sep 17 00:00:00 2001 From: Drup Date: Sun, 1 Jan 2017 19:20:17 +0100 Subject: [PATCH 21/23] Add missing bit of runtime. --- src/lib/eliom_wrap.client.ml | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 src/lib/eliom_wrap.client.ml diff --git a/src/lib/eliom_wrap.client.ml b/src/lib/eliom_wrap.client.ml new file mode 100644 index 0000000000..aaf8a2a94f --- /dev/null +++ b/src/lib/eliom_wrap.client.ml @@ -0,0 +1,4 @@ + +type poly +type 'a wrapped_value = poly * 'a +type unwrapper From db76e44cdd5659000efb58c82c4dd9a0a5dd9442 Mon Sep 17 00:00:00 2001 From: Drup Date: Sun, 1 Jan 2017 19:20:43 +0100 Subject: [PATCH 22/23] TEMP: Comment out to_and_of --- src/lib/eliom_common.server.ml | 2 +- src/lib/eliom_common.server.mli | 2 +- src/lib/eliom_parameter.server.mli | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/lib/eliom_common.server.ml b/src/lib/eliom_common.server.ml index 0362dc8825..2726f187e5 100644 --- a/src/lib/eliom_common.server.ml +++ b/src/lib/eliom_common.server.ml @@ -1398,7 +1398,7 @@ module To_and_of_shared = struct let create ?client_to_and_of server = { server ; - client = client_to_and_of ; + client = None (* client_to_and_of *); wrapper } diff --git a/src/lib/eliom_common.server.mli b/src/lib/eliom_common.server.mli index 80b80ee6cc..526f6293ed 100644 --- a/src/lib/eliom_common.server.mli +++ b/src/lib/eliom_common.server.mli @@ -727,7 +727,7 @@ module To_and_of_shared : sig type 'a t val create : - ?client_to_and_of : 'a to_and_of Eliom_client_value.t -> + ?client_to_and_of : _ Eliom_client_value.t -> 'a to_and_of -> 'a t diff --git a/src/lib/eliom_parameter.server.mli b/src/lib/eliom_parameter.server.mli index fe0bc99e1e..cc9caa8629 100644 --- a/src/lib/eliom_parameter.server.mli +++ b/src/lib/eliom_parameter.server.mli @@ -31,7 +31,7 @@ include Eliom_parameter_sigs.S injecting the parameter (or a service that uses it) for use in client code. *) val user_type : - ?client_to_and_of : 'a to_and_of Eliom_client_value.t -> + ?client_to_and_of : _ (* 'a to_and_of *) Eliom_client_value.t -> of_string : (string -> 'a) -> to_string : ('a -> string) -> string -> @@ -41,7 +41,7 @@ val user_type : by the user. See [user_type] for the description of the arguments. *) val all_suffix_user : - ?client_to_and_of : 'a to_and_of Eliom_client_value.t -> + ?client_to_and_of : _ (* 'a to_and_of *) Eliom_client_value.t -> of_string : (string -> 'a) -> to_string : ('a -> string) -> string -> From 30f458c51d0e0ca8bd6631d55ee1a6d280faa3b7 Mon Sep 17 00:00:00 2001 From: Drup Date: Mon, 2 Jan 2017 00:08:30 +0100 Subject: [PATCH 23/23] fixup! Remove some unused sideness annotations. --- src/lib/eliom_client_value.client.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/eliom_client_value.client.ml b/src/lib/eliom_client_value.client.ml index dc20883541..daf8b14426 100644 --- a/src/lib/eliom_client_value.client.ml +++ b/src/lib/eliom_client_value.client.ml @@ -20,7 +20,7 @@ exception False exception Exception_on_server of string -type ('a[@client]) t = 'a +type 'a t = 'a type injection_datum = Eliom_serial.injection_datum