diff --git a/pkg/distillery/basic.ppx/Makefile b/pkg/distillery/basic.ppx/Makefile index 8c47d3983d..df9a38e019 100644 --- a/pkg/distillery/basic.ppx/Makefile +++ b/pkg/distillery/basic.ppx/Makefile @@ -12,9 +12,9 @@ include Makefile.options ## Internals ## Required binaries -ELIOMC := eliomc -ppx -ELIOMOPT := eliomopt -ppx -JS_OF_ELIOM := js_of_eliom -ppx +ELIOMC := eliomc %%%REASON_FLAG%%% -ppx +ELIOMOPT := eliomopt %%%REASON_FLAG%%% -ppx +JS_OF_ELIOM := js_of_eliom %%%REASON_FLAG%%% -ppx ELIOMDEP := eliomdep OCSIGENSERVER := ocsigenserver OCSIGENSERVER.OPT := ocsigenserver.opt @@ -103,7 +103,7 @@ run.opt: # Use `eliomdep -sort' only in OCaml>4 ifeq ($(shell ocamlc -version|cut -c1),4) -eliomdep=$(shell $(ELIOMDEP) $(1) -ppx -sort $(2) $(filter %.eliom %.ml,$(3)))) +eliomdep=$(shell $(ELIOMDEP) $(1) %%%REASON_FLAG%%% -ppx -sort $(2) $(filter %.eliom %.ml,$(3)))) else eliomdep=$(3) endif @@ -219,10 +219,10 @@ include .depend cat $^ > $@ $(DEPSDIR)/%.server: % | $(DEPSDIR) - $(ELIOMDEP) -server -ppx $(SERVER_INC) $< > $@ + $(ELIOMDEP) -server %%%REASON_FLAG%%% -ppx $(SERVER_INC) $< > $@ $(DEPSDIR)/%.client: % | $(DEPSDIR) - $(ELIOMDEP) -client -ppx $(CLIENT_INC) $< > $@ + $(ELIOMDEP) -client %%%REASON_FLAG%%% -ppx $(CLIENT_INC) $< > $@ $(DEPSDIR): mkdir $@ diff --git a/src/ppx/ppx_eliom_utils.ml b/src/ppx/ppx_eliom_utils.ml index 9105a34a63..b01229fd47 100644 --- a/src/ppx/ppx_eliom_utils.ml +++ b/src/ppx/ppx_eliom_utils.ml @@ -37,6 +37,8 @@ let pat_args = function | [p] -> p | l -> Pat.tuple l +let override_file_name = ref None + (* 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 @@ -44,7 +46,14 @@ let pat_args = function 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 file_name = + match !override_file_name with + | Some file_name -> + file_name + | None -> + loc.Location.loc_start.pos_fname + in + let s = Digest.string file_name in let e = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_'" in let o = Bytes.create 6 in let g p = Char.code s.[p] in @@ -287,10 +296,17 @@ module Context = struct end -let match_args = function +let rec match_args = function | [ ] -> () - | [ "-type" ; type_file ] -> Mli.type_file := Some type_file - | [ "-notype" ] -> Mli.type_file := None + | "-orig-file-name" :: file_name :: args -> + override_file_name := Some file_name; + match_args args + | "-type" :: type_file :: args -> + Mli.type_file := Some type_file; + match_args args + | "-notype" :: args -> + Mli.type_file := None; + match_args args | args -> Location.raise_errorf ~loc:Location.(in_file !input_name) "Wrong arguments:@ %s" (String.concat " " args) diff --git a/src/tools/distillery.ml b/src/tools/distillery.ml index a60c8be7c3..cf43dd8259 100644 --- a/src/tools/distillery.ml +++ b/src/tools/distillery.ml @@ -187,7 +187,16 @@ let expand_dest_path ~name ~dest_dir s = |> join_path |> Filename.concat dest_dir -let create_project ?preds ~without_asking ~name ~env ~source_dir ~dest_dir () = +let convert_file_to_reason path = + let extension = Filename.extension path in + if (extension = ".eliom" || extension = ".eliomi") then + Utils.run_command + ~on_error:(function + | 127 -> Printf.eprintf "Error: refmt is not installed - please install with `opam install reason`\n" + | d -> Printf.eprintf "Unknown error code %d while running refmt\n" d) + ("refmt --parse=ml --print=re --in-place " ^ path) + +let create_project ?preds ~without_asking ~use_refmt ~name ~env ~source_dir ~dest_dir () = let eliom_ignore_files = lines_of_file (Filename.concat source_dir eliomignore_filename) and eliom_verbatim_files = @@ -213,7 +222,8 @@ let create_project ?preds ~without_asking ~name ~env ~source_dir ~dest_dir () = else let src_path = Filename.concat source_dir src_file and dst_path = expand_dest_path ~name ~dest_dir src_file in - copy_file ?preds ~env src_path dst_path + copy_file ?preds ~env src_path dst_path ; + if use_refmt then convert_file_to_reason dst_path ) (Sys.readdir source_dir) @@ -227,7 +237,8 @@ let env name = [ "PROJECT_NAME", name; "MODULE_NAME", String.capitalize name; - "PROJECT_DB", db + "PROJECT_DB", db; + "REASON_FLAG", if !Utils.use_refmt then "-reason" else "" ] let get_templatedirs () = @@ -312,6 +323,8 @@ let main () = " Display the template directories (set through $ELIOM_DISTILLERY_PATH)"; "-y", Set without_asking, " Create the project directory without confirmation."; + "-reason", Set Utils.use_refmt, + " Create the project with reason syntax (defaults to OCaml)"; "-name", String (fun s -> name := Some (check_name s)), " Name of the project (a valid compilation unit name)"; "-template", String select_template, @@ -339,7 +352,7 @@ let main () = (fst template) else let env, source_dir = init_project template name in - create_project ~without_asking:(!without_asking) ~name ~env ~source_dir ~dest_dir () + create_project ~without_asking:(!without_asking) ~use_refmt:(!Utils.use_refmt) ~name ~env ~source_dir ~dest_dir () end let () = main () diff --git a/src/tools/eliomc.ml b/src/tools/eliomc.ml index 23b5c9a36f..d13ff87ba7 100644 --- a/src/tools/eliomc.ml +++ b/src/tools/eliomc.ml @@ -190,11 +190,6 @@ let compile_obj file = (* Process eliom and eliomi files *) -let run_command s = - let v = Sys.command s in - if v != 0 then - failwith (Printf.sprintf "Warning: command [%s] returned %d" s v) - (* WARNING: if you change this, also change inferred_type_prefix in ppx/ppx_eliom_utils.ml and ocamlbuild/ocamlbuild_eliom.ml *) let inferred_type_prefix = "eliom_inferred_type_" @@ -235,7 +230,8 @@ let compile_server_type_eliom file = let out = Unix.openfile obj [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0o666 in let on_error _ = Unix.close out; - Sys.remove obj + Sys.remove obj; + Utils.exit_no_refmt () in create_process ~out ~on_error !compiler ( [ "-i" ] @@ -303,14 +299,17 @@ let compile_eliom ~impl_intf file = | `Server | `ServerOpt -> obj_ext () in output_prefix file ^ ext + and ppopts = get_ppopts ~impl_intf file in + let on_error _ = + Sys.remove obj; + Utils.exit_no_refmt () in - let ppopts = get_ppopts ~impl_intf file in (* if !do_dump then begin *) (* let camlp4, ppopt = get_pp_dump pkg ("-printer" :: "o" :: ppopts @ [file]) in *) (* create_process camlp4 ppopt; *) (* exit 0 *) (* end; *) - create_process !compiler ( + create_process ~on_error !compiler ( [ "-c" ; "-o" ; obj ] @ preprocess_opt ppopts @ [ "-intf-suffix"; ".eliomi" ] @@ -322,6 +321,7 @@ let compile_eliom ~impl_intf file = args := !args @ [obj] let process_eliom ~impl_intf file = + if !Utils.use_refmt then Utils.orig_file_name := Some file; match !mode with | `Infer when impl_intf = `Impl -> compile_server_type_eliom file @@ -423,6 +423,9 @@ let process_option () = if !i+1 >= Array.length Sys.argv then usage (); process_eliom ~impl_intf:`Impl Sys.argv.(!i+1); i := !i+2 + | "-reason" -> + use_refmt := true; + incr i | arg when Filename.check_suffix arg ".mli" -> process_ocaml ~impl_intf:`Intf arg; incr i diff --git a/src/tools/eliomdep.ml b/src/tools/eliomdep.ml index 59006a5713..47f3386d50 100644 --- a/src/tools/eliomdep.ml +++ b/src/tools/eliomdep.ml @@ -275,6 +275,9 @@ let process_option () = else compile_eliom ~impl_intf:`Impl arg; i := !i+2 + | "-reason" -> + use_refmt := true; + incr i | arg when Filename.check_suffix arg ".mli" -> if not (do_sort ()) then compile_intf arg; diff --git a/src/tools/eliomdoc.ml b/src/tools/eliomdoc.ml index 07b7bcd89b..83b505c89d 100644 --- a/src/tools/eliomdoc.ml +++ b/src/tools/eliomdoc.ml @@ -179,6 +179,9 @@ let process_option () = let arg = Sys.argv.(!i+1) in compile_eliom ~impl_intf:`Impl arg; i := !i+2 + | "-reason" -> + use_refmt := true; + incr i | arg when Filename.check_suffix arg ".mli" -> compile_intf arg; incr i diff --git a/src/tools/utils.ml b/src/tools/utils.ml index b1549e1c3f..1f9d5ab271 100644 --- a/src/tools/utils.ml +++ b/src/tools/utils.ml @@ -71,6 +71,10 @@ let default_server_types_ext = let build_dir : string ref = ref "" let type_dir : string ref = ref default_type_dir +let use_refmt = ref false + +let orig_file_name = ref None + let get_kind k = match k with | Some k -> k @@ -362,6 +366,12 @@ let get_ppopts ~impl_intf file = type_opt impl_intf file @ !ppopt let preprocess_opt ?(ocaml = false) ?kind opts = + let refmt () = + if !use_refmt then + [ "-pp"; "refmt --parse=re --print=ml" ] + else + [] + in match !pp_mode with | `Camlp4 -> let pkg = match ocaml, simplify_kind ?kind () with @@ -372,17 +382,31 @@ let preprocess_opt ?(ocaml = false) ?kind opts = in [ "-pp"; get_pp pkg ^ " " ^ String.concat " " opts ] | `Ppx when ocaml -> - [] + refmt () | `Ppx -> let pkg = match simplify_kind ?kind () with | `Client -> "eliom.ppx.client" | `Server -> "eliom.ppx.server" | `Types -> "eliom.ppx.type" + and opts = + match !orig_file_name, !use_refmt with + | Some orig_file_name, true -> + "-orig-file-name" :: orig_file_name :: opts + | _, _ -> + opts in - [ "-ppx"; get_ppx pkg ^ " " ^ String.concat " " opts ] + refmt () @ [ "-ppx"; get_ppx pkg ^ " " ^ String.concat " " opts ] (** Process *) +let run_command ?on_error s = + let v = Sys.command s in + if v != 0 then + match on_error with + | Some f -> f v + | None -> Printf.eprintf "Error: command [%s] returned [%d]" s v; + exit 255 + let rec wait ?(on_error=fun _ -> ()) pid = let e = snd (Unix.waitpid [] pid) in match e with @@ -414,6 +438,13 @@ let create_filter name args f = let ch = Unix.in_channel_of_descr in_ in try f ch with _ -> close_in ch; wait pid +let exit_no_refmt () = + if !use_refmt then ( + Printf.eprintf + "Compiler failed. Have you installed reason and its refmt binary?\n%!"; + exit 1 + ) + let help_filter skip msg ch = for _i = 1 to skip do ignore (input_line ch) done; prerr_endline msg;