Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

feat: support (OCaml syntax) expressions in {j| .. |j} interpolation #1025

Draft
wants to merge 3 commits into
base: main
Choose a base branch
from
Draft

feat: support (OCaml syntax) expressions in {j| .. |j} interpolation #1025

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
b701e85
feat: support (OCaml syntax) expressions in `{j| .. |j}` interpolation
anmonteiro Jan 10, 2024
040b35a
Merge branch 'main' into anmonteiro/interpolation-expressions
anmonteiro Jan 10, 2024
dba2f98
chore: remove / port tests that should live elsewhere
anmonteiro Jan 10, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
119 changes: 83 additions & 36 deletions jscomp/common/utf8_string.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -220,8 +220,8 @@ module Interp = struct
| Unmatched_paren
| Invalid_syntax_of_var of string

type kind = String | Var of int * int
(* [Var (loffset, roffset)]
type kind = String | Expr of int * int
(* [Expr (loffset, roffset)]
For parens it used to be (2,-1)
for non-parens it used to be (1,0) *)

Expand Down Expand Up @@ -331,51 +331,73 @@ module Interp = struct
},
error ))

let empty_segment_cxt cxt =
(* Move the position back 2 characters "$(" if this is the empty
interpolation. *)
{
cxt with
segment_start =
{
cxt.segment_start with
offset = (match cxt.segment_start.offset with 0 -> 0 | n -> n - 3);
byte_bol =
(match cxt.segment_start.byte_bol with 0 -> 0 | n -> n - 3);
};
pos_bol = cxt.pos_bol + 3;
byte_bol = cxt.byte_bol + 3;
}

let add_var_segment cxt loc loffset roffset =
let content = Buffer.contents cxt.buf in
Buffer.clear cxt.buf;
let next_loc =
{
lnum = cxt.pos_lnum;
offset = loc - cxt.pos_bol;
byte_bol = cxt.byte_bol;
}
in
if valid_identifier content then (
let next_loc =
{
lnum = cxt.pos_lnum;
offset = loc - cxt.pos_bol;
byte_bol = cxt.byte_bol;
}
in
cxt.segments <-
{
start = cxt.segment_start;
finish = next_loc;
kind = Var (loffset, roffset);
kind = Expr (loffset, roffset);
content;
}
:: cxt.segments;
cxt.segment_start <- next_loc)
else
let cxt =
match String.trim content with
| "" ->
(* Move the position back 2 characters "$(" if this is the empty
interpolation. *)
{
cxt with
segment_start =
{
cxt.segment_start with
offset =
(match cxt.segment_start.offset with 0 -> 0 | n -> n - 3);
byte_bol =
(match cxt.segment_start.byte_bol with
| 0 -> 0
| n -> n - 3);
};
pos_bol = cxt.pos_bol + 3;
byte_bol = cxt.byte_bol + 3;
}
| _ -> cxt
match String.trim content with "" -> empty_segment_cxt cxt | _ -> cxt
in
pos_error cxt ~loc (Invalid_syntax_of_var content)

let add_expr_segment cxt loc loffset roffset =
let content = Buffer.contents cxt.buf in
Buffer.clear cxt.buf;
match String.trim content with
| "" ->
let cxt = empty_segment_cxt cxt in
pos_error cxt ~loc (Invalid_syntax_of_var content)
| _ ->
let next_loc =
{
lnum = cxt.pos_lnum;
offset = loc - cxt.pos_bol;
byte_bol = cxt.byte_bol;
}
in
cxt.segments <-
{
start = cxt.segment_start;
finish = next_loc;
kind = Expr (loffset, roffset);
content;
}
:: cxt.segments;
cxt.segment_start <- next_loc

let add_str_segment cxt loc =
let content = Buffer.contents cxt.buf in
Buffer.clear cxt.buf;
Expand Down Expand Up @@ -453,15 +475,25 @@ module Interp = struct

and expect_var_paren loc s offset ({ buf; s_len; _ } as cxt) =
let v = ref offset in
while !v < s_len && s.[!v] <> ')' do
let opening_parens = ref [] in
let stop = ref false in
while !v < s_len && not !stop do
let cur_char = s.[!v] in
Buffer.add_char buf cur_char;
incr v

(if cur_char = ')' then
match !opening_parens with
| [] -> stop := true
| _ :: rest -> opening_parens := rest);

if not !stop then (
if cur_char = '(' then opening_parens := cur_char :: !opening_parens;
Buffer.add_char buf cur_char;
incr v)
done;
let added_length = !v - offset in
let loc = added_length + 1 + loc in
if !v < s_len && s.[!v] = ')' then (
add_var_segment cxt loc 2 (-1);
add_expr_segment cxt loc 2 (-1);
check_and_transform loc s (added_length + 1 + offset) cxt)
else pos_error cxt ~loc Unmatched_paren

Expand Down Expand Up @@ -525,7 +557,7 @@ module Interp = struct
| String ->
let loc = update border start finish loc in
Exp.constant (Pconst_string (content, loc, escaped_j_delimiter))
| Var (soffset, foffset) ->
| Expr (soffset, foffset) -> (
let loc =
{
loc with
Expand All @@ -535,7 +567,22 @@ module Interp = struct
update_position (foffset + border) finish loc.loc_start;
}
in
Exp.ident ~loc { loc; txt = Lident content })
let lexbuf = Lexing.from_string content in
try { (Parse.expression lexbuf) with pexp_loc = loc }
with Syntaxerr.Error err ->
let err =
match err with
| Unclosed _ -> Syntaxerr.Other loc
| Expecting (_, s) -> Expecting (loc, s)
| Not_expecting (_, s) -> Not_expecting (loc, s)
| Applicative_path _ -> Applicative_path loc
| Variable_in_scope (_, s) -> Variable_in_scope (loc, s)
| Other _ -> Other loc
| Ill_formed_ast (_, s) -> Ill_formed_ast (loc, s)
| Invalid_package_type (_, s) -> Invalid_package_type (loc, s)
| Removed_string_set _ -> Removed_string_set loc
in
raise (Syntaxerr.Error err)))
in
let concat_exp a_loc x ~(lhs : Parsetree.expression) =
let loc = merge_loc a_loc lhs.pexp_loc in
Expand Down
2 changes: 1 addition & 1 deletion jscomp/common/utf8_string.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,7 @@ module Interp : sig
| Unmatched_paren
| Invalid_syntax_of_var of string

type kind = String | Var of int * int
type kind = String | Expr of int * int

(* Note the position is about code point *)
type pos = {
Expand Down
68 changes: 68 additions & 0 deletions test/blackbox-tests/utf8-string-interp.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -35,3 +35,71 @@
Error: This expression has type int but an expression was expected of type
string
[2]

`{j| .. |j}` interpolation with expressions

$ cat > x.ml <<EOF
> let x =
> let y = 3 in
> {j| Hello, \$(y + y |> Js.String.make)|j}
> EOF
$ melc -ppx melppx x.ml
// Generated by Melange
'use strict';


var x = " Hello, " + String(6);

exports.x = x;
/* x Not a pure module */

Interpolation expression errors

$ cat > x.ml <<EOF
> let x =
> let y = 3 in
> {j| Hello, \$(y + y |>)|j}
> EOF
$ melc -ppx melppx x.ml
File "x.ml", line 3, characters 15-23:
3 | {j| Hello, $(y + y |>)|j}
^^^^^^^^
Error: Syntax error
[2]

$ cat > x.ml <<EOF
> let x =
> let y = 3 in
> {j| Hello, \$(y + y)|j}
> EOF
$ melc -ppx melppx x.ml
File "x.ml", line 3, characters 15-20:
3 | {j| Hello, $(y + y)|j}
^^^^^
Error: This expression has type int but an expression was expected of type
string
[2]

$ cat > x.ml <<EOF
> let x =
> let y = 3 in
> {j| Hello, \$(y +)|j}
> EOF
$ melc -ppx melppx x.ml
File "x.ml", line 3, characters 15-18:
3 | {j| Hello, $(y +)|j}
^^^
Error: Syntax error
[2]

$ cat > x.ml <<EOF
> let x =
> {j|\$(()) |j}
> EOF
$ melc -ppx melppx x.ml
File "x.ml", line 2, characters 7-9:
2 | {j|$(()) |j}
^^
Error: This expression has type unit but an expression was expected of type
string
[2]
35 changes: 3 additions & 32 deletions test/unit-tests/ounit_unicode_tests.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@ let ( =~ ) a b = OUnit.assert_equal ~cmp:String.equal a b

module Utf8_string = Melange_ffi.Utf8_string

(* Note [Var] kind can not be mpty *)
(* Note [Expr] kind can not be mpty *)
let empty_segment { Utf8_string.Interp.Private.content; _ } =
String.length content = 0

Expand Down Expand Up @@ -38,8 +38,8 @@ let ( ==* ) a b =
in
OUnit.assert_equal segments b

let varParen : Utf8_string.Interp.kind = Var (2, -1)
let var : Utf8_string.Interp.kind = Var (1, 0)
let varParen : Utf8_string.Interp.kind = Expr (2, -1)
let var : Utf8_string.Interp.kind = Expr (1, 0)

let suites =
__FILE__
Expand Down Expand Up @@ -167,15 +167,6 @@ let suites =
] );
( __LOC__ >:: fun _ ->
{|$x)|} ==* [ (0, 0, 0, 2, var, "x"); (0, 2, 0, 3, String, ")") ] );
( __LOC__ >:: fun _ ->
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I wonder if these tests can be left, but updating them to the new behavior?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The new behavior is different and it's covered elsewhere, in the blackbox-tests. I think these are actually unnecessary.

match Utf8_string.Interp.Private.transform_test {j| $( ()) |j} with
| exception
Utf8_string.Interp.Error
( { lnum = 0; offset = 1; byte_bol = 0 },
{ lnum = 0; offset = 6; byte_bol = 0 },
Invalid_syntax_of_var " (" ) ->
OUnit.assert_bool __LOC__ true
| _ -> OUnit.assert_bool __LOC__ false );
( __LOC__ >:: fun _ ->
match Utf8_string.Interp.Private.transform_test {|$ ()|} with
| exception
Expand All @@ -194,26 +185,6 @@ let suites =
Invalid_syntax_of_var "" ) ->
OUnit.assert_bool __LOC__ true
| _ -> OUnit.assert_bool __LOC__ false );
( __LOC__ >:: fun _ ->
match
Utf8_string.Interp.Private.transform_test {|$(hello world)|}
with
| exception
Utf8_string.Interp.Error
( { lnum = 0; offset = 0; byte_bol = 0 },
{ lnum = 0; offset = 14; byte_bol = 0 },
Invalid_syntax_of_var "hello world" ) ->
OUnit.assert_bool __LOC__ true
| _ -> OUnit.assert_bool __LOC__ false );
( __LOC__ >:: fun _ ->
match Utf8_string.Interp.Private.transform_test {|$( hi*) |} with
| exception
Utf8_string.Interp.Error
( { lnum = 0; offset = 0; byte_bol = 0 },
{ lnum = 0; offset = 7; byte_bol = 0 },
Invalid_syntax_of_var " hi*" ) ->
OUnit.assert_bool __LOC__ true
| _ -> OUnit.assert_bool __LOC__ false );
( __LOC__ >:: fun _ ->
match Utf8_string.Interp.Private.transform_test {|xx $|} with
| exception
Expand Down
Loading