package ppx_string_interpolation

  1. Overview
  2. Docs

Source file interpolation_emitter.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
open Ppxlib
open Ppxlib.Ast_builder.Default

type element = string * Location.t

type token =
  | String of element
  | EscapedPercent of Location.t
  | Expression of element * element option
  | Variable of element * element option

let token_to_string = function
  | String (s, _) ->
    s
  | Expression ((e, _), _) ->
    "{" ^ e ^ "}"
  | Variable ((v, _), _) ->
    "[" ^ v ^ "]"
  | EscapedPercent _ ->
    "%"

(* Debug printing of tokens. Compresses %% into % *)
let print_tokens = List.iter (fun p -> print_string (token_to_string p))

(* Convert commented out expression to a string.
   Here we also rely on UTF8/single codepage - '(','*' and ')' occupy only one byte. *)
let convert_commented_out = function
  | Expression ((str, loc), fmt) ->
    if String.length str >= 4 && str.[1] = '*' && str.[String.length str - 2] = '*' then (
      match fmt with
      | Some (fmt, _) ->
        String ("%" ^ fmt ^ "$" ^ str, loc)
      | None ->
        String ("$" ^ str, loc))
    else
      Expression ((str, loc), fmt)
  | x ->
    x

(* Generate a list of sprintf arguments from tokens. *)
let to_arguments tokens =
  let shift by ({ Location.loc_start; _ } as loc) =
    { loc with
      Location.loc_start = { loc_start with Lexing.pos_cnum = loc_start.pos_cnum + by }
    }
  in
  List.rev
  @@ List.fold_left
       (fun acc token ->
          match token with
          | Expression ((e, loc), _) ->
            let lexbuf = Lexing.from_string e in
            let open Lexing in
            let open Location in
            lexbuf.lex_curr_p <- loc.loc_start;
            lexbuf.lex_abs_pos <- loc.loc_start.pos_cnum + 1;
            (Nolabel, Parse.expression lexbuf) :: acc
          | Variable ((v, loc), _) ->
            let loc = shift 1 loc in
            (Nolabel, pexp_ident ~loc { txt = Lident v; loc }) :: acc
          | _ ->
            acc)
       []
       tokens

(* Check invalid format before composing whole string to report correct location. *)
let verify_formats tokens =
  let check fmt loc =
    try
      let _ = CamlinternalFormat.fmt_ebb_of_string fmt in
      ()
    with
    | Failure msg ->
      Location.raise_errorf ~loc "%s" msg
    | _ ->
      ()
  in
  List.iter
    (fun token ->
       match token with
       | Expression (_, Some (fmt, loc)) ->
         check fmt loc
       | Variable (_, Some (fmt, loc)) ->
         check fmt loc
       | _ ->
         ())
    tokens

(* Generate format string for sprintf from tokens. NOTE, we always manually compress "$$"
   into "$" since [sprintf] does not treat is specially. However, "%%" is compressed into "%"
   only if the string does not contain interpolations, and therefore [sprintf] call is not emitted. *)
let to_format_string ~escape_percent tokens =
  let joined =
    String.concat ""
    @@ List.rev
    @@ List.fold_left
         (fun acc token ->
            match token with
            | Expression (_, Some (fmt, _)) ->
              fmt :: acc
            | Expression (_, None) ->
              "%s" :: acc
            | Variable (_, Some (fmt, _)) ->
              fmt :: acc
            | Variable (_, None) ->
              "%s" :: acc
            | String (s, _) ->
              s :: acc
            | EscapedPercent _ when escape_percent ->
              "%%" :: acc
            | EscapedPercent _ ->
              "%" :: acc)
         []
         tokens
  in
  pexp_constant ~loc:Location.none (Pconst_string (joined, Location.none, None))

(* Convert list of expressions with formats to ast. *)
let generate tokens =
  let sprintf =
    let open Longident in
    pexp_ident
      ~loc:Location.none
      { txt = Ldot (Lident "Printf", "sprintf"); loc = Location.none }
  in
  let apply func args = pexp_apply ~loc:Location.none func args in
  match to_arguments tokens with
  | [] ->
    to_format_string ~escape_percent:false tokens
  | args ->
    apply sprintf @@ ((Nolabel, to_format_string ~escape_percent:true tokens) :: args)

let emit_ast tokens =
  verify_formats tokens;
  List.map convert_commented_out tokens |> generate