package ocaml-protoc

  1. Overview
  2. Docs
Pure OCaml compiler for .proto files

Install 

dune-project
 Dependency

github.com Readme Changelog Edit opam file Versions (21)

Authors

  1. M
    Maxime Ransan <maxime.ransan@gmail.com>
  2. S
    Simon Cruanes

Maintainers

  1. M
    Maxime Ransan <maxime.ransan@gmail.com>
  2. S
    Simon Cruanes

Sources

ocaml-protoc-4.0.tbz
sha256=88533848ee8ad662bfb063f34932286405977fa3810515b997119b06f05105e4
sha512=df12c71f7181eafc94cd0fc400edf7f258cdd3740a5badafce097f771b7828fed9a9a9c0a457e7e118848a8b1ddd87fe3134a5bdf88d4adcb0d0e04ba6808c5f

doc/src/ocaml-protoc.compiler-lib/pb_codegen_make.ml.html

Source file pb_codegen_make.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
module Ot = Pb_codegen_ocaml_type
module F = Pb_codegen_formatting

type default_info = Pb_codegen_default.default_info = {
  fname: string;
  ftype: string;
  ftype_underlying: string;
  default_value: string;
  optional: bool;  (** Are we passing an option? *)
  rfp: Pb_codegen_ocaml_type.record_field_presence;
  bitfield_idx: int;
}

(** Obtain information about the fields *)
let fields_of_record { Ot.r_fields; _ } : Pb_codegen_default.default_info list =
  List.map
    (fun r_field ->
      let dinfo = Pb_codegen_default.record_field_default_info r_field in
      dinfo)
    r_fields

let gen_record ({ Ot.r_name; _ } as r) sc : unit =
  let fields = fields_of_record r in

  (* generate [has_field] accessors *)
  List.iter
    (fun (d : default_info) ->
      match d.rfp with
      | Rfp_bitfield _ ->
        F.linep sc "let[@inline] %s_has_%s (self:%s) : bool = %s" r_name d.fname
          r_name
          (Pb_codegen_util.presence_get ~bv:"self._presence" ~idx:d.bitfield_idx
             ())
      | _ -> ())
    fields;
  F.line sc "";

  (* generate [set_field] accessors *)
  List.iter
    (fun (d : default_info) ->
      F.linep sc "let[@inline] %s_set_%s (self:%s) (x:%s) : unit =" r_name
        d.fname r_name d.ftype_underlying;
      F.sub_scope sc (fun sc ->
          match d.rfp with
          | Rfp_bitfield idx ->
            F.linep sc "self._presence <- %s; self.%s <- x"
              (Pb_codegen_util.presence_set ~bv:"self._presence" ~idx ())
              d.fname
          | Rfp_wrapped_option -> F.linep sc "self.%s <- Some x" d.fname
          | Rfp_repeated | Rfp_always -> F.linep sc "self.%s <- x" d.fname))
    fields;
  F.line sc "";

  F.linep sc "let copy_%s (self:%s) : %s =" r_name r_name r_name;
  F.sub_scope sc (fun sc ->
      let field0 = List.hd fields in
      F.linep sc "{ self with %s = self.%s }" field0.fname field0.fname);
  F.line sc "";

  F.linep sc "let make_%s " r_name;
  F.sub_scope sc (fun sc ->
      List.iter
        (fun (d : default_info) ->
          match d.rfp with
          | Rfp_bitfield _ -> F.linep sc "?(%s:%s option)" d.fname d.ftype
          | Rfp_wrapped_option -> F.linep sc "?(%s:%s)" d.fname d.ftype
          | Rfp_repeated -> F.linep sc "?(%s=%s)" d.fname d.default_value
          | Rfp_always -> F.linep sc "~(%s:%s) " d.fname d.ftype)
        fields;
      F.linep sc "() : %s  =" r_name);
  F.sub_scope sc (fun sc ->
      F.linep sc "let _res = default_%s () in" r_name;
      List.iter
        (fun d ->
          if d.optional then (
            F.linep sc "(match %s with" d.fname;
            F.linep sc "| None -> ()";
            F.linep sc "| Some v -> %s_set_%s _res v);" r_name d.fname
          ) else
            F.linep sc "%s_set_%s _res %s;" r_name d.fname d.fname)
        fields;
      F.line sc "_res");

  ()

let gen_struct ?and_:_ ~mode:_ t sc =
  let { Ot.spec; _ } = t in

  let has_encoded =
    match spec with
    | Ot.Record r ->
      gen_record r sc;
      true
    | Ot.Const_variant _ | Ot.Variant _ | Ot.Unit _ ->
      (* nothing for variants *)
      false
  in
  has_encoded

let gen_sig_record sc ({ Ot.r_name; _ } as r) =
  let fields : _ list = fields_of_record r in

  F.linep sc "val make_%s : " r_name;
  F.sub_scope sc (fun sc ->
      List.iter
        (fun d ->
          match d.rfp with
          | Rfp_bitfield _ | Rfp_wrapped_option | Rfp_repeated ->
            F.linep sc "?%s:%s ->" d.fname d.ftype_underlying
          | Rfp_always -> F.linep sc "%s:%s ->" d.fname d.ftype)
        fields;
      F.line sc "unit ->";
      F.line sc r_name);
  let rn = r_name in
  F.linep sc "(** [make_%s … ()] is a builder for type [%s] *)" rn rn;

  F.line sc "";
  F.linep sc "val copy_%s : %s -> %s" r_name r_name r_name;

  List.iter
    (fun (d : default_info) ->
      (match d.rfp with
      | Rfp_bitfield _ ->
        F.line sc "";
        F.linep sc "val %s_has_%s : %s -> bool" r_name d.fname r_name;
        F.linep sc "  (** presence of field %S in [%s] *)" d.fname r_name
      | _ -> ());

      F.line sc "";
      F.linep sc "val %s_set_%s : %s -> %s -> unit" r_name d.fname r_name
        d.ftype_underlying;
      F.linep sc "  (** set field %s in %s *)" d.fname r_name)
    fields;

  ()

let gen_sig ?and_:_ ~mode:_ t sc =
  let { Ot.spec; _ } = t in

  let has_encoded =
    match spec with
    | Ot.Record r ->
      gen_sig_record sc r;
      true
    | Ot.Variant _ | Ot.Const_variant _ | Ot.Unit _ -> false
  in

  has_encoded

let ocamldoc_title = "Make functions"