Skip to content

Commit 1afbcc2

Browse files
zthzth
committed
more fixes
1 parent 8abc29a commit 1afbcc2

File tree

7 files changed

+108
-50
lines changed

7 files changed

+108
-50
lines changed

‎compiler/core/embed_rewrite.ml‎

Lines changed: 20 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -84,12 +84,11 @@ let rewrite_structure (entries : map_entry list) (ast : structure) : structure =
8484
| _ -> None)
8585
| _ -> None
8686
in
87-
let open Ast_helper in
88-
let rec map_mod (m : module_expr) : module_expr =
87+
let module_expr (self : Ast_mapper.mapper) (m : module_expr) : module_expr =
8988
match m.pmod_desc with
9089
| Pmod_extension (({txt = tag; _} as name_loc), payload) -> (
9190
match string_lit_of_payload payload with
92-
| None -> m
91+
| None -> Ast_mapper.default_mapper.module_expr self m
9392
| Some s -> (
9493
match Hashtbl.find_opt index tag with
9594
| None ->
@@ -108,18 +107,15 @@ let rewrite_structure (entries : map_entry list) (ast : structure) : structure =
108107
Location.raise_errorf ~loc:name_loc.loc
109108
"EMBED_MAP_MISMATCH: hash mismatch for tag %s occurrence %d" tag
110109
k;
111-
Mod.ident ~loc:m.pmod_loc
112-
{txt = Lident entry.target_module; loc = m.pmod_loc})))
113-
| Pmod_structure s -> Mod.structure ~loc:m.pmod_loc (map_str s)
114-
| Pmod_functor (n, mt, body) ->
115-
Mod.functor_ ~loc:m.pmod_loc n mt (map_mod body)
116-
| Pmod_apply (m1, m2) -> Mod.apply ~loc:m.pmod_loc (map_mod m1) (map_mod m2)
117-
| _ -> m
118-
and map_expr (e : expression) : expression =
110+
Ast_helper.Mod.ident ~loc:m.pmod_loc
111+
{txt = Longident.Lident entry.target_module; loc = m.pmod_loc})))
112+
| _ -> Ast_mapper.default_mapper.module_expr self m
113+
in
114+
let expr (self : Ast_mapper.mapper) (e : expression) : expression =
119115
match e.pexp_desc with
120116
| Pexp_extension (({txt = tag; _} as name_loc), payload) -> (
121117
match string_lit_of_payload payload with
122-
| None -> e
118+
| None -> Ast_mapper.default_mapper.expr self e
123119
| Some s -> (
124120
match Hashtbl.find_opt index tag with
125121
| None ->
@@ -138,44 +134,19 @@ let rewrite_structure (entries : map_entry list) (ast : structure) : structure =
138134
Location.raise_errorf ~loc:name_loc.loc
139135
"EMBED_MAP_MISMATCH: hash mismatch for tag %s occurrence %d" tag
140136
k;
141-
let id =
142-
Exp.ident ~loc:e.pexp_loc
143-
{
144-
txt = Longident.Ldot (Lident entry.target_module, "default");
145-
loc = e.pexp_loc;
146-
}
147-
in
148-
id)))
149-
| _ -> e
150-
and map_str (s : structure) : structure =
151-
List.map
152-
(fun (si : structure_item) ->
153-
match si.pstr_desc with
154-
| Pstr_include incl ->
155-
let m' = map_mod incl.pincl_mod in
156-
if m' == incl.pincl_mod then si
157-
else Str.include_ ~loc:si.pstr_loc {incl with pincl_mod = m'}
158-
| Pstr_module mb ->
159-
let m' = map_mod mb.pmb_expr in
160-
if m' == mb.pmb_expr then si
161-
else Str.module_ ~loc:si.pstr_loc {mb with pmb_expr = m'}
162-
| Pstr_recmodule mbs ->
163-
let mbs' =
164-
List.map (fun mb -> {mb with pmb_expr = map_mod mb.pmb_expr}) mbs
165-
in
166-
Str.rec_module ~loc:si.pstr_loc mbs'
167-
| Pstr_value (recflag, vbs) ->
168-
let vbs' =
169-
List.map (fun vb -> {vb with pvb_expr = map_expr vb.pvb_expr}) vbs
170-
in
171-
Str.value ~loc:si.pstr_loc recflag vbs'
172-
| Pstr_eval (e, _attrs) ->
173-
let e' = map_expr e in
174-
if e' == e then si else Str.eval ~loc:si.pstr_loc e'
175-
| _ -> si)
176-
s
137+
Ast_helper.Exp.ident ~loc:e.pexp_loc
138+
{
139+
txt =
140+
Longident.Ldot
141+
(Longident.Lident entry.target_module, "default");
142+
loc = e.pexp_loc;
143+
})))
144+
| _ -> Ast_mapper.default_mapper.expr self e
145+
in
146+
let mapper : Ast_mapper.mapper =
147+
{Ast_mapper.default_mapper with expr; module_expr}
177148
in
178-
map_str ast
149+
mapper.Ast_mapper.structure mapper ast
179150

180151
let write_ast_impl ~output (ast : structure) =
181152
let sourcefile = !Location.input_name in

‎rewatch/tests/embeds-nested-compiler.sh‎

Lines changed: 65 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,65 @@
1+
#!/bin/bash
2+
set -euo pipefail
3+
4+
cd "$(dirname "$0")"
5+
source ./utils.sh
6+
7+
bold "Embeds (compiler-only): nested expressions rewrite"
8+
9+
SRCDIR="./fixtures/embeds_nested/src"
10+
BUILDDIR="./_tmp_embeds_nested/build/src"
11+
mkdir -p "$BUILDDIR"
12+
13+
# 1) Emit AST + index
14+
"$RESCRIPT_BSC_EXE" -bs-ast -o "$BUILDDIR/Foo" -embeds sql.one "$SRCDIR/Foo.res" >/dev/null 2>&1 || true
15+
16+
# Extract both literalHash values in order (occurrenceIndex 1..N)
17+
LITERAL_HASH_1=$(sed -n 's/.*"literalHash"[[:space:]]*:[[:space:]]*"\([a-f0-9]\{32\}\)".*/\1/p' "$BUILDDIR/Foo.embeds.json" | sed -n '1p')
18+
LITERAL_HASH_2=$(sed -n 's/.*"literalHash"[[:space:]]*:[[:space:]]*"\([a-f0-9]\{32\}\)".*/\1/p' "$BUILDDIR/Foo.embeds.json" | sed -n '2p')
19+
20+
# 2) Create resolution map for both embeds and run rewrite
21+
cat > "$BUILDDIR/Foo.embeds.map.json" <<MAP
22+
{
23+
"version": 1,
24+
"module": "Foo",
25+
"entries": [
26+
{
27+
"tag": "sql.one",
28+
"occurrenceIndex": 1,
29+
"literalHash": "$LITERAL_HASH_1",
30+
"targetModule": "Foo__embed_sql_one_A"
31+
},
32+
{
33+
"tag": "sql.one",
34+
"occurrenceIndex": 2,
35+
"literalHash": "$LITERAL_HASH_2",
36+
"targetModule": "Foo__embed_sql_one_B"
37+
}
38+
]
39+
}
40+
MAP
41+
42+
"$RESCRIPT_BSC_EXE" -rewrite-embeds -ast "$BUILDDIR/Foo.ast" -map "$BUILDDIR/Foo.embeds.map.json" -o "$BUILDDIR/Foo.ast" >/dev/null 2>&1
43+
44+
# 3) Snapshot index + rewritten source
45+
SNAPSHOT="../tests/snapshots/embeds-nested-basic.txt"
46+
{
47+
echo '=== Foo.embeds.json ==='
48+
cat "$BUILDDIR/Foo.embeds.json"
49+
echo
50+
echo '=== Rewritten Source ==='
51+
"$RESCRIPT_BSC_EXE" -only-parse -dsource "$BUILDDIR/Foo.ast" 2>/dev/null || true
52+
} > "$SNAPSHOT"
53+
54+
normalize_paths "$SNAPSHOT"
55+
56+
if git diff --exit-code ../tests/snapshots/embeds-nested-basic.txt &> /dev/null;
57+
then
58+
success "Embeds (compiler-only) nested rewrite OK"
59+
else
60+
error "Embeds (compiler-only) nested snapshot changed"
61+
bold ../tests/snapshots/embeds-nested-basic.txt
62+
git --no-pager diff ../tests/snapshots/embeds-nested-basic.txt ../tests/snapshots/embeds-nested-basic.txt
63+
exit 1
64+
fi
65+

‎rewatch/tests/fixtures/embeds_nested/rescript.json‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
{
2+
"name": "embeds-nested-fixture",
3+
"sources": [ { "dir": "src", "subdirs": true } ]
4+
}
5+

‎rewatch/tests/fixtures/embeds_nested/src/Foo.res‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
let b = foo(%sql.one("/* @name A */ select 1"), %sql.one("/* @name B */ select 2"))
2+

‎rewatch/tests/snapshots/embeds-nested-basic.txt‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
=== Foo.embeds.json ===
2+
{ "embeds" : [ { "tag" : "sql.one" , "range" : { "end" : { "line" : 1 , "column" : 45 } , "start" : { "line" : 1 , "column" : 21 } } , "context" : "expr" , "embedString" : "/* @name A */ select 1" , "literalHash" : "040b7e3d20321295fb092cda36a6c4e0" , "occurrenceIndex" : 1 } , { "tag" : "sql.one" , "range" : { "end" : { "line" : 1 , "column" : 81 } , "start" : { "line" : 1 , "column" : 57 } } , "context" : "expr" , "embedString" : "/* @name B */ select 2" , "literalHash" : "582f4f09f01b4ab3197ab897eb3674aa" , "occurrenceIndex" : 2 } ] , "module" : "Foo" , "version" : 1 , "sourcePath" : "./fixtures/embeds_nested/src/Foo.res" }
3+
=== Rewritten Source ===

‎rewatch/tests/suite-ci.sh‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -44,4 +44,4 @@ else
4444
exit 1
4545
fi
4646

47-
./compile.sh && ./watch.sh && ./lock.sh && ./suffix.sh && ./format.sh && ./clean.sh && ./experimental.sh && ./experimental-invalid.sh && ./compiler-args.sh && ./embeds-compiler.sh && ./embeds.sh && ./embeds-cache.sh && ./embeds-diags.sh
47+
./compile.sh && ./watch.sh && ./lock.sh && ./suffix.sh && ./format.sh && ./clean.sh && ./experimental.sh && ./experimental-invalid.sh && ./compiler-args.sh && ./embeds-compiler.sh && ./embeds-nested-compiler.sh && ./embeds.sh && ./embeds-cache.sh && ./embeds-diags.sh

‎rewatch/tests/utils.sh‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -32,12 +32,24 @@ normalize_paths() {
3232
if [[ $OSTYPE == 'darwin'* ]];
3333
then
3434
sed -i '' "s#$(pwd_prefix)##g" $1;
35+
# Normalize leading './' before '../' segments (Windows-only quirk)
36+
# Examples:
37+
# src=./../../foo -> src=../../foo
38+
# "sourcePath": "./../../foo" -> "sourcePath": "../../foo"
39+
sed -i '' -E 's#(src=)\./(\.\./)#\1\2#g' $1;
40+
sed -i '' -E 's#("sourcePath"[[:space:]]*:[[:space:]]*")\./(\.\./)#\1\2#g' $1;
3541
else
3642
if is_windows; then
3743
sed -i "s#$(pwd_prefix)##g" $1
3844
sed -i "s#\\\\#/#g" $1
45+
# Normalize leading './' before '../' segments
46+
sed -i -E 's#(src=)\./(\.\./)#\1\2#g' $1
47+
sed -i -E 's#("sourcePath"[[:space:]]*:[[:space:]]*")\./(\.\./)#\1\2#g' $1
3948
else
4049
sed -i "s#$(pwd_prefix)##g" $1;
50+
# Normalize leading './' before '../' segments
51+
sed -i -E 's#(src=)\./(\.\./)#\1\2#g' $1
52+
sed -i -E 's#("sourcePath"[[:space:]]*:[[:space:]]*")\./(\.\./)#\1\2#g' $1
4153
fi
4254
fi
4355
}

0 commit comments

Comments
 (0)