Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base: 0e374e290e
...
compare: 15e0b966cf
  • 4 commits
  • 5 files changed
  • 0 commit comments
  • 1 contributor
View
12 compiler/OMakefile
@@ -2,7 +2,10 @@ OCAMLINCLUDES[] += $(BASE)/runtime
OCAML_LIBS[] =
$(BASE)/runtime/extprot
-OCAMLFLAGS += -syntax camlp4o
+CAMLP4PATH = $(shell ocamlfind query camlp4)
+PARSERS_PATH = $(CAMLP4PATH)/Camlp4Parsers
+
+OCAMLFLAGS += -syntax camlp4o -I $(PARSERS_PATH)
OCAMLDEPFLAGS += -syntax camlp4o
OCAMLPACKS[] +=
@@ -18,6 +21,10 @@ EXTPROT_OBJS[] =
gencode_types
gen_OCaml
+CAMLP4_OBJS[] =
+ Camlp4OCamlRevisedParser
+ Camlp4OCamlParser
+
section
OCAMLPACKS[] += camlp4.extend
OCAMLFLAGS += -w e
@@ -28,7 +35,8 @@ section
CamlSources(protocol_types gencode_types)
OCAMLPACKS += camlp4.lib
-OCamlProgram(extprotc, $(EXTPROT_OBJS) extprotc)
+OCamlProgram(extprotc, \
+ $(addprefix $(PARSERS_PATH)/, $(CAMLP4_OBJS)) $(EXTPROT_OBJS) extprotc)
.DEFAULT: extprotc$(EXE)
View
19 compiler/gen_OCaml.ml
@@ -133,6 +133,19 @@ let ctyp_of_path path = match List.rev @@ String.nsplit path "." with
<:ctyp< $lid:ty$ >>
mods
+module Caml =
+ Camlp4OCamlParser.Make
+ (Camlp4OCamlRevisedParser.Make
+ (Camlp4.OCamlInitSyntax.Make(Ast)(Gram)(Quotation)))
+
+let expr_of_string s =
+ try
+ Gram.parse_string Caml.expr (Loc.mk "<string>") s
+ with Loc.Exc_located (_, b) as e ->
+ Printf.eprintf "Parse error in OCaml expression: %s\nin\n%s\n"
+ (Printexc.to_string b) s;
+ raise e
+
let expr_of_path expr = match List.rev @@ String.nsplit expr "." with
[] -> raise (Bad_option "Empty expr")
| e :: mods ->
@@ -527,6 +540,12 @@ struct
{ c with c_pretty_printer =
Some <:str_item< value $lid:"pp_" ^ tyname$ = $wrap expr$ >> }
+ let add_typedecl_pretty_printer bindings tyname typarams texpr opts c =
+ match lookup_option "pp" opts with
+ None -> add_typedecl_pretty_printer bindings tyname typarams texpr opts c
+ | Some s ->
+ { c with c_pretty_printer =
+ Some <:str_item< value $lid:"pp_" ^ tyname$ = $expr_of_string s$ >> }
end
module Make_reader
View
2  compiler/parser.ml
@@ -122,7 +122,7 @@ EXTEND Gram
a_LIDENT: [ [ `LIDENT s -> s ] ];
a_UIDENT: [ [ `UIDENT s -> s ] ];
- a_STRING: [ [ `STRING (_, s) -> s ] ];
+ a_STRING: [ [ `STRING (s, _) -> s ] ];
END
View
53 doc/language-mapping.md
@@ -45,6 +45,59 @@ will translate to this module:
val write_msg1 : Extprot.Msg_buffer.t -> msg1 -> unit
end
+### Type options
+
+You can give hints to the code generator by appending
+
+ options "ocaml.xxx" = "..."
+ "ocaml.yyy" = "..."
+
+to the type definition.
+
+#### Using external types and type aliases
+
+The generated code can convert automatically values from the serialization
+type to an external one by using suitable conversion functions; e.g.,
+
+ type timestamp = long
+ options "ocaml.type" = "Time.t, Time.of_int64, Time.to_int64"
+
+will serialize Time.t values by converting them to 64-bit integers
+(using Time.to_int64), and deserialize by reading a 64-bit integer and
+converting it into a Time.t value with Time.of_int64. The "ocaml.type" option
+value _must_ be a comma-separated list of identifiers (with optional module
+paths).
+
+##### Type equality
+
+You can indicate that a type is equal to an existing one with the
+"ocaml.type_equals" option; e.g.,
+
+
+ type opt 'a = None | Some 'a
+ options "ocaml.type_equals" = "option"
+
+defines an opt type that is equal to the usual option type. The
+"ocaml.type_equals" value must be an idenfifier with optional module path.
+
+#### Pretty-printers
+
+You can provide a customized pretty-printer function that overrides the
+default one with the "ocaml.pp" option; its value must be a valid
+OCaml expression of type ... -> Format.formatter -> a -> unit where
+the ellipsis represents pretty-printer functions for each type parameter
+(if any)
+
+ type opt 'a = None | Some 'a
+ options "ocaml.type_equals" = "option"
+ "ocaml.pp" =
+ "fun pp_a fmt -> function
+ None -> Format.fprintf fmt \"nothing at all\"
+ | Some x -> Format.fprintf fmt \"some value %a\" pp_a x"
+
+Note that special characters need to be escaped inside the string given as the
+option value (as done in normal OCaml programs).
+
### Performance
See the `test/bm_01` program.
View
7 runtime/error.ml
@@ -46,6 +46,13 @@ let pp_extprot_error pp (e, loc) = match e with
| Bad_format err ->
PP.pp_tuple2 ~constr:"Bad_format" pp_format_error pp_location pp (err, loc)
+let () =
+ Printexc.register_printer
+ (function
+ Extprot_error (err, loc) ->
+ Some (PP.ppfmt "Extprot_error %a" pp_extprot_error (err, loc))
+ | _ -> None)
+
let extprot_error err loc = raise (Extprot_error (err, loc))
let bad_format err loc = extprot_error (Bad_format err) loc

No commit comments for this range

Something went wrong with that request. Please try again.