Skip to content

Commit da9a11f

Browse files
cristianoccristianoc
committed
GenType: removed support for @genType.as which has become unnecessary.
1 parent 273c4f4 commit da9a11f

34 files changed

+184
-241
lines changed

‎CHANGELOG.md

+1
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,7 @@ These are only breaking changes for unformatted code.
4646
- Remove deprecated module `Printexc`
4747
- `@deriving(jsConverter)` not supported anymore for variant types https://github.com/rescript-lang/rescript-compiler/pull/6088
4848
- New representation for variants, where the tag is a string instead of a number. https://github.com/rescript-lang/rescript-compiler/pull/6088
49+
- GenType: removed support for `@genType.as` for records and variants which has become unnecessary. Use the language's `@as` instead to channge the runtime representation without requiring any runtime conversion during FFI.
4950

5051
#### :bug: Bug Fix
5152

‎Makefile

+2-2
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ bench:
1313
$(DUNE_BIN_DIR)/syntax_benchmarks
1414

1515
dce:
16-
reanalyze.exe -- -dce-cmt _build
16+
reanalyze.exe -dce-cmt _build/default/jscomp
1717

1818
ninja/ninja:
1919
./scripts/buildNinjaBinary.js
@@ -42,7 +42,7 @@ test-gentype:
4242
test-all: test test-gentype
4343

4444
reanalyze:
45-
reanalyze.exe -set-exit-code -all-cmt _build/default/res_syntax -suppress res_syntax/testrunner
45+
reanalyze.exe -set-exit-code -all-cmt _build/default/jscomp -suppress res_syntax/testrunner -exclude-paths jscomp/super_errors,jscomp/outcome_printer,jscomp/ounit_tests,jscomp/ml,jscomp/js_parser,jscomp/frontend,jscomp/ext,jscomp/depends,jscomp/core,jscomp/common,jscomp/cmij,jscomp/bsb_helper,jscomp/bsb
4646

4747
lib: build node_modules/.bin/semver
4848
node scripts/ninja.js config

‎jscomp/gentype/Annotation.ml

+52-28
Original file line numberDiff line numberDiff line change
@@ -64,65 +64,89 @@ let rec getAttributePayload checkText (attributes : Typedtree.attributes) =
6464
in
6565
match attributes with
6666
| [] -> None
67-
| ({Asttypes.txt}, payload) :: _tl when checkText txt -> (
67+
| ({txt; loc}, payload) :: _tl when checkText txt -> (
68+
let payload =
69+
match payload with
70+
| PStr [] -> Some UnrecognizedPayload
71+
| PStr ({pstr_desc = Pstr_eval (expr, _)} :: _) -> expr |> fromExpr
72+
| PStr ({pstr_desc = Pstr_extension _} :: _) -> Some UnrecognizedPayload
73+
| PStr ({pstr_desc = Pstr_value _} :: _) -> Some UnrecognizedPayload
74+
| PStr ({pstr_desc = Pstr_primitive _} :: _) -> Some UnrecognizedPayload
75+
| PStr ({pstr_desc = Pstr_type _} :: _) -> Some UnrecognizedPayload
76+
| PStr ({pstr_desc = Pstr_typext _} :: _) -> Some UnrecognizedPayload
77+
| PStr ({pstr_desc = Pstr_exception _} :: _) -> Some UnrecognizedPayload
78+
| PStr ({pstr_desc = Pstr_module _} :: _) -> Some UnrecognizedPayload
79+
| PStr ({pstr_desc = Pstr_recmodule _} :: _) -> Some UnrecognizedPayload
80+
| PStr ({pstr_desc = Pstr_modtype _} :: _) -> Some UnrecognizedPayload
81+
| PStr ({pstr_desc = Pstr_open _} :: _) -> Some UnrecognizedPayload
82+
| PStr ({pstr_desc = Pstr_class _} :: _) -> Some UnrecognizedPayload
83+
| PStr ({pstr_desc = Pstr_class_type _} :: _) -> Some UnrecognizedPayload
84+
| PStr ({pstr_desc = Pstr_include _} :: _) -> Some UnrecognizedPayload
85+
| PStr ({pstr_desc = Pstr_attribute _} :: _) -> Some UnrecognizedPayload
86+
| PPat _ -> Some UnrecognizedPayload
87+
| PSig _ -> Some UnrecognizedPayload
88+
| PTyp _ -> Some UnrecognizedPayload
89+
in
6890
match payload with
69-
| PStr [] -> Some UnrecognizedPayload
70-
| PStr ({pstr_desc = Pstr_eval (expr, _)} :: _) -> expr |> fromExpr
71-
| PStr ({pstr_desc = Pstr_extension _} :: _) -> Some UnrecognizedPayload
72-
| PStr ({pstr_desc = Pstr_value _} :: _) -> Some UnrecognizedPayload
73-
| PStr ({pstr_desc = Pstr_primitive _} :: _) -> Some UnrecognizedPayload
74-
| PStr ({pstr_desc = Pstr_type _} :: _) -> Some UnrecognizedPayload
75-
| PStr ({pstr_desc = Pstr_typext _} :: _) -> Some UnrecognizedPayload
76-
| PStr ({pstr_desc = Pstr_exception _} :: _) -> Some UnrecognizedPayload
77-
| PStr ({pstr_desc = Pstr_module _} :: _) -> Some UnrecognizedPayload
78-
| PStr ({pstr_desc = Pstr_recmodule _} :: _) -> Some UnrecognizedPayload
79-
| PStr ({pstr_desc = Pstr_modtype _} :: _) -> Some UnrecognizedPayload
80-
| PStr ({pstr_desc = Pstr_open _} :: _) -> Some UnrecognizedPayload
81-
| PStr ({pstr_desc = Pstr_class _} :: _) -> Some UnrecognizedPayload
82-
| PStr ({pstr_desc = Pstr_class_type _} :: _) -> Some UnrecognizedPayload
83-
| PStr ({pstr_desc = Pstr_include _} :: _) -> Some UnrecognizedPayload
84-
| PStr ({pstr_desc = Pstr_attribute _} :: _) -> Some UnrecognizedPayload
85-
| PPat _ -> Some UnrecognizedPayload
86-
| PSig _ -> Some UnrecognizedPayload
87-
| PTyp _ -> Some UnrecognizedPayload)
91+
| None -> None
92+
| Some payload -> Some (loc, payload))
8893
| _hd :: tl -> getAttributePayload checkText tl
8994

9095
let getGenTypeAsRenaming attributes =
9196
match attributes |> getAttributePayload tagIsGenTypeAs with
92-
| Some (StringPayload s) -> Some s
97+
| Some (_, StringPayload s) -> Some s
9398
| None -> (
9499
match attributes |> getAttributePayload tagIsGenType with
95-
| Some (StringPayload s) -> Some s
100+
| Some (_, StringPayload s) -> Some s
96101
| _ -> None)
97102
| _ -> None
98103

104+
(* This is not supported anymore: only use to give a warning *)
105+
let checkUnsupportedGenTypeAsRenaming attributes =
106+
let error ~loc =
107+
Log_.Color.setup ();
108+
Log_.info ~loc ~name:"Warning genType" (fun ppf () ->
109+
Format.fprintf ppf
110+
"@\n\
111+
@genType.as is not supported anymore in type definitions. Use @as \
112+
from the language.")
113+
in
114+
match attributes |> getAttributePayload tagIsGenTypeAs with
115+
| Some (loc, _) -> error ~loc
116+
| None -> (
117+
match attributes |> getAttributePayload tagIsGenType with
118+
| Some (loc, _) -> error ~loc
119+
| None -> ())
120+
99121
let getBsAsRenaming attributes =
100122
match attributes |> getAttributePayload tagIsBsAs with
101-
| Some (StringPayload s) -> Some s
123+
| Some (_, StringPayload s) -> Some s
102124
| _ -> None
103125

104126
let getBsAsInt attributes =
105127
match attributes |> getAttributePayload tagIsBsAs with
106-
| Some (IntPayload s) -> (
128+
| Some (_, IntPayload s) -> (
107129
try Some (int_of_string s) with Failure _ -> None)
108130
| _ -> None
109131

110132
let getAttributeImportRenaming attributes =
111133
let attributeImport = attributes |> getAttributePayload tagIsGenTypeImport in
112134
let genTypeAsRenaming = attributes |> getGenTypeAsRenaming in
113135
match (attributeImport, genTypeAsRenaming) with
114-
| Some (StringPayload importString), _ ->
136+
| Some (_, StringPayload importString), _ ->
115137
(Some importString, genTypeAsRenaming)
116138
| ( Some
117-
(TuplePayload [StringPayload importString; StringPayload renameString]),
139+
( _,
140+
TuplePayload [StringPayload importString; StringPayload renameString]
141+
),
118142
_ ) ->
119143
(Some importString, Some renameString)
120144
| _ -> (None, genTypeAsRenaming)
121145

122146
let getDocString attributes =
123147
let docPayload = attributes |> getAttributePayload tagIsOcamlDoc in
124148
match docPayload with
125-
| Some (StringPayload docString) -> "/** " ^ docString ^ " */\n"
149+
| Some (_, StringPayload docString) -> "/** " ^ docString ^ " */\n"
126150
| _ -> ""
127151

128152
let hasAttribute checkText (attributes : Typedtree.attributes) =
@@ -133,7 +157,7 @@ let fromAttributes ~loc (attributes : Typedtree.attributes) =
133157
else if hasAttribute (fun s -> tagIsGenType s || tagIsGenTypeAs s) attributes
134158
then (
135159
(match attributes |> getAttributePayload tagIsGenType with
136-
| Some UnrecognizedPayload -> ()
160+
| Some (_, UnrecognizedPayload) -> ()
137161
| Some _ ->
138162
Log_.Color.setup ();
139163
Log_.info ~loc ~name:"Warning genType" (fun ppf () ->

‎jscomp/gentype/Converter.ml

+3-10
Original file line numberDiff line numberDiff line change
@@ -198,10 +198,10 @@ let typeGetConverterNormalized ~config ~inline ~lookupId ~typeNameIsInterface
198198
in
199199
( ObjectC
200200
(fieldsConverted
201-
|> List.map (fun ({nameJS; nameRE; optional}, (converter, _)) ->
201+
|> List.map (fun ({nameJS; optional}, (converter, _)) ->
202202
{
203203
lblJS = nameJS;
204-
lblRE = nameRE;
204+
lblRE = nameJS;
205205
c =
206206
(match optional = Mandatory with
207207
| true -> converter
@@ -357,14 +357,7 @@ let rec converterIsIdentity ~config ~toJS converter =
357357
argConverter |> converterIsIdentity ~config ~toJS:(not toJS)
358358
| GroupConverter _ -> false)
359359
| IdentC -> true
360-
| ObjectC fieldsC ->
361-
fieldsC
362-
|> List.for_all (fun {lblJS; lblRE; c} ->
363-
lblJS = lblRE
364-
&&
365-
match c with
366-
| OptionC c1 -> c1 |> converterIsIdentity ~config ~toJS
367-
| _ -> c |> converterIsIdentity ~config ~toJS)
360+
| ObjectC _ -> true
368361
| OptionC c -> c |> converterIsIdentity ~config ~toJS
369362
| PromiseC c -> c |> converterIsIdentity ~config ~toJS
370363
| TupleC innerTypesC ->

‎jscomp/gentype/EmitJs.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -81,7 +81,7 @@ let emitExportType ~emitters ~config ~typeGetNormalized ~typeNameIsInterface
8181
Log_.Color.setup ();
8282
Log_.info ~loc ~name:"Warning genType" (fun ppf () ->
8383
Format.fprintf ppf
84-
"GADT types are not supported: exporting %s as opaque type"
84+
"@\nGADT types are not supported: exporting %s as opaque type"
8585
(resolvedTypeName |> ResolvedName.toString));
8686
Some true
8787
| _ -> opaque

‎jscomp/gentype/EmitType.ml

+2-4
Original file line numberDiff line numberDiff line change
@@ -60,16 +60,15 @@ let typeReactRef ~type_ =
6060
{
6161
mutable_ = Mutable;
6262
nameJS = reactRefCurrent;
63-
nameRE = reactRefCurrent;
6463
optional = Mandatory;
6564
type_ = Null type_;
6665
};
6766
] )
6867

6968
let isTypeReactRef ~fields =
7069
match fields with
71-
| [{mutable_ = Mutable; nameJS; nameRE; optional = Mandatory}] ->
72-
nameJS == reactRefCurrent && nameJS == nameRE
70+
| [{mutable_ = Mutable; nameJS; optional = Mandatory}] ->
71+
nameJS == reactRefCurrent
7372
| _ -> false
7473

7574
let isTypeFunctionComponent ~fields type_ =
@@ -182,7 +181,6 @@ let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface
182181
{
183182
mutable_ = Mutable;
184183
nameJS = name;
185-
nameRE = name;
186184
optional = Mandatory;
187185
type_ = TypeVar value;
188186
}

‎jscomp/gentype/ExportModule.ml

-1
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,6 @@ and exportModuleItemToFields =
5656
{
5757
mutable_ = Mutable;
5858
nameJS = fieldName;
59-
nameRE = fieldName;
6059
optional = Mandatory;
6160
type_ = typeForType;
6261
}

‎jscomp/gentype/GenTypeCommon.ml

-1
Original file line numberDiff line numberDiff line change
@@ -78,7 +78,6 @@ and argType = {aName: string; aType: type_}
7878
and field = {
7979
mutable_: mutable_;
8080
nameJS: string;
81-
nameRE: string;
8281
optional: optional;
8382
type_: type_;
8483
}

‎jscomp/gentype/GenTypeMain.ml

+1
Original file line numberDiff line numberDiff line change
@@ -168,3 +168,4 @@ let processCmtFile cmt =
168168
else (
169169
outputFile |> GeneratedFiles.logFileAction NoMatch;
170170
if Sys.file_exists outputFile then Sys.remove outputFile)
171+
[@@live]

‎jscomp/gentype/NamedArgs.ml

+2-14
Original file line numberDiff line numberDiff line change
@@ -14,25 +14,13 @@ let rec groupReversed ~revCurGroup ~revResult labeledTypes =
1414
(* Add it to the current group, not result. *)
1515
groupReversed
1616
~revCurGroup:
17-
({
18-
mutable_ = Immutable;
19-
nameJS = name;
20-
nameRE = name;
21-
optional = Optional;
22-
type_;
23-
}
17+
({mutable_ = Immutable; nameJS = name; optional = Optional; type_}
2418
:: revCurGroup)
2519
~revResult tl
2620
| _, (Label name, type_) :: tl ->
2721
groupReversed
2822
~revCurGroup:
29-
({
30-
mutable_ = Immutable;
31-
nameJS = name;
32-
nameRE = name;
33-
optional = Mandatory;
34-
type_;
35-
}
23+
({mutable_ = Immutable; nameJS = name; optional = Mandatory; type_}
3624
:: revCurGroup)
3725
~revResult tl
3826
| [], [] -> revResult

‎jscomp/gentype/Paths.ml

-23
Original file line numberDiff line numberDiff line change
@@ -62,27 +62,4 @@ let getBsConfigFile ~projectRoot =
6262
| true -> Some bsconfig
6363
| false -> None
6464

65-
(** Find the relative path from /.../bs/lib
66-
e.g. /foo/bar/bs/lib/src/Hello.res --> src/Hello.res *)
67-
let relativePathFromBsLib fileName =
68-
if Filename.is_relative fileName then fileName
69-
else
70-
let rec pathToList path =
71-
let isRoot = path |> Filename.basename = path in
72-
match isRoot with
73-
| true -> [path]
74-
| false ->
75-
(path |> Filename.basename) :: (path |> Filename.dirname |> pathToList)
76-
in
77-
let rec fromLibBs ~acc reversedList =
78-
match reversedList with
79-
| "bs" :: "lib" :: _ -> acc
80-
| dir :: dirs -> fromLibBs ~acc:(dir :: acc) dirs
81-
| [] -> []
82-
in
83-
fileName |> pathToList |> fromLibBs ~acc:[] |> fun l ->
84-
match l with
85-
| [] -> fileName
86-
| root :: dirs -> dirs |> List.fold_left concat root
87-
8865
let readConfig ~namespace = Config.readConfig ~getBsConfigFile ~namespace

‎jscomp/gentype/TranslateCoreType.ml

+1-6
Original file line numberDiff line numberDiff line change
@@ -93,12 +93,7 @@ let rec translateArrowType ~config ~typeVarsGen ~noFunctionReturnDependencies
9393
|> translateArrowType ~config ~typeVarsGen ~noFunctionReturnDependencies
9494
~typeEnv ~revArgDeps:nextRevDeps
9595
~revArgs:
96-
(( OptLabel
97-
(match asLabel = "" with
98-
| true -> lbl |> Runtime.mangleObjectField
99-
| false -> asLabel),
100-
type1 )
101-
:: revArgs))
96+
((OptLabel (lbl |> Runtime.mangleObjectField), type1) :: revArgs))
10297
| _ ->
10398
let {dependencies; type_ = retType} =
10499
coreType |> translateCoreType_ ~config ~typeVarsGen ~typeEnv

‎jscomp/gentype/TranslateStructure.ml

+3-3
Original file line numberDiff line numberDiff line change
@@ -44,11 +44,11 @@ and addAnnotationsToFields ~config (expr : Typedtree.expression)
4444
let nextFields1, types1 =
4545
addAnnotationsToFields ~config c_rhs nextFields argTypes
4646
in
47-
let nameJS, nameRE =
47+
let name =
4848
TranslateTypeDeclarations.renameRecordField
49-
~attributes:expr.exp_attributes ~nameRE:field.nameRE
49+
~attributes:expr.exp_attributes ~name:field.nameJS
5050
in
51-
({field with nameJS; nameRE} :: nextFields1, types1)
51+
({field with nameJS = name} :: nextFields1, types1)
5252
| _ -> (fields, argTypes)
5353

5454
(** Recover from expr the renaming annotations on named arguments. *)

0 commit comments

Comments
 (0)