diff --git a/jscomp/snapshot.ninja b/jscomp/snapshot.ninja index cd3200e6b9..48ae2a6cb9 100644 --- a/jscomp/snapshot.ninja +++ b/jscomp/snapshot.ninja @@ -47,11 +47,11 @@ o $SNAP/unstable/bspack.ml: bspack | ./bin/bspack.exe $LTO main = Bspack_main o $SNAP/unstable/js_compiler.ml: bspack | ./bin/bspack.exe $LTO - flags = -D BS_BROWSER=true -bs-MD -module-alias Config=Config_whole_compiler -bs-exclude-I config -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I $OCAML_SRC_TYPING -I $OCAML_SRC_BYTECOMP -I $OCAML_SRC_DRIVER -I stubs -I ext -I syntax -I depends -I common -I core -I super_errors -I bsb -I outcome_printer -I js_parser -I main + flags = -D BS_BROWSER=true -bs-MD -module-alias Config=Config_whole_compiler -bs-exclude-I config -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I $OCAML_SRC_TYPING -I $OCAML_SRC_BYTECOMP -I $OCAML_SRC_DRIVER -I stubs -I ext -I napkin -I syntax -I depends -I common -I core -I super_errors -I bsb -I outcome_printer -I js_parser -I main main = Jsoo_main o $SNAP/unstable/js_refmt_compiler.ml: bspack | ./bin/bspack.exe $LTO - flags = -D BS_BROWSER=true -bs-MD -module-alias Config=Config_whole_compiler -bs-exclude-I config -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I $OCAML_SRC_TYPING -I $OCAML_SRC_BYTECOMP -I $OCAML_SRC_DRIVER -I js_parser -I stubs -I ext -I syntax -I depends -I common -I core -I super_errors -I bsb -I outcome_printer -I js_parser -I main -I refmt + flags = -D BS_BROWSER=true -bs-MD -module-alias Config=Config_whole_compiler -bs-exclude-I config -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I $OCAML_SRC_TYPING -I $OCAML_SRC_BYTECOMP -I $OCAML_SRC_DRIVER -I js_parser -I stubs -I ext -I napkin -I syntax -I depends -I common -I core -I super_errors -I bsb -I outcome_printer -I js_parser -I main -I refmt main = Jsoo_refmt_main subninja build.ninja diff --git a/jscomp/syntax/reactjs_jsx_ppx.cppo.ml b/jscomp/syntax/reactjs_jsx_ppx.cppo.ml deleted file mode 100644 index 21ae3fb1bf..0000000000 --- a/jscomp/syntax/reactjs_jsx_ppx.cppo.ml +++ /dev/null @@ -1,974 +0,0 @@ -(* - This is the file that handles turning Reason JSX' agnostic function call into - a ReasonReact-specific function call. Aka, this is a macro, using OCaml's ppx - facilities; https://whitequark.org/blog/2014/04/16/a-guide-to-extension- - points-in-ocaml/ - You wouldn't use this file directly; it's used by BuckleScript's - bsconfig.json. Specifically, there's a field called `react-jsx` inside the - field `reason`, which enables this ppx through some internal call in bsb -*) - -(* - There are two different transforms that can be selected in this file (v2 and v3): - v2: - transform `[@JSX] div(~props1=a, ~props2=b, ~children=[foo, bar], ())` into - `ReactDOMRe.createElement("div", ~props={"props1": 1, "props2": b}, [|foo, - bar|])`. - transform `[@JSX] div(~props1=a, ~props2=b, ~children=foo, ())` into - `ReactDOMRe.createElementVariadic("div", ~props={"props1": 1, "props2": b}, foo)`. - transform the upper-cased case - `[@JSX] Foo.createElement(~key=a, ~ref=b, ~foo=bar, ~children=[], ())` into - `ReasonReact.element(~key=a, ~ref=b, Foo.make(~foo=bar, [||]))` - transform `[@JSX] [foo]` into - `ReactDOMRe.createElement(ReasonReact.fragment, [|foo|])` - v3: - transform `[@JSX] div(~props1=a, ~props2=b, ~children=[foo, bar], ())` into - `ReactDOMRe.createDOMElementVariadic("div", ReactDOMRe.domProps(~props1=1, ~props2=b), [|foo, bar|])`. - transform the upper-cased case - `[@JSX] Foo.createElement(~key=a, ~ref=b, ~foo=bar, ~children=[], ())` into - `React.createElement(Foo.make, Foo.makeProps(~key=a, ~ref=b, ~foo=bar, ()))` - transform the upper-cased case - `[@JSX] Foo.createElement(~foo=bar, ~children=[foo, bar], ())` into - `React.createElementVariadic(Foo.make, Foo.makeProps(~foo=bar, ~children=React.null, ()), [|foo, bar|])` - transform `[@JSX] [foo]` into - `ReactDOMRe.createElement(ReasonReact.fragment, [|foo|])` -*) - -open Ast_helper -open Ast_mapper -open Asttypes -open Parsetree -open Longident - -let rec find_opt p = function - | [] -> None - | x :: l -> if p x then Some x else find_opt p l - - - -let nolabel = Nolabel -let labelled str = Labelled str -let optional str = Optional str -let isOptional str = match str with -| Optional _ -> true -| _ -> false -let isLabelled str = match str with -| Labelled _ -> true -| _ -> false -let getLabel str = match str with -| Optional str | Labelled str -> str -| Nolabel -> "" -let optionIdent = Lident "option" - -let argIsKeyRef = function - | (Labelled ("key" | "ref"), _) | (Optional ("key" | "ref"), _) -> true - | _ -> false -let constantString ~loc str = Ast_helper.Exp.constant ~loc (Pconst_string (str, None)) - - -let safeTypeFromValue valueStr = -let valueStr = getLabel valueStr in -match String.sub valueStr 0 1 with -| "_" -> "T" ^ valueStr -| _ -> valueStr -let keyType loc = Typ.constr ~loc {loc; txt=optionIdent} [Typ.constr ~loc {loc; txt=Lident "string"} []] - -type 'a children = | ListLiteral of 'a | Exact of 'a -type componentConfig = { - propsName: string; -} - -(* if children is a list, convert it to an array while mapping each element. If not, just map over it, as usual *) -let transformChildrenIfListUpper ~loc ~mapper theList = - let rec transformChildren_ theList accum = - (* not in the sense of converting a list to an array; convert the AST - reprensentation of a list to the AST reprensentation of an array *) - match theList with - | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> begin - match accum with - | [singleElement] -> Exact singleElement - | accum -> ListLiteral (List.rev accum |> Exp.array ~loc) - end - | {pexp_desc = Pexp_construct ( - {txt = Lident "::"}, - Some {pexp_desc = Pexp_tuple (v::acc::[])} - )} -> - transformChildren_ acc ((mapper.expr mapper v)::accum) - | notAList -> Exact (mapper.expr mapper notAList) - in - transformChildren_ theList [] - -let transformChildrenIfList ~loc ~mapper theList = - let rec transformChildren_ theList accum = - (* not in the sense of converting a list to an array; convert the AST - reprensentation of a list to the AST reprensentation of an array *) - match theList with - | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> - List.rev accum |> Exp.array ~loc - | {pexp_desc = Pexp_construct ( - {txt = Lident "::"}, - Some {pexp_desc = Pexp_tuple (v::acc::[])} - )} -> - transformChildren_ acc ((mapper.expr mapper v)::accum) - | notAList -> mapper.expr mapper notAList - in - transformChildren_ theList [] - -let extractChildren ?(removeLastPositionUnit=false) ~loc propsAndChildren = - let rec allButLast_ lst acc = match lst with - | [] -> [] - | (Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})::[] -> acc - | (Nolabel, _) :: _rest -> raise (Invalid_argument "JSX: found non-labelled argument before the last position") - | arg::rest -> allButLast_ rest (arg::acc) - in - let allButLast lst = allButLast_ lst [] |> List.rev in - match (List.partition (fun (label, _) -> label = labelled "children") propsAndChildren) with - | ([], props) -> - (* no children provided? Place a placeholder list *) - (Exp.construct ~loc {loc; txt = Lident "[]"} None, if removeLastPositionUnit then allButLast props else props) - | ([(_, childrenExpr)], props) -> - (childrenExpr, if removeLastPositionUnit then allButLast props else props) - | _ -> raise (Invalid_argument "JSX: somehow there's more than one `children` label") - -let unerasableIgnore loc = ({loc; txt = "warning"}, (PStr [Str.eval (Exp.constant (Pconst_string ("-16", None)))])) -let merlinFocus = ({loc = Location.none; txt = "merlin.focus"}, (PStr [])) - -(* Helper method to look up the [@react.component] attribute *) -let hasAttr (loc, _) = - loc.txt = "react.component" - -(* Helper method to filter out any attribute that isn't [@react.component] *) -let otherAttrsPure (loc, _) = - loc.txt <> "react.component" - -(* Iterate over the attributes and try to find the [@react.component] attribute *) -let hasAttrOnBinding {pvb_attributes} = find_opt hasAttr pvb_attributes <> None - -(* Filter the [@react.component] attribute and immutably replace them on the binding *) -let filterAttrOnBinding binding = {binding with pvb_attributes = List.filter otherAttrsPure binding.pvb_attributes} - -(* Finds the name of the variable the binding is assigned to, otherwise raises Invalid_argument *) -let getFnName binding = - match binding with - | {pvb_pat = { - ppat_desc = Ppat_var {txt} - }} -> txt - | _ -> raise (Invalid_argument "react.component calls cannot be destructured.") - -let makeNewBinding binding expression newName = - match binding with - | {pvb_pat = { - ppat_desc = Ppat_var ( ppat_var) - } as pvb_pat} ->{ binding with pvb_pat = { - pvb_pat with - ppat_desc = Ppat_var {ppat_var with txt = newName}; - }; - pvb_expr = expression; - pvb_attributes = [merlinFocus]; - } - | _ -> raise (Invalid_argument "react.component calls cannot be destructured.") - -(* Lookup the value of `props` otherwise raise Invalid_argument error *) -let getPropsNameValue _acc (loc, exp) = - match (loc, exp) with - | ({ txt = Lident "props" }, { pexp_desc = Pexp_ident {txt = Lident str} }) -> { propsName = str } - | ({ txt }, _) -> raise (Invalid_argument ("react.component only accepts props as an option, given: " ^ Longident.last txt)) - -(* Lookup the `props` record or string as part of [@react.component] and store the name for use when rewriting *) -let getPropsAttr payload = - let defaultProps = {propsName = "Props"} in - match payload with - | Some(PStr( - {pstr_desc = Pstr_eval ({ - pexp_desc = Pexp_record (recordFields, None) - }, _)}::_rest - )) -> - List.fold_left getPropsNameValue defaultProps recordFields - | Some(PStr({pstr_desc = Pstr_eval ({pexp_desc = Pexp_ident {txt = Lident "props"}}, _)}::_rest)) -> {propsName = "props"} - | Some(PStr({pstr_desc = Pstr_eval (_, _)}::_rest)) -> raise (Invalid_argument ("react.component accepts a record config with props as an options.")) - | _ -> defaultProps - -(* Plucks the label, loc, and type_ from an AST node *) -let pluckLabelDefaultLocType (label, default, _, _, loc, type_) = (label, default, loc, type_) - -(* Lookup the filename from the location information on the AST node and turn it into a valid module identifier *) -let filenameFromLoc (pstr_loc: Location.t) = - let fileName = match pstr_loc.loc_start.pos_fname with - | "" -> !Location.input_name - | fileName -> fileName - in - let fileName = try - Filename.chop_extension (Filename.basename fileName) - with | Invalid_argument _-> fileName in - let fileName = String.capitalize_ascii fileName in - fileName - -(* Build a string representation of a module name with segments separated by $ *) -let makeModuleName fileName nestedModules fnName = - let fullModuleName = match (fileName, nestedModules, fnName) with - (* TODO: is this even reachable? It seems like the fileName always exists *) - | ("", nestedModules, "make") -> nestedModules - | ("", nestedModules, fnName) -> List.rev (fnName :: nestedModules) - | (fileName, nestedModules, "make") -> fileName :: (List.rev nestedModules) - | (fileName, nestedModules, fnName) -> fileName :: (List.rev (fnName :: nestedModules)) - in - let fullModuleName = String.concat "$" fullModuleName in - fullModuleName - -(* - AST node builders - These functions help us build AST nodes that are needed when transforming a [@react.component] into a - constructor and a props external -*) - -(* Build an AST node representing all named args for the `external` definition for a component's props *) -let rec recursivelyMakeNamedArgsForExternal list args = - match list with - | (label, default, loc, interiorType)::tl -> - recursivelyMakeNamedArgsForExternal tl (Typ.arrow - ~loc - label - (match (label, interiorType, default) with - (* ~foo=1 *) - | (label, None, Some _) -> - { - ptyp_desc = Ptyp_var (safeTypeFromValue label); - ptyp_loc = loc; - ptyp_attributes = []; - } - (* ~foo: int=1 *) - | (_label, Some type_, Some _) -> - type_ - - (* ~foo: option(int)=? *) - | (label, Some ({ptyp_desc = Ptyp_constr ({txt=(Lident "option")}, [type_])}), _) - | (label, Some ({ptyp_desc = Ptyp_constr ({txt=(Ldot (Lident "*predef*", "option"))}, [type_])}), _) - (* ~foo: int=? - note this isnt valid. but we want to get a type error *) - | (label, Some type_, _) when isOptional label -> - type_ - (* ~foo=? *) - | (label, None, _) when isOptional label -> - { - ptyp_desc = Ptyp_var (safeTypeFromValue label); - ptyp_loc = loc; - ptyp_attributes = []; - } - - (* ~foo *) - | (label, None, _) -> - { - ptyp_desc = Ptyp_var (safeTypeFromValue label); - ptyp_loc = loc; - ptyp_attributes = []; - } - | (_label, Some type_, _) -> - type_ - ) - args) - | [] -> args - -(* Build an AST node for the [@bs.obj] representing props for a component *) -let makePropsValue fnName loc namedArgListWithKeyAndRef propsType = - let propsName = fnName ^ "Props" in { - pval_name = {txt = propsName; loc}; - pval_type = - recursivelyMakeNamedArgsForExternal - namedArgListWithKeyAndRef - (Typ.arrow - nolabel - { - ptyp_desc = Ptyp_constr ({txt= Lident("unit"); loc}, []); - ptyp_loc = loc; - ptyp_attributes = []; - } - propsType - ); - pval_prim = [""]; - pval_attributes = [({txt = "bs.obj"; loc = loc}, PStr [])]; - pval_loc = loc; -} - -(* Build an AST node representing an `external` with the definition of the [@bs.obj] *) -let makePropsExternal fnName loc namedArgListWithKeyAndRef propsType = - { - pstr_loc = loc; - pstr_desc = Pstr_primitive (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) - } - -(* Build an AST node for the signature of the `external` definition *) -let makePropsExternalSig fnName loc namedArgListWithKeyAndRef propsType = - { - psig_loc = loc; - psig_desc = Psig_value (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) - } - -(* Build an AST node for the props name when converted to a Js.t inside the function signature *) -let makePropsName ~loc name = - { - ppat_desc = Ppat_var {txt = name; loc}; - ppat_loc = loc; - ppat_attributes = []; - } - - -let makeObjectField loc (str, attrs, type_) = - Otag ({ loc; txt = str }, attrs, type_) - - -(* Build an AST node representing a "closed" Js.t object representing a component's props *) -let makePropsType ~loc namedTypeList = - Typ.mk ~loc ( - Ptyp_constr({txt= Ldot (Lident("Js"), "t"); loc}, [{ - ptyp_desc = Ptyp_object( - List.map (makeObjectField loc) namedTypeList, - Closed - ); - ptyp_loc = loc; - ptyp_attributes = []; - }]) - ) - -(* Builds an AST node for the entire `external` definition of props *) -let makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList = - makePropsExternal - fnName - loc - (List.map pluckLabelDefaultLocType namedArgListWithKeyAndRef) - (makePropsType ~loc namedTypeList) - -(* TODO: some line number might still be wrong *) -let jsxMapper () = - - let jsxVersion = ref None in - - let transformUppercaseCall3 modulePath mapper loc attrs _ callArguments = - let (children, argsWithLabels) = extractChildren ~loc ~removeLastPositionUnit:true callArguments in - let argsForMake = argsWithLabels in - let childrenExpr = transformChildrenIfListUpper ~loc ~mapper children in - let recursivelyTransformedArgsForMake = argsForMake |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) in - let childrenArg = ref None in - let args = recursivelyTransformedArgsForMake - @ (match childrenExpr with - | Exact children -> [(labelled "children", children)] - | ListLiteral ({ pexp_desc = Pexp_array list }) when list = [] -> [] - | ListLiteral expression -> - (* this is a hack to support react components that introspect into their children *) - (childrenArg := Some expression; - [(labelled "children", Exp.ident ~loc {loc; txt = Ldot (Lident "React", "null")})])) - @ [(nolabel, Exp.construct ~loc {loc; txt = Lident "()"} None)] in - let isCap str = let first = String.sub str 0 1 in - let capped = String.uppercase_ascii first in first = capped in - let ident = match modulePath with - | Lident _ -> Ldot (modulePath, "make") - | (Ldot (_modulePath, value) as fullPath) when isCap value -> Ldot (fullPath, "make") - | modulePath -> modulePath in - let propsIdent = match ident with - | Lident path -> Lident (path ^ "Props") - | Ldot(ident, path) -> Ldot (ident, path ^ "Props") - | _ -> raise (Invalid_argument "JSX name can't be the result of function applications") in - let props = - Exp.apply ~attrs ~loc (Exp.ident ~loc {loc; txt = propsIdent}) args in - (* handle key, ref, children *) - (* React.createElement(Component.make, props, ...children) *) - match (!childrenArg) with - | None -> - (Exp.apply - ~loc - ~attrs - (Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElement")}) - ([ - (nolabel, Exp.ident ~loc {txt = ident; loc}); - (nolabel, props) - ])) - | Some children -> - (Exp.apply - ~loc - ~attrs - (Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElementVariadic")}) - ([ - (nolabel, Exp.ident ~loc {txt = ident; loc}); - (nolabel, props); - (nolabel, children) - ])) - in - - let transformLowercaseCall3 mapper loc attrs callArguments id = - let (children, nonChildrenProps) = extractChildren ~loc callArguments in - let componentNameExpr = constantString ~loc id in - let childrenExpr = transformChildrenIfList ~loc ~mapper children in - let createElementCall = match children with - (* [@JSX] div(~children=[a]), coming from
a
*) - | { - pexp_desc = - Pexp_construct ({txt = Lident "::"}, Some {pexp_desc = Pexp_tuple _ }) - | Pexp_construct ({txt = Lident "[]"}, None) - } -> "createDOMElementVariadic" - (* [@JSX] div(~children= value), coming from
...(value)
*) - | _ -> raise (Invalid_argument "A spread as a DOM element's \ - children don't make sense written together. You can simply remove the spread.") - in - let args = match nonChildrenProps with - | [_justTheUnitArgumentAtEnd] -> - [ - (* "div" *) - (nolabel, componentNameExpr); - (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] - | nonEmptyProps -> - let propsCall = - Exp.apply - ~loc - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "domProps")}) - (nonEmptyProps |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression))) - in - [ - (* "div" *) - (nolabel, componentNameExpr); - (* ReactDOMRe.props(~className=blabla, ~foo=bar, ()) *) - (labelled "props", propsCall); - (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] in - Exp.apply - ~loc - (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs - (* ReactDOMRe.createElement *) - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", createElementCall)}) - args - in - - - - - let rec recursivelyTransformNamedArgsForMake mapper expr list = - let expr = mapper.expr mapper expr in - match expr.pexp_desc with - (* TODO: make this show up with a loc. *) - | Pexp_fun (Labelled "key", _, _, _) - | Pexp_fun (Optional "key", _, _, _) -> raise (Invalid_argument "Key cannot be accessed inside of a component. Don't worry - you can always key a component from its parent!") - | Pexp_fun (Labelled "ref", _, _, _) - | Pexp_fun (Optional "ref", _, _, _) -> raise (Invalid_argument "Ref cannot be passed as a normal prop. Please use `forwardRef` API instead.") - | Pexp_fun (arg, default, pattern, expression) when isOptional arg || isLabelled arg -> - let () = - (match (isOptional arg, pattern, default) with - | (true, { ppat_desc = Ppat_constraint (_, { ptyp_desc })}, None) -> - (match ptyp_desc with - | Ptyp_constr({txt=(Lident "option")}, [_]) -> () - | _ -> - let currentType = (match ptyp_desc with - | Ptyp_constr({txt}, []) -> String.concat "." (Longident.flatten txt) - | Ptyp_constr({txt}, _innerTypeArgs) -> String.concat "." (Longident.flatten txt) ^ "(...)" - | _ -> "...") - in - Location.prerr_warning pattern.ppat_loc - (Preprocessor - (Printf.sprintf "ReasonReact: optional argument annotations must have explicit `option`. Did you mean `option(%s)=?`?" currentType))) - | _ -> ()) in - let alias = (match pattern with - | {ppat_desc = Ppat_alias (_, {txt}) | Ppat_var {txt}} -> txt - | {ppat_desc = Ppat_any} -> "_" - | _ -> getLabel arg) in - let type_ = (match pattern with - | {ppat_desc = Ppat_constraint (_, type_)} -> Some type_ - | _ -> None) in - - recursivelyTransformNamedArgsForMake mapper expression ((arg, default, pattern, alias, pattern.ppat_loc, type_) :: list) - | Pexp_fun (Nolabel, _, { ppat_desc = (Ppat_construct ({txt = Lident "()"}, _) | Ppat_any)}, _expression) -> - (list, None) - | Pexp_fun (Nolabel, _, { ppat_desc = Ppat_var ({txt}) | Ppat_constraint ({ ppat_desc = Ppat_var ({txt})}, _)}, _expression) -> - (list, Some txt) - | Pexp_fun (Nolabel, _, pattern, _expression) -> - Location.raise_errorf ~loc:pattern.ppat_loc "ReasonReact: react.component refs only support plain arguments and type annotations." - | _ -> (list, None) - in - - - let argToType types (name, default, _noLabelName, _alias, loc, type_) = match (type_, name, default) with - | (Some ({ptyp_desc = Ptyp_constr ({txt=(Lident "option")}, [type_])}), name, _) when isOptional name -> - (getLabel name, [], { - type_ with - ptyp_desc = Ptyp_constr ({loc=type_.ptyp_loc; txt=optionIdent}, [type_]); - }) :: types - | (Some type_, name, Some _default) -> - (getLabel name, [], { - ptyp_desc = Ptyp_constr ({loc; txt=optionIdent}, [type_]); - ptyp_loc = loc; - ptyp_attributes = []; - }) :: types - | (Some type_, name, _) -> - (getLabel name, [], type_) :: types - | (None, name, _) when isOptional name -> - (getLabel name, [], { - ptyp_desc = Ptyp_constr ({loc; txt=optionIdent}, [{ - ptyp_desc = Ptyp_var (safeTypeFromValue name); - ptyp_loc = loc; - ptyp_attributes = []; - }]); - ptyp_loc = loc; - ptyp_attributes = []; - }) :: types - | (None, name, _) when isLabelled name -> - (getLabel name, [], { - ptyp_desc = Ptyp_var (safeTypeFromValue name); - ptyp_loc = loc; - ptyp_attributes = []; - }) :: types - | _ -> types - in - - let argToConcreteType types (name, loc, type_) = match name with - | name when isLabelled name -> - (getLabel name, [], type_) :: types - | name when isOptional name -> - (getLabel name, [], Typ.constr ~loc {loc; txt=optionIdent} [type_]) :: types - | _ -> types - in - - let nestedModules = ref([]) in - let transformComponentDefinition mapper structure returnStructures = match structure with - (* external *) - | ({ - pstr_loc; - pstr_desc = Pstr_primitive ({ - pval_name = { txt = fnName }; - pval_attributes; - pval_type; - } as value_description) - } as pstr) -> - (match List.filter hasAttr pval_attributes with - | [] -> structure :: returnStructures - | [_] -> - let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = - (match ptyp_desc with - | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) when isLabelled name || isOptional name -> - getPropTypes ((name, ptyp_loc, type_)::types) rest - | Ptyp_arrow (Nolabel, _type, rest) -> - getPropTypes types rest - | Ptyp_arrow (name, type_, returnValue) when isLabelled name || isOptional name -> - (returnValue, (name, returnValue.ptyp_loc, type_)::types) - | _ -> (fullType, types)) - in - let (innerType, propTypes) = getPropTypes [] pval_type in - let namedTypeList = List.fold_left argToConcreteType [] propTypes in - let pluckLabelAndLoc (label, loc, type_) = (label, None (* default *), loc, Some type_) in - let retPropsType = makePropsType ~loc:pstr_loc namedTypeList in - let externalPropsDecl = makePropsExternal fnName pstr_loc (( - optional "key", - None, - pstr_loc, - Some(keyType pstr_loc) - ) :: List.map pluckLabelAndLoc propTypes) retPropsType in - (* can't be an arrow because it will defensively uncurry *) - let newExternalType = Ptyp_constr ( - {loc = pstr_loc; txt = Ldot ((Lident "React"), "componentLike")}, - [retPropsType; innerType] - ) in - let newStructure = { - pstr with pstr_desc = Pstr_primitive { - value_description with pval_type = { - pval_type with ptyp_desc = newExternalType; - }; - pval_attributes = List.filter otherAttrsPure pval_attributes; - } - } in - externalPropsDecl :: newStructure :: returnStructures - | _ -> raise (Invalid_argument "Only one react.component call can exist on a component at one time")) - (* let component = ... *) - | { - pstr_loc; - pstr_desc = Pstr_value ( - recFlag, - valueBindings - ) - } -> - let fileName = filenameFromLoc pstr_loc in - let emptyLoc = Location.in_file fileName in - let mapBinding binding = if (hasAttrOnBinding binding) then - let bindingLoc = binding.pvb_loc in - let bindingPatLoc = binding.pvb_pat.ppat_loc in - let binding = { binding with pvb_pat = { binding.pvb_pat with ppat_loc = emptyLoc}; pvb_loc = emptyLoc} in - let fnName = getFnName binding in - let internalFnName = fnName ^ "$Internal" in - let fullModuleName = makeModuleName fileName !nestedModules fnName in - let modifiedBindingOld binding = - let expression = binding.pvb_expr in - (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) - let rec spelunkForFunExpression expression = (match expression with - (* let make = (~prop) => ... *) - | { - pexp_desc = Pexp_fun _ - } -> expression - (* let make = {let foo = bar in (~prop) => ...} *) - | { - pexp_desc = Pexp_let (_recursive, _vbs, returnExpression) - } -> - (* here's where we spelunk! *) - spelunkForFunExpression returnExpression - (* let make = React.forwardRef((~prop) => ...) *) - - | { pexp_desc = Pexp_apply (_wrapperExpression, [(Nolabel, innerFunctionExpression)]) } -> - spelunkForFunExpression innerFunctionExpression - | { - pexp_desc = Pexp_sequence (_wrapperExpression, innerFunctionExpression) - } -> - spelunkForFunExpression innerFunctionExpression - | _ -> raise (Invalid_argument "react.component calls can only be on function definitions or component wrappers (forwardRef, memo).") - ) in - spelunkForFunExpression expression - in - let modifiedBinding binding = - let hasApplication = ref(false) in - let wrapExpressionWithBinding expressionFn expression = - Vb.mk - ~loc:bindingLoc - ~attrs:(List.filter otherAttrsPure binding.pvb_attributes) - (Pat.var ~loc:bindingPatLoc {loc = bindingPatLoc; txt = fnName}) (expressionFn expression) in - let expression = binding.pvb_expr in - let unerasableIgnoreExp exp = { exp with pexp_attributes = (unerasableIgnore emptyLoc) :: exp.pexp_attributes } in - (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) - let rec spelunkForFunExpression expression = (match expression with - (* let make = (~prop) => ... with no final unit *) - | { - pexp_desc = Pexp_fun ((Labelled(_) | Optional(_) as label), default, pattern, ({pexp_desc = Pexp_fun _} as internalExpression)) - } -> - let (wrap, hasUnit, exp) = spelunkForFunExpression internalExpression in - (wrap, hasUnit, unerasableIgnoreExp {expression with pexp_desc = Pexp_fun (label, default, pattern, exp)}) - (* let make = (()) => ... *) - (* let make = (_) => ... *) - | { - pexp_desc = Pexp_fun (Nolabel, _default, { ppat_desc = Ppat_construct ({txt = Lident "()"}, _) | Ppat_any}, _internalExpression) - } -> ((fun a -> a), true, expression) - (* let make = (~prop) => ... *) - | { - pexp_desc = Pexp_fun ((Labelled(_) | Optional(_)), _default, _pattern, _internalExpression) - } -> ((fun a -> a), false, unerasableIgnoreExp expression) - (* let make = (prop) => ... *) - | { - pexp_desc = Pexp_fun (_nolabel, _default, pattern, _internalExpression) - } -> - if (hasApplication.contents) then - ((fun a -> a), false, unerasableIgnoreExp expression) - else - Location.raise_errorf ~loc:pattern.ppat_loc "ReasonReact: props need to be labelled arguments.\n If you are working with refs be sure to wrap with React.forwardRef.\n If your component doesn't have any props use () or _ instead of a name." - (* let make = {let foo = bar in (~prop) => ...} *) - | { - pexp_desc = Pexp_let (recursive, vbs, internalExpression) - } -> - (* here's where we spelunk! *) - let (wrap, hasUnit, exp) = spelunkForFunExpression internalExpression in - (wrap, hasUnit, {expression with pexp_desc = Pexp_let (recursive, vbs, exp)}) - (* let make = React.forwardRef((~prop) => ...) *) - | { pexp_desc = Pexp_apply (wrapperExpression, [(Nolabel, internalExpression)]) } -> - let () = hasApplication := true in - let (_, hasUnit, exp) = spelunkForFunExpression internalExpression in - ((fun exp -> Exp.apply wrapperExpression [(nolabel, exp)]), hasUnit, exp) - | { - pexp_desc = Pexp_sequence (wrapperExpression, internalExpression) - } -> - let (wrap, hasUnit, exp) = spelunkForFunExpression internalExpression in - (wrap, hasUnit, {expression with pexp_desc = Pexp_sequence (wrapperExpression, exp)}) - | e -> ((fun a -> a), false, e) - ) in - let (wrapExpression, hasUnit, expression) = spelunkForFunExpression expression in - (wrapExpressionWithBinding wrapExpression, hasUnit, expression) - in - let (bindingWrapper, hasUnit, expression) = modifiedBinding binding in - let reactComponentAttribute = try - Some(List.find hasAttr binding.pvb_attributes) - with | Not_found -> None in - let (_attr_loc, payload) = match reactComponentAttribute with - | Some (loc, payload) -> (loc.loc, Some payload) - | None -> (emptyLoc, None) in - let props = getPropsAttr payload in - (* do stuff here! *) - let (namedArgList, forwardRef) = recursivelyTransformNamedArgsForMake mapper (modifiedBindingOld binding) [] in - let namedArgListWithKeyAndRef = (optional("key"), None, Pat.var {txt = "key"; loc = emptyLoc}, "key", emptyLoc, Some(keyType emptyLoc)) :: namedArgList in - let namedArgListWithKeyAndRef = match forwardRef with - | Some(_) -> (optional("ref"), None, Pat.var {txt = "key"; loc = emptyLoc}, "ref", emptyLoc, None) :: namedArgListWithKeyAndRef - | None -> namedArgListWithKeyAndRef - in - let namedArgListWithKeyAndRefForNew = match forwardRef with - | Some(txt) -> namedArgList @ [(nolabel, None, Pat.var {txt; loc = emptyLoc}, txt, emptyLoc, None)] - | None -> namedArgList - in - let pluckArg (label, _, _, alias, loc, _) = - let labelString = (match label with | label when isOptional label || isLabelled label -> getLabel label | _ -> "") in - (label, - (match labelString with - | "" -> (Exp.ident ~loc { - txt = (Lident alias); - loc - }) - | labelString -> (Exp.apply ~loc - (Exp.ident ~loc {txt = (Lident "##"); loc }) - [ - (nolabel, Exp.ident ~loc {txt = (Lident props.propsName); loc }); - (nolabel, Exp.ident ~loc { - txt = (Lident labelString); - loc - }) - ] - ) - ) - ) in - let namedTypeList = List.fold_left argToType [] namedArgList in - let loc = emptyLoc in - let externalDecl = makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList in - let innerExpressionArgs = (List.map pluckArg namedArgListWithKeyAndRefForNew) @ - if hasUnit then [(Nolabel, Exp.construct {loc; txt = Lident "()"} None)] else [] in - let innerExpression = Exp.apply (Exp.ident {loc; txt = Lident( - match recFlag with - | Recursive -> internalFnName - | Nonrecursive -> fnName - )}) innerExpressionArgs in - let innerExpressionWithRef = match (forwardRef) with - | Some txt -> - {innerExpression with pexp_desc = Pexp_fun (nolabel, None, { - ppat_desc = Ppat_var { txt; loc = emptyLoc }; - ppat_loc = emptyLoc; - ppat_attributes = []; - }, innerExpression)} - | None -> innerExpression - in - let fullExpression = Exp.fun_ - nolabel - None - { - ppat_desc = Ppat_constraint ( - makePropsName ~loc:emptyLoc props.propsName, - makePropsType ~loc:emptyLoc namedTypeList - ); - ppat_loc = emptyLoc; - ppat_attributes = []; - } - innerExpressionWithRef in - let fullExpression = match (fullModuleName) with - | ("") -> fullExpression - | (txt) -> Exp.let_ - Nonrecursive - [Vb.mk - ~loc:emptyLoc - (Pat.var ~loc:emptyLoc {loc = emptyLoc; txt}) - fullExpression - ] - (Exp.ident ~loc:emptyLoc {loc = emptyLoc; txt = Lident txt}) in - let (bindings, newBinding) = - match recFlag with - | Recursive -> ([bindingWrapper (Exp.let_ - ~loc:(emptyLoc) - Recursive - [ - makeNewBinding binding expression internalFnName; - Vb.mk (Pat.var {loc = emptyLoc; txt = fnName}) fullExpression - ] - (Exp.ident {loc = emptyLoc; txt = Lident fnName}))], None) - | Nonrecursive -> ([{ binding with pvb_expr = expression; pvb_attributes = [] }], Some(bindingWrapper fullExpression)) - in - (Some externalDecl, bindings, newBinding) - else - (None, [binding], None) - in - let structuresAndBinding = List.map mapBinding valueBindings in - let otherStructures (extern, binding, newBinding) (externs, bindings, newBindings) = - let externs = match extern with - | Some extern -> extern :: externs - | None -> externs in - let newBindings = match newBinding with - | Some newBinding -> newBinding :: newBindings - | None -> newBindings in - (externs, binding @ bindings, newBindings) - in - let (externs, bindings, newBindings) = List.fold_right otherStructures structuresAndBinding ([], [], []) in - externs @ [{ - pstr_loc; - pstr_desc = Pstr_value ( - recFlag, - bindings - ) - }] @ (match newBindings with - | [] -> [] - | newBindings -> [{ - pstr_loc = emptyLoc; - pstr_desc = Pstr_value ( - recFlag, - newBindings - ) - }]) @ returnStructures - | structure -> structure :: returnStructures in - - let reactComponentTransform mapper structures = - List.fold_right (transformComponentDefinition mapper) structures [] in - - let transformComponentSignature _mapper signature returnSignatures = match signature with - | ({ - psig_loc; - psig_desc = Psig_value ({ - pval_name = { txt = fnName }; - pval_attributes; - pval_type; - } as psig_desc) - } as psig) -> - (match List.filter hasAttr pval_attributes with - | [] -> signature :: returnSignatures - | [_] -> - let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = - (match ptyp_desc with - | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) when isOptional name || isLabelled name -> - getPropTypes ((name, ptyp_loc, type_)::types) rest - | Ptyp_arrow (Nolabel, _type, rest) -> - getPropTypes types rest - | Ptyp_arrow (name, type_, returnValue) when isOptional name || isLabelled name -> - (returnValue, (name, returnValue.ptyp_loc, type_)::types) - | _ -> (fullType, types)) - in - let (innerType, propTypes) = getPropTypes [] pval_type in - let namedTypeList = List.fold_left argToConcreteType [] propTypes in - let pluckLabelAndLoc (label, loc, type_) = (label, None, loc, Some type_) in - let retPropsType = makePropsType ~loc:psig_loc namedTypeList in - let externalPropsDecl = makePropsExternalSig fnName psig_loc (( - optional "key", - None, - psig_loc, - Some(keyType psig_loc) - ) :: List.map pluckLabelAndLoc propTypes) retPropsType in - (* can't be an arrow because it will defensively uncurry *) - let newExternalType = Ptyp_constr ( - {loc = psig_loc; txt = Ldot ((Lident "React"), "componentLike")}, - [retPropsType; innerType] - ) in - let newStructure = { - psig with psig_desc = Psig_value { - psig_desc with pval_type = { - pval_type with ptyp_desc = newExternalType; - }; - pval_attributes = List.filter otherAttrsPure pval_attributes; - } - } in - externalPropsDecl :: newStructure :: returnSignatures - | _ -> raise (Invalid_argument "Only one react.component call can exist on a component at one time")) - | signature -> signature :: returnSignatures in - - let reactComponentSignatureTransform mapper signatures = - List.fold_right (transformComponentSignature mapper) signatures [] in - - - let transformJsxCall mapper callExpression callArguments attrs = - (match callExpression.pexp_desc with - | Pexp_ident caller -> - (match caller with - | {txt = Lident "createElement"} -> - raise (Invalid_argument "JSX: `createElement` should be preceeded by a module name.") - - (* Foo.createElement(~prop1=foo, ~prop2=bar, ~children=[], ()) *) - | {loc; txt = Ldot (modulePath, ("createElement" | "make"))} -> - (match !jsxVersion with - | None - | Some 3 -> transformUppercaseCall3 modulePath mapper loc attrs callExpression callArguments - | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 3")) - - (* div(~prop1=foo, ~prop2=bar, ~children=[bla], ()) *) - (* turn that into - ReactDOMRe.createElement(~props=ReactDOMRe.props(~props1=foo, ~props2=bar, ()), [|bla|]) *) - | {loc; txt = Lident id} -> - (match !jsxVersion with - | None - | Some 3 -> transformLowercaseCall3 mapper loc attrs callArguments id - | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 3")) - - | {txt = Ldot (_, anythingNotCreateElementOrMake)} -> - raise ( - Invalid_argument - ("JSX: the JSX attribute should be attached to a `YourModuleName.createElement` or `YourModuleName.make` call. We saw `" - ^ anythingNotCreateElementOrMake - ^ "` instead" - ) - ) - - | {txt = Lapply _} -> - (* don't think there's ever a case where this is reached *) - raise ( - Invalid_argument "JSX: encountered a weird case while processing the code. Please report this!" - ) - ) - | _ -> - raise ( - Invalid_argument "JSX: `createElement` should be preceeded by a simple, direct module name." - ) - ) in - - let signature = - (fun mapper signature -> default_mapper.signature mapper @@ reactComponentSignatureTransform mapper signature) in - - let structure = - (fun mapper structure -> match structure with - | structures -> begin - default_mapper.structure mapper @@ reactComponentTransform mapper structures - end - ) in - - let expr = - (fun mapper expression -> match expression with - (* Does the function application have the @JSX attribute? *) - | { - pexp_desc = Pexp_apply (callExpression, callArguments); - pexp_attributes - } -> - let (jsxAttribute, nonJSXAttributes) = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - (match (jsxAttribute, nonJSXAttributes) with - (* no JSX attribute *) - | ([], _) -> default_mapper.expr mapper expression - | (_, nonJSXAttributes) -> transformJsxCall mapper callExpression callArguments nonJSXAttributes) - - (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) - | { - pexp_desc = - Pexp_construct ({txt = Lident "::"; loc}, Some {pexp_desc = Pexp_tuple _}) - | Pexp_construct ({txt = Lident "[]"; loc}, None); - pexp_attributes - } as listItems -> - let (jsxAttribute, nonJSXAttributes) = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - (match (jsxAttribute, nonJSXAttributes) with - (* no JSX attribute *) - | ([], _) -> default_mapper.expr mapper expression - | (_, nonJSXAttributes) -> - let fragment = Exp.ident ~loc {loc; txt = Ldot (Lident "ReasonReact", "fragment")} in - let childrenExpr = transformChildrenIfList ~loc ~mapper listItems in - let args = [ - (* "div" *) - (nolabel, fragment); - (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] in - Exp.apply - ~loc - (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs:nonJSXAttributes - (* ReactDOMRe.createElement *) - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "createElement")}) - args - ) - (* Delegate to the default mapper, a deep identity traversal *) - | e -> default_mapper.expr mapper e) in - - let module_binding = - (fun mapper module_binding -> - let _ = nestedModules := module_binding.pmb_name.txt :: !nestedModules in - let mapped = default_mapper.module_binding mapper module_binding in - let _ = nestedModules := List.tl !nestedModules in - mapped - ) in - - { default_mapper with structure; expr; signature; module_binding; } - -let rewrite_implementation (code: Parsetree.structure) : Parsetree.structure = - let mapper = jsxMapper () in - mapper.structure mapper code -let rewrite_signature (code : Parsetree.signature) : Parsetree.signature = - let mapper = jsxMapper () in - mapper.signature mapper code - -#ifdef BINARY -let () = Ast_mapper.register "JSX" (fun _argv -> jsxMapper ()) -#endif diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index a4de45c7ed..2c7c8b7c22 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -408272,16 +408272,14 @@ let mapper : mapper = end -module Reactjs_jsx_ppx_v3 -= struct -#1 "reactjs_jsx_ppx_v3.ml" -# 1 "syntax/reactjs_jsx_ppx.cppo.ml" +module Reactjs_jsx_ppx_v3 : sig +#1 "reactjs_jsx_ppx_v3.mli" (* - This is the file that handles turning Reason JSX' agnostic function call into + This is the module that handles turning Reason JSX' agnostic function call into a ReasonReact-specific function call. Aka, this is a macro, using OCaml's ppx facilities; https://whitequark.org/blog/2014/04/16/a-guide-to-extension- points-in-ocaml/ - You wouldn't use this file directly; it's used by BuckleScript's + You wouldn't use this file directly; it's used by ReScript's bsconfig.json. Specifically, there's a field called `react-jsx` inside the field `reason`, which enables this ppx through some internal call in bsb *) @@ -408312,49 +408310,46 @@ module Reactjs_jsx_ppx_v3 `ReactDOMRe.createElement(ReasonReact.fragment, [|foo|])` *) +val rewrite_implementation : Parsetree.structure -> Parsetree.structure + +val rewrite_signature : Parsetree.signature -> Parsetree.signature + +end = struct +#1 "reactjs_jsx_ppx_v3.ml" open Ast_helper open Ast_mapper open Asttypes open Parsetree open Longident -let rec find_opt p = function - | [] -> None - | x :: l -> if p x then Some x else find_opt p l - - +let rec find_opt p = function [] -> None | x :: l -> if p x then Some x else find_opt p l let nolabel = Nolabel + let labelled str = Labelled str + let optional str = Optional str -let isOptional str = match str with -| Optional _ -> true -| _ -> false -let isLabelled str = match str with -| Labelled _ -> true -| _ -> false -let getLabel str = match str with -| Optional str | Labelled str -> str -| Nolabel -> "" + +let isOptional str = match str with Optional _ -> true | _ -> false + +let isLabelled str = match str with Labelled _ -> true | _ -> false + +let getLabel str = match str with Optional str | Labelled str -> str | Nolabel -> "" + let optionIdent = Lident "option" -let argIsKeyRef = function - | (Labelled ("key" | "ref"), _) | (Optional ("key" | "ref"), _) -> true - | _ -> false let constantString ~loc str = Ast_helper.Exp.constant ~loc (Pconst_string (str, None)) - let safeTypeFromValue valueStr = -let valueStr = getLabel valueStr in -match String.sub valueStr 0 1 with -| "_" -> "T" ^ valueStr -| _ -> valueStr -let keyType loc = Typ.constr ~loc {loc; txt=optionIdent} [Typ.constr ~loc {loc; txt=Lident "string"} []] - -type 'a children = | ListLiteral of 'a | Exact of 'a -type componentConfig = { - propsName: string; -} + let valueStr = getLabel valueStr in + match String.sub valueStr 0 1 with "_" -> "T" ^ valueStr | _ -> valueStr + [@@raises Invalid_argument] + +let keyType loc = Typ.constr ~loc { loc; txt = optionIdent } [ Typ.constr ~loc { loc; txt = Lident "string" } [] ] + +type 'a children = ListLiteral of 'a | Exact of 'a + +type componentConfig = { propsName : string } (* if children is a list, convert it to an array while mapping each element. If not, just map over it, as usual *) let transformChildrenIfListUpper ~loc ~mapper theList = @@ -408362,16 +408357,12 @@ let transformChildrenIfListUpper ~loc ~mapper theList = (* not in the sense of converting a list to an array; convert the AST reprensentation of a list to the AST reprensentation of an array *) match theList with - | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> begin - match accum with - | [singleElement] -> Exact singleElement - | accum -> ListLiteral (List.rev accum |> Exp.array ~loc) - end - | {pexp_desc = Pexp_construct ( - {txt = Lident "::"}, - Some {pexp_desc = Pexp_tuple (v::acc::[])} - )} -> - transformChildren_ acc ((mapper.expr mapper v)::accum) + | { pexp_desc = Pexp_construct ({ txt = Lident "[]" }, None) } -> ( + match accum with + | [ singleElement ] -> Exact singleElement + | accum -> ListLiteral (Exp.array ~loc (List.rev accum)) ) + | { pexp_desc = Pexp_construct ({ txt = Lident "::" }, Some { pexp_desc = Pexp_tuple [ v; acc ] }) } -> + transformChildren_ acc (mapper.expr mapper v :: accum) | notAList -> Exact (mapper.expr mapper notAList) in transformChildren_ theList [] @@ -408381,114 +408372,103 @@ let transformChildrenIfList ~loc ~mapper theList = (* not in the sense of converting a list to an array; convert the AST reprensentation of a list to the AST reprensentation of an array *) match theList with - | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> - List.rev accum |> Exp.array ~loc - | {pexp_desc = Pexp_construct ( - {txt = Lident "::"}, - Some {pexp_desc = Pexp_tuple (v::acc::[])} - )} -> - transformChildren_ acc ((mapper.expr mapper v)::accum) + | { pexp_desc = Pexp_construct ({ txt = Lident "[]" }, None) } -> Exp.array ~loc (List.rev accum) + | { pexp_desc = Pexp_construct ({ txt = Lident "::" }, Some { pexp_desc = Pexp_tuple [ v; acc ] }) } -> + transformChildren_ acc (mapper.expr mapper v :: accum) | notAList -> mapper.expr mapper notAList in transformChildren_ theList [] -let extractChildren ?(removeLastPositionUnit=false) ~loc propsAndChildren = - let rec allButLast_ lst acc = match lst with +let extractChildren ?(removeLastPositionUnit = false) ~loc propsAndChildren = + let rec allButLast_ lst acc = + match lst with | [] -> [] - | (Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})::[] -> acc + | [ (Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) }) ] -> acc | (Nolabel, _) :: _rest -> raise (Invalid_argument "JSX: found non-labelled argument before the last position") - | arg::rest -> allButLast_ rest (arg::acc) + | arg :: rest -> allButLast_ rest (arg :: acc) + [@@raises Invalid_argument] in - let allButLast lst = allButLast_ lst [] |> List.rev in - match (List.partition (fun (label, _) -> label = labelled "children") propsAndChildren) with - | ([], props) -> - (* no children provided? Place a placeholder list *) - (Exp.construct ~loc {loc; txt = Lident "[]"} None, if removeLastPositionUnit then allButLast props else props) - | ([(_, childrenExpr)], props) -> - (childrenExpr, if removeLastPositionUnit then allButLast props else props) + let allButLast lst = allButLast_ lst [] |> List.rev [@@raises Invalid_argument] in + match List.partition (fun (label, _) -> label = labelled "children") propsAndChildren with + | [], props -> + (* no children provided? Place a placeholder list *) + (Exp.construct ~loc { loc; txt = Lident "[]" } None, if removeLastPositionUnit then allButLast props else props) + | [ (_, childrenExpr) ], props -> (childrenExpr, if removeLastPositionUnit then allButLast props else props) | _ -> raise (Invalid_argument "JSX: somehow there's more than one `children` label") + [@@raises Invalid_argument] + +let unerasableIgnore loc = ({ loc; txt = "warning" }, PStr [ Str.eval (Exp.constant (Pconst_string ("-16", None))) ]) -let unerasableIgnore loc = ({loc; txt = "warning"}, (PStr [Str.eval (Exp.constant (Pconst_string ("-16", None)))])) -let merlinFocus = ({loc = Location.none; txt = "merlin.focus"}, (PStr [])) +let merlinFocus = ({ loc = Location.none; txt = "merlin.focus" }, PStr []) (* Helper method to look up the [@react.component] attribute *) -let hasAttr (loc, _) = - loc.txt = "react.component" +let hasAttr (loc, _) = loc.txt = "react.component" (* Helper method to filter out any attribute that isn't [@react.component] *) -let otherAttrsPure (loc, _) = - loc.txt <> "react.component" +let otherAttrsPure (loc, _) = loc.txt <> "react.component" (* Iterate over the attributes and try to find the [@react.component] attribute *) -let hasAttrOnBinding {pvb_attributes} = find_opt hasAttr pvb_attributes <> None - -(* Filter the [@react.component] attribute and immutably replace them on the binding *) -let filterAttrOnBinding binding = {binding with pvb_attributes = List.filter otherAttrsPure binding.pvb_attributes} +let hasAttrOnBinding { pvb_attributes } = find_opt hasAttr pvb_attributes <> None (* Finds the name of the variable the binding is assigned to, otherwise raises Invalid_argument *) let getFnName binding = match binding with - | {pvb_pat = { - ppat_desc = Ppat_var {txt} - }} -> txt + | { pvb_pat = { ppat_desc = Ppat_var { txt } } } -> txt | _ -> raise (Invalid_argument "react.component calls cannot be destructured.") + [@@raises Invalid_argument] let makeNewBinding binding expression newName = match binding with - | {pvb_pat = { - ppat_desc = Ppat_var ( ppat_var) - } as pvb_pat} ->{ binding with pvb_pat = { - pvb_pat with - ppat_desc = Ppat_var {ppat_var with txt = newName}; - }; - pvb_expr = expression; - pvb_attributes = [merlinFocus]; - } + | { pvb_pat = { ppat_desc = Ppat_var ppat_var } as pvb_pat } -> + { + binding with + pvb_pat = { pvb_pat with ppat_desc = Ppat_var { ppat_var with txt = newName } }; + pvb_expr = expression; + pvb_attributes = [ merlinFocus ]; + } | _ -> raise (Invalid_argument "react.component calls cannot be destructured.") + [@@raises Invalid_argument] (* Lookup the value of `props` otherwise raise Invalid_argument error *) let getPropsNameValue _acc (loc, exp) = - match (loc, exp) with - | ({ txt = Lident "props" }, { pexp_desc = Pexp_ident {txt = Lident str} }) -> { propsName = str } - | ({ txt }, _) -> raise (Invalid_argument ("react.component only accepts props as an option, given: " ^ Longident.last txt)) + match (loc, exp) with + | { txt = Lident "props" }, { pexp_desc = Pexp_ident { txt = Lident str } } -> { propsName = str } + | { txt }, _ -> + raise (Invalid_argument ("react.component only accepts props as an option, given: " ^ Longident.last txt)) + [@@raises Invalid_argument] (* Lookup the `props` record or string as part of [@react.component] and store the name for use when rewriting *) let getPropsAttr payload = - let defaultProps = {propsName = "Props"} in + let defaultProps = { propsName = "Props" } in match payload with - | Some(PStr( - {pstr_desc = Pstr_eval ({ - pexp_desc = Pexp_record (recordFields, None) - }, _)}::_rest - )) -> + | Some (PStr ({ pstr_desc = Pstr_eval ({ pexp_desc = Pexp_record (recordFields, None) }, _) } :: _rest)) -> List.fold_left getPropsNameValue defaultProps recordFields - | Some(PStr({pstr_desc = Pstr_eval ({pexp_desc = Pexp_ident {txt = Lident "props"}}, _)}::_rest)) -> {propsName = "props"} - | Some(PStr({pstr_desc = Pstr_eval (_, _)}::_rest)) -> raise (Invalid_argument ("react.component accepts a record config with props as an options.")) + | Some (PStr ({ pstr_desc = Pstr_eval ({ pexp_desc = Pexp_ident { txt = Lident "props" } }, _) } :: _rest)) -> + { propsName = "props" } + | Some (PStr ({ pstr_desc = Pstr_eval (_, _) } :: _rest)) -> + raise (Invalid_argument "react.component accepts a record config with props as an options.") | _ -> defaultProps + [@@raises Invalid_argument] (* Plucks the label, loc, and type_ from an AST node *) let pluckLabelDefaultLocType (label, default, _, _, loc, type_) = (label, default, loc, type_) (* Lookup the filename from the location information on the AST node and turn it into a valid module identifier *) -let filenameFromLoc (pstr_loc: Location.t) = - let fileName = match pstr_loc.loc_start.pos_fname with - | "" -> !Location.input_name - | fileName -> fileName - in - let fileName = try - Filename.chop_extension (Filename.basename fileName) - with | Invalid_argument _-> fileName in +let filenameFromLoc (pstr_loc : Location.t) = + let fileName = match pstr_loc.loc_start.pos_fname with "" -> !Location.input_name | fileName -> fileName in + let fileName = try Filename.chop_extension (Filename.basename fileName) with Invalid_argument _ -> fileName in let fileName = String.capitalize_ascii fileName in fileName (* Build a string representation of a module name with segments separated by $ *) let makeModuleName fileName nestedModules fnName = - let fullModuleName = match (fileName, nestedModules, fnName) with - (* TODO: is this even reachable? It seems like the fileName always exists *) - | ("", nestedModules, "make") -> nestedModules - | ("", nestedModules, fnName) -> List.rev (fnName :: nestedModules) - | (fileName, nestedModules, "make") -> fileName :: (List.rev nestedModules) - | (fileName, nestedModules, fnName) -> fileName :: (List.rev (fnName :: nestedModules)) + let fullModuleName = + match (fileName, nestedModules, fnName) with + (* TODO: is this even reachable? It seems like the fileName always exists *) + | "", nestedModules, "make" -> nestedModules + | "", nestedModules, fnName -> List.rev (fnName :: nestedModules) + | fileName, nestedModules, "make" -> fileName :: List.rev nestedModules + | fileName, nestedModules, fnName -> fileName :: List.rev (fnName :: nestedModules) in let fullModuleName = String.concat "$" fullModuleName in fullModuleName @@ -408502,202 +408482,167 @@ let makeModuleName fileName nestedModules fnName = (* Build an AST node representing all named args for the `external` definition for a component's props *) let rec recursivelyMakeNamedArgsForExternal list args = match list with - | (label, default, loc, interiorType)::tl -> - recursivelyMakeNamedArgsForExternal tl (Typ.arrow - ~loc - label - (match (label, interiorType, default) with - (* ~foo=1 *) - | (label, None, Some _) -> - { - ptyp_desc = Ptyp_var (safeTypeFromValue label); - ptyp_loc = loc; - ptyp_attributes = []; - } - (* ~foo: int=1 *) - | (_label, Some type_, Some _) -> - type_ - - (* ~foo: option(int)=? *) - | (label, Some ({ptyp_desc = Ptyp_constr ({txt=(Lident "option")}, [type_])}), _) - | (label, Some ({ptyp_desc = Ptyp_constr ({txt=(Ldot (Lident "*predef*", "option"))}, [type_])}), _) - (* ~foo: int=? - note this isnt valid. but we want to get a type error *) - | (label, Some type_, _) when isOptional label -> - type_ - (* ~foo=? *) - | (label, None, _) when isOptional label -> - { - ptyp_desc = Ptyp_var (safeTypeFromValue label); - ptyp_loc = loc; - ptyp_attributes = []; - } - - (* ~foo *) - | (label, None, _) -> - { - ptyp_desc = Ptyp_var (safeTypeFromValue label); - ptyp_loc = loc; - ptyp_attributes = []; - } - | (_label, Some type_, _) -> - type_ - ) - args) + | (label, default, loc, interiorType) :: tl -> + recursivelyMakeNamedArgsForExternal tl + (Typ.arrow ~loc label + ( match (label, interiorType, default) with + (* ~foo=1 *) + | label, None, Some _ -> + { ptyp_desc = Ptyp_var (safeTypeFromValue label); ptyp_loc = loc; ptyp_attributes = [] } + (* ~foo: int=1 *) + | _label, Some type_, Some _ -> type_ + (* ~foo: option(int)=? *) + | label, Some { ptyp_desc = Ptyp_constr ({ txt = Lident "option" }, [ type_ ]) }, _ + | label, Some { ptyp_desc = Ptyp_constr ({ txt = Ldot (Lident "*predef*", "option") }, [ type_ ]) }, _ + (* ~foo: int=? - note this isnt valid. but we want to get a type error *) + | label, Some type_, _ + when isOptional label -> + type_ + (* ~foo=? *) + | label, None, _ when isOptional label -> + { ptyp_desc = Ptyp_var (safeTypeFromValue label); ptyp_loc = loc; ptyp_attributes = [] } + (* ~foo *) + | label, None, _ -> { ptyp_desc = Ptyp_var (safeTypeFromValue label); ptyp_loc = loc; ptyp_attributes = [] } + | _label, Some type_, _ -> type_ ) + args) | [] -> args + [@@raises Invalid_argument] (* Build an AST node for the [@bs.obj] representing props for a component *) let makePropsValue fnName loc namedArgListWithKeyAndRef propsType = - let propsName = fnName ^ "Props" in { - pval_name = {txt = propsName; loc}; - pval_type = - recursivelyMakeNamedArgsForExternal - namedArgListWithKeyAndRef - (Typ.arrow - nolabel - { - ptyp_desc = Ptyp_constr ({txt= Lident("unit"); loc}, []); - ptyp_loc = loc; - ptyp_attributes = []; - } - propsType - ); - pval_prim = [""]; - pval_attributes = [({txt = "bs.obj"; loc = loc}, PStr [])]; - pval_loc = loc; -} + let propsName = fnName ^ "Props" in + { + pval_name = { txt = propsName; loc }; + pval_type = + recursivelyMakeNamedArgsForExternal namedArgListWithKeyAndRef + (Typ.arrow nolabel + { ptyp_desc = Ptyp_constr ({ txt = Lident "unit"; loc }, []); ptyp_loc = loc; ptyp_attributes = [] } + propsType); + pval_prim = [ "" ]; + pval_attributes = [ ({ txt = "bs.obj"; loc }, PStr []) ]; + pval_loc = loc; + } + [@@raises Invalid_argument] (* Build an AST node representing an `external` with the definition of the [@bs.obj] *) let makePropsExternal fnName loc namedArgListWithKeyAndRef propsType = - { - pstr_loc = loc; - pstr_desc = Pstr_primitive (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) - } + { pstr_loc = loc; pstr_desc = Pstr_primitive (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) } + [@@raises Invalid_argument] (* Build an AST node for the signature of the `external` definition *) let makePropsExternalSig fnName loc namedArgListWithKeyAndRef propsType = - { - psig_loc = loc; - psig_desc = Psig_value (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) - } + { psig_loc = loc; psig_desc = Psig_value (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) } + [@@raises Invalid_argument] (* Build an AST node for the props name when converted to a Js.t inside the function signature *) -let makePropsName ~loc name = - { - ppat_desc = Ppat_var {txt = name; loc}; - ppat_loc = loc; - ppat_attributes = []; - } - - -let makeObjectField loc (str, attrs, type_) = - Otag ({ loc; txt = str }, attrs, type_) +let makePropsName ~loc name = { ppat_desc = Ppat_var { txt = name; loc }; ppat_loc = loc; ppat_attributes = [] } +let makeObjectField loc (str, attrs, type_) = Otag ({ loc; txt = str }, attrs, type_) (* Build an AST node representing a "closed" Js.t object representing a component's props *) let makePropsType ~loc namedTypeList = - Typ.mk ~loc ( - Ptyp_constr({txt= Ldot (Lident("Js"), "t"); loc}, [{ - ptyp_desc = Ptyp_object( - List.map (makeObjectField loc) namedTypeList, - Closed - ); - ptyp_loc = loc; - ptyp_attributes = []; - }]) - ) + Typ.mk ~loc + (Ptyp_constr + ( { txt = Ldot (Lident "Js", "t"); loc }, + [ + { + ptyp_desc = Ptyp_object (List.map (makeObjectField loc) namedTypeList, Closed); + ptyp_loc = loc; + ptyp_attributes = []; + }; + ] )) (* Builds an AST node for the entire `external` definition of props *) let makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList = - makePropsExternal - fnName - loc + makePropsExternal fnName loc (List.map pluckLabelDefaultLocType namedArgListWithKeyAndRef) (makePropsType ~loc namedTypeList) + [@@raises Invalid_argument] (* TODO: some line number might still be wrong *) let jsxMapper () = - let jsxVersion = ref None in let transformUppercaseCall3 modulePath mapper loc attrs _ callArguments = - let (children, argsWithLabels) = extractChildren ~loc ~removeLastPositionUnit:true callArguments in + let children, argsWithLabels = extractChildren ~loc ~removeLastPositionUnit:true callArguments in let argsForMake = argsWithLabels in let childrenExpr = transformChildrenIfListUpper ~loc ~mapper children in - let recursivelyTransformedArgsForMake = argsForMake |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) in + let recursivelyTransformedArgsForMake = + argsForMake |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) + in let childrenArg = ref None in - let args = recursivelyTransformedArgsForMake - @ (match childrenExpr with - | Exact children -> [(labelled "children", children)] - | ListLiteral ({ pexp_desc = Pexp_array list }) when list = [] -> [] + let args = + recursivelyTransformedArgsForMake + @ ( match childrenExpr with + | Exact children -> [ (labelled "children", children) ] + | ListLiteral { pexp_desc = Pexp_array list } when list = [] -> [] | ListLiteral expression -> - (* this is a hack to support react components that introspect into their children *) - (childrenArg := Some expression; - [(labelled "children", Exp.ident ~loc {loc; txt = Ldot (Lident "React", "null")})])) - @ [(nolabel, Exp.construct ~loc {loc; txt = Lident "()"} None)] in - let isCap str = let first = String.sub str 0 1 in - let capped = String.uppercase_ascii first in first = capped in - let ident = match modulePath with - | Lident _ -> Ldot (modulePath, "make") - | (Ldot (_modulePath, value) as fullPath) when isCap value -> Ldot (fullPath, "make") - | modulePath -> modulePath in - let propsIdent = match ident with - | Lident path -> Lident (path ^ "Props") - | Ldot(ident, path) -> Ldot (ident, path ^ "Props") - | _ -> raise (Invalid_argument "JSX name can't be the result of function applications") in - let props = - Exp.apply ~attrs ~loc (Exp.ident ~loc {loc; txt = propsIdent}) args in + (* this is a hack to support react components that introspect into their children *) + childrenArg := Some expression; + [ (labelled "children", Exp.ident ~loc { loc; txt = Ldot (Lident "React", "null") }) ] ) + @ [ (nolabel, Exp.construct ~loc { loc; txt = Lident "()" } None) ] + in + let isCap str = + let first = String.sub str 0 1 [@@raises Invalid_argument] in + let capped = String.uppercase_ascii first in + first = capped + [@@raises Invalid_argument] + in + let ident = + match modulePath with + | Lident _ -> Ldot (modulePath, "make") + | Ldot (_modulePath, value) as fullPath when isCap value -> Ldot (fullPath, "make") + | modulePath -> modulePath + in + let propsIdent = + match ident with + | Lident path -> Lident (path ^ "Props") + | Ldot (ident, path) -> Ldot (ident, path ^ "Props") + | _ -> raise (Invalid_argument "JSX name can't be the result of function applications") + in + let props = Exp.apply ~attrs ~loc (Exp.ident ~loc { loc; txt = propsIdent }) args in (* handle key, ref, children *) - (* React.createElement(Component.make, props, ...children) *) - match (!childrenArg) with + (* React.createElement(Component.make, props, ...children) *) + match !childrenArg with | None -> - (Exp.apply - ~loc - ~attrs - (Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElement")}) - ([ - (nolabel, Exp.ident ~loc {txt = ident; loc}); - (nolabel, props) - ])) - | Some children -> - (Exp.apply - ~loc - ~attrs - (Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElementVariadic")}) - ([ - (nolabel, Exp.ident ~loc {txt = ident; loc}); - (nolabel, props); - (nolabel, children) - ])) - in + Exp.apply ~loc ~attrs + (Exp.ident ~loc { loc; txt = Ldot (Lident "React", "createElement") }) + [ (nolabel, Exp.ident ~loc { txt = ident; loc }); (nolabel, props) ] + | Some children -> + Exp.apply ~loc ~attrs + (Exp.ident ~loc { loc; txt = Ldot (Lident "React", "createElementVariadic") }) + [ (nolabel, Exp.ident ~loc { txt = ident; loc }); (nolabel, props); (nolabel, children) ] + [@@raises Invalid_argument] + in - let transformLowercaseCall3 mapper loc attrs callArguments id = - let (children, nonChildrenProps) = extractChildren ~loc callArguments in - let componentNameExpr = constantString ~loc id in - let childrenExpr = transformChildrenIfList ~loc ~mapper children in - let createElementCall = match children with - (* [@JSX] div(~children=[a]), coming from
a
*) - | { - pexp_desc = - Pexp_construct ({txt = Lident "::"}, Some {pexp_desc = Pexp_tuple _ }) - | Pexp_construct ({txt = Lident "[]"}, None) - } -> "createDOMElementVariadic" - (* [@JSX] div(~children= value), coming from
...(value)
*) - | _ -> raise (Invalid_argument "A spread as a DOM element's \ - children don't make sense written together. You can simply remove the spread.") - in - let args = match nonChildrenProps with - | [_justTheUnitArgumentAtEnd] -> - [ - (* "div" *) - (nolabel, componentNameExpr); - (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] - | nonEmptyProps -> + let transformLowercaseCall3 mapper loc attrs callArguments id = + let children, nonChildrenProps = extractChildren ~loc callArguments in + let componentNameExpr = constantString ~loc id in + let childrenExpr = transformChildrenIfList ~loc ~mapper children in + let createElementCall = + match children with + (* [@JSX] div(~children=[a]), coming from
a
*) + | { + pexp_desc = + ( Pexp_construct ({ txt = Lident "::" }, Some { pexp_desc = Pexp_tuple _ }) + | Pexp_construct ({ txt = Lident "[]" }, None) ); + } -> + "createDOMElementVariadic" + (* [@JSX] div(~children= value), coming from
...(value)
*) + | _ -> + raise + (Invalid_argument + "A spread as a DOM element's children don't make sense written together. You can simply remove the \ + spread.") + in + let args = + match nonChildrenProps with + | [ _justTheUnitArgumentAtEnd ] -> + [ (* "div" *) (nolabel, componentNameExpr); (* [|moreCreateElementCallsHere|] *) (nolabel, childrenExpr) ] + | nonEmptyProps -> let propsCall = - Exp.apply - ~loc - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "domProps")}) + Exp.apply ~loc + (Exp.ident ~loc { loc; txt = Ldot (Lident "ReactDOMRe", "domProps") }) (nonEmptyProps |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression))) in [ @@ -408706,547 +408651,551 @@ let jsxMapper () = (* ReactDOMRe.props(~className=blabla, ~foo=bar, ()) *) (labelled "props", propsCall); (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] in - Exp.apply - ~loc - (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs - (* ReactDOMRe.createElement *) - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", createElementCall)}) - args + (nolabel, childrenExpr); + ] in - - - + Exp.apply ~loc (* throw away the [@JSX] attribute and keep the others, if any *) ~attrs + (* ReactDOMRe.createElement *) + (Exp.ident ~loc { loc; txt = Ldot (Lident "ReactDOMRe", createElementCall) }) + args + [@@raises Invalid_argument] + in let rec recursivelyTransformNamedArgsForMake mapper expr list = let expr = mapper.expr mapper expr in match expr.pexp_desc with (* TODO: make this show up with a loc. *) - | Pexp_fun (Labelled "key", _, _, _) - | Pexp_fun (Optional "key", _, _, _) -> raise (Invalid_argument "Key cannot be accessed inside of a component. Don't worry - you can always key a component from its parent!") - | Pexp_fun (Labelled "ref", _, _, _) - | Pexp_fun (Optional "ref", _, _, _) -> raise (Invalid_argument "Ref cannot be passed as a normal prop. Please use `forwardRef` API instead.") + | Pexp_fun (Labelled "key", _, _, _) | Pexp_fun (Optional "key", _, _, _) -> + raise + (Invalid_argument + "Key cannot be accessed inside of a component. Don't worry - you can always key a component from its \ + parent!") + | Pexp_fun (Labelled "ref", _, _, _) | Pexp_fun (Optional "ref", _, _, _) -> + raise (Invalid_argument "Ref cannot be passed as a normal prop. Please use `forwardRef` API instead.") | Pexp_fun (arg, default, pattern, expression) when isOptional arg || isLabelled arg -> - let () = - (match (isOptional arg, pattern, default) with - | (true, { ppat_desc = Ppat_constraint (_, { ptyp_desc })}, None) -> - (match ptyp_desc with - | Ptyp_constr({txt=(Lident "option")}, [_]) -> () - | _ -> - let currentType = (match ptyp_desc with - | Ptyp_constr({txt}, []) -> String.concat "." (Longident.flatten txt) - | Ptyp_constr({txt}, _innerTypeArgs) -> String.concat "." (Longident.flatten txt) ^ "(...)" - | _ -> "...") - in - Location.prerr_warning pattern.ppat_loc - (Preprocessor - (Printf.sprintf "ReasonReact: optional argument annotations must have explicit `option`. Did you mean `option(%s)=?`?" currentType))) - | _ -> ()) in - let alias = (match pattern with - | {ppat_desc = Ppat_alias (_, {txt}) | Ppat_var {txt}} -> txt - | {ppat_desc = Ppat_any} -> "_" - | _ -> getLabel arg) in - let type_ = (match pattern with - | {ppat_desc = Ppat_constraint (_, type_)} -> Some type_ - | _ -> None) in - - recursivelyTransformNamedArgsForMake mapper expression ((arg, default, pattern, alias, pattern.ppat_loc, type_) :: list) - | Pexp_fun (Nolabel, _, { ppat_desc = (Ppat_construct ({txt = Lident "()"}, _) | Ppat_any)}, _expression) -> + let () = + match (isOptional arg, pattern, default) with + | true, { ppat_desc = Ppat_constraint (_, { ptyp_desc }) }, None -> ( + match ptyp_desc with + | Ptyp_constr ({ txt = Lident "option" }, [ _ ]) -> () + | _ -> + let currentType = + match ptyp_desc with + | Ptyp_constr ({ txt }, []) -> String.concat "." (Longident.flatten txt) + | Ptyp_constr ({ txt }, _innerTypeArgs) -> String.concat "." (Longident.flatten txt) ^ "(...)" + | _ -> "..." + in + Location.prerr_warning pattern.ppat_loc + (Preprocessor + (Printf.sprintf + "ReasonReact: optional argument annotations must have explicit `option`. Did you mean \ + `option(%s)=?`?" + currentType)) ) + | _ -> () + in + let alias = + match pattern with + | { ppat_desc = Ppat_alias (_, { txt }) | Ppat_var { txt } } -> txt + | { ppat_desc = Ppat_any } -> "_" + | _ -> getLabel arg + in + let type_ = match pattern with { ppat_desc = Ppat_constraint (_, type_) } -> Some type_ | _ -> None in + + recursivelyTransformNamedArgsForMake mapper expression + ((arg, default, pattern, alias, pattern.ppat_loc, type_) :: list) + | Pexp_fun (Nolabel, _, { ppat_desc = Ppat_construct ({ txt = Lident "()" }, _) | Ppat_any }, _expression) -> (list, None) - | Pexp_fun (Nolabel, _, { ppat_desc = Ppat_var ({txt}) | Ppat_constraint ({ ppat_desc = Ppat_var ({txt})}, _)}, _expression) -> + | Pexp_fun + ( Nolabel, + _, + { ppat_desc = Ppat_var { txt } | Ppat_constraint ({ ppat_desc = Ppat_var { txt } }, _) }, + _expression ) -> (list, Some txt) | Pexp_fun (Nolabel, _, pattern, _expression) -> - Location.raise_errorf ~loc:pattern.ppat_loc "ReasonReact: react.component refs only support plain arguments and type annotations." + Location.raise_errorf ~loc:pattern.ppat_loc + "ReasonReact: react.component refs only support plain arguments and type annotations." | _ -> (list, None) + [@@raises Invalid_argument] in - - let argToType types (name, default, _noLabelName, _alias, loc, type_) = match (type_, name, default) with - | (Some ({ptyp_desc = Ptyp_constr ({txt=(Lident "option")}, [type_])}), name, _) when isOptional name -> - (getLabel name, [], { - type_ with - ptyp_desc = Ptyp_constr ({loc=type_.ptyp_loc; txt=optionIdent}, [type_]); - }) :: types - | (Some type_, name, Some _default) -> - (getLabel name, [], { - ptyp_desc = Ptyp_constr ({loc; txt=optionIdent}, [type_]); - ptyp_loc = loc; - ptyp_attributes = []; - }) :: types - | (Some type_, name, _) -> - (getLabel name, [], type_) :: types - | (None, name, _) when isOptional name -> - (getLabel name, [], { - ptyp_desc = Ptyp_constr ({loc; txt=optionIdent}, [{ - ptyp_desc = Ptyp_var (safeTypeFromValue name); - ptyp_loc = loc; - ptyp_attributes = []; - }]); - ptyp_loc = loc; - ptyp_attributes = []; - }) :: types - | (None, name, _) when isLabelled name -> - (getLabel name, [], { - ptyp_desc = Ptyp_var (safeTypeFromValue name); - ptyp_loc = loc; - ptyp_attributes = []; - }) :: types + let argToType types (name, default, _noLabelName, _alias, loc, type_) = + match (type_, name, default) with + | Some { ptyp_desc = Ptyp_constr ({ txt = Lident "option" }, [ type_ ]) }, name, _ when isOptional name -> + ( getLabel name, + [], + { type_ with ptyp_desc = Ptyp_constr ({ loc = type_.ptyp_loc; txt = optionIdent }, [ type_ ]) } ) + :: types + | Some type_, name, Some _default -> + ( getLabel name, + [], + { ptyp_desc = Ptyp_constr ({ loc; txt = optionIdent }, [ type_ ]); ptyp_loc = loc; ptyp_attributes = [] } ) + :: types + | Some type_, name, _ -> (getLabel name, [], type_) :: types + | None, name, _ when isOptional name -> + ( getLabel name, + [], + { + ptyp_desc = + Ptyp_constr + ( { loc; txt = optionIdent }, + [ { ptyp_desc = Ptyp_var (safeTypeFromValue name); ptyp_loc = loc; ptyp_attributes = [] } ] ); + ptyp_loc = loc; + ptyp_attributes = []; + } ) + :: types + | None, name, _ when isLabelled name -> + (getLabel name, [], { ptyp_desc = Ptyp_var (safeTypeFromValue name); ptyp_loc = loc; ptyp_attributes = [] }) + :: types | _ -> types + [@@raises Invalid_argument] in - let argToConcreteType types (name, loc, type_) = match name with - | name when isLabelled name -> - (getLabel name, [], type_) :: types - | name when isOptional name -> - (getLabel name, [], Typ.constr ~loc {loc; txt=optionIdent} [type_]) :: types + let argToConcreteType types (name, loc, type_) = + match name with + | name when isLabelled name -> (getLabel name, [], type_) :: types + | name when isOptional name -> (getLabel name, [], Typ.constr ~loc { loc; txt = optionIdent } [ type_ ]) :: types | _ -> types in - let nestedModules = ref([]) in - let transformComponentDefinition mapper structure returnStructures = match structure with - (* external *) - | ({ - pstr_loc; - pstr_desc = Pstr_primitive ({ - pval_name = { txt = fnName }; - pval_attributes; - pval_type; - } as value_description) - } as pstr) -> - (match List.filter hasAttr pval_attributes with - | [] -> structure :: returnStructures - | [_] -> - let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = - (match ptyp_desc with - | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) when isLabelled name || isOptional name -> - getPropTypes ((name, ptyp_loc, type_)::types) rest - | Ptyp_arrow (Nolabel, _type, rest) -> - getPropTypes types rest - | Ptyp_arrow (name, type_, returnValue) when isLabelled name || isOptional name -> - (returnValue, (name, returnValue.ptyp_loc, type_)::types) - | _ -> (fullType, types)) - in - let (innerType, propTypes) = getPropTypes [] pval_type in - let namedTypeList = List.fold_left argToConcreteType [] propTypes in - let pluckLabelAndLoc (label, loc, type_) = (label, None (* default *), loc, Some type_) in - let retPropsType = makePropsType ~loc:pstr_loc namedTypeList in - let externalPropsDecl = makePropsExternal fnName pstr_loc (( - optional "key", - None, - pstr_loc, - Some(keyType pstr_loc) - ) :: List.map pluckLabelAndLoc propTypes) retPropsType in - (* can't be an arrow because it will defensively uncurry *) - let newExternalType = Ptyp_constr ( - {loc = pstr_loc; txt = Ldot ((Lident "React"), "componentLike")}, - [retPropsType; innerType] - ) in - let newStructure = { - pstr with pstr_desc = Pstr_primitive { - value_description with pval_type = { - pval_type with ptyp_desc = newExternalType; - }; - pval_attributes = List.filter otherAttrsPure pval_attributes; - } - } in - externalPropsDecl :: newStructure :: returnStructures - | _ -> raise (Invalid_argument "Only one react.component call can exist on a component at one time")) - (* let component = ... *) - | { - pstr_loc; - pstr_desc = Pstr_value ( - recFlag, - valueBindings - ) - } -> - let fileName = filenameFromLoc pstr_loc in - let emptyLoc = Location.in_file fileName in - let mapBinding binding = if (hasAttrOnBinding binding) then - let bindingLoc = binding.pvb_loc in - let bindingPatLoc = binding.pvb_pat.ppat_loc in - let binding = { binding with pvb_pat = { binding.pvb_pat with ppat_loc = emptyLoc}; pvb_loc = emptyLoc} in - let fnName = getFnName binding in - let internalFnName = fnName ^ "$Internal" in - let fullModuleName = makeModuleName fileName !nestedModules fnName in - let modifiedBindingOld binding = - let expression = binding.pvb_expr in - (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) - let rec spelunkForFunExpression expression = (match expression with - (* let make = (~prop) => ... *) - | { - pexp_desc = Pexp_fun _ - } -> expression - (* let make = {let foo = bar in (~prop) => ...} *) - | { - pexp_desc = Pexp_let (_recursive, _vbs, returnExpression) - } -> - (* here's where we spelunk! *) - spelunkForFunExpression returnExpression - (* let make = React.forwardRef((~prop) => ...) *) - - | { pexp_desc = Pexp_apply (_wrapperExpression, [(Nolabel, innerFunctionExpression)]) } -> - spelunkForFunExpression innerFunctionExpression - | { - pexp_desc = Pexp_sequence (_wrapperExpression, innerFunctionExpression) - } -> - spelunkForFunExpression innerFunctionExpression - | _ -> raise (Invalid_argument "react.component calls can only be on function definitions or component wrappers (forwardRef, memo).") - ) in - spelunkForFunExpression expression - in - let modifiedBinding binding = - let hasApplication = ref(false) in - let wrapExpressionWithBinding expressionFn expression = - Vb.mk - ~loc:bindingLoc - ~attrs:(List.filter otherAttrsPure binding.pvb_attributes) - (Pat.var ~loc:bindingPatLoc {loc = bindingPatLoc; txt = fnName}) (expressionFn expression) in - let expression = binding.pvb_expr in - let unerasableIgnoreExp exp = { exp with pexp_attributes = (unerasableIgnore emptyLoc) :: exp.pexp_attributes } in - (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) - let rec spelunkForFunExpression expression = (match expression with - (* let make = (~prop) => ... with no final unit *) - | { - pexp_desc = Pexp_fun ((Labelled(_) | Optional(_) as label), default, pattern, ({pexp_desc = Pexp_fun _} as internalExpression)) - } -> - let (wrap, hasUnit, exp) = spelunkForFunExpression internalExpression in - (wrap, hasUnit, unerasableIgnoreExp {expression with pexp_desc = Pexp_fun (label, default, pattern, exp)}) - (* let make = (()) => ... *) - (* let make = (_) => ... *) - | { - pexp_desc = Pexp_fun (Nolabel, _default, { ppat_desc = Ppat_construct ({txt = Lident "()"}, _) | Ppat_any}, _internalExpression) - } -> ((fun a -> a), true, expression) - (* let make = (~prop) => ... *) - | { - pexp_desc = Pexp_fun ((Labelled(_) | Optional(_)), _default, _pattern, _internalExpression) - } -> ((fun a -> a), false, unerasableIgnoreExp expression) - (* let make = (prop) => ... *) - | { - pexp_desc = Pexp_fun (_nolabel, _default, pattern, _internalExpression) - } -> - if (hasApplication.contents) then - ((fun a -> a), false, unerasableIgnoreExp expression) - else - Location.raise_errorf ~loc:pattern.ppat_loc "ReasonReact: props need to be labelled arguments.\n If you are working with refs be sure to wrap with React.forwardRef.\n If your component doesn't have any props use () or _ instead of a name." - (* let make = {let foo = bar in (~prop) => ...} *) - | { - pexp_desc = Pexp_let (recursive, vbs, internalExpression) - } -> - (* here's where we spelunk! *) - let (wrap, hasUnit, exp) = spelunkForFunExpression internalExpression in - (wrap, hasUnit, {expression with pexp_desc = Pexp_let (recursive, vbs, exp)}) - (* let make = React.forwardRef((~prop) => ...) *) - | { pexp_desc = Pexp_apply (wrapperExpression, [(Nolabel, internalExpression)]) } -> - let () = hasApplication := true in - let (_, hasUnit, exp) = spelunkForFunExpression internalExpression in - ((fun exp -> Exp.apply wrapperExpression [(nolabel, exp)]), hasUnit, exp) - | { - pexp_desc = Pexp_sequence (wrapperExpression, internalExpression) - } -> - let (wrap, hasUnit, exp) = spelunkForFunExpression internalExpression in - (wrap, hasUnit, {expression with pexp_desc = Pexp_sequence (wrapperExpression, exp)}) - | e -> ((fun a -> a), false, e) - ) in - let (wrapExpression, hasUnit, expression) = spelunkForFunExpression expression in - (wrapExpressionWithBinding wrapExpression, hasUnit, expression) - in - let (bindingWrapper, hasUnit, expression) = modifiedBinding binding in - let reactComponentAttribute = try - Some(List.find hasAttr binding.pvb_attributes) - with | Not_found -> None in - let (_attr_loc, payload) = match reactComponentAttribute with - | Some (loc, payload) -> (loc.loc, Some payload) - | None -> (emptyLoc, None) in - let props = getPropsAttr payload in - (* do stuff here! *) - let (namedArgList, forwardRef) = recursivelyTransformNamedArgsForMake mapper (modifiedBindingOld binding) [] in - let namedArgListWithKeyAndRef = (optional("key"), None, Pat.var {txt = "key"; loc = emptyLoc}, "key", emptyLoc, Some(keyType emptyLoc)) :: namedArgList in - let namedArgListWithKeyAndRef = match forwardRef with - | Some(_) -> (optional("ref"), None, Pat.var {txt = "key"; loc = emptyLoc}, "ref", emptyLoc, None) :: namedArgListWithKeyAndRef - | None -> namedArgListWithKeyAndRef - in - let namedArgListWithKeyAndRefForNew = match forwardRef with - | Some(txt) -> namedArgList @ [(nolabel, None, Pat.var {txt; loc = emptyLoc}, txt, emptyLoc, None)] - | None -> namedArgList + let nestedModules = ref [] in + let transformComponentDefinition mapper structure returnStructures = + match structure with + (* external *) + | { + pstr_loc; + pstr_desc = Pstr_primitive ({ pval_name = { txt = fnName }; pval_attributes; pval_type } as value_description); + } as pstr -> ( + match List.filter hasAttr pval_attributes with + | [] -> structure :: returnStructures + | [ _ ] -> + let rec getPropTypes types ({ ptyp_loc; ptyp_desc } as fullType) = + match ptyp_desc with + | Ptyp_arrow (name, type_, ({ ptyp_desc = Ptyp_arrow _ } as rest)) when isLabelled name || isOptional name + -> + getPropTypes ((name, ptyp_loc, type_) :: types) rest + | Ptyp_arrow (Nolabel, _type, rest) -> getPropTypes types rest + | Ptyp_arrow (name, type_, returnValue) when isLabelled name || isOptional name -> + (returnValue, (name, returnValue.ptyp_loc, type_) :: types) + | _ -> (fullType, types) + in + let innerType, propTypes = getPropTypes [] pval_type in + let namedTypeList = List.fold_left argToConcreteType [] propTypes in + let pluckLabelAndLoc (label, loc, type_) = (label, None (* default *), loc, Some type_) in + let retPropsType = makePropsType ~loc:pstr_loc namedTypeList in + let externalPropsDecl = + makePropsExternal fnName pstr_loc + ((optional "key", None, pstr_loc, Some (keyType pstr_loc)) :: List.map pluckLabelAndLoc propTypes) + retPropsType + in + (* can't be an arrow because it will defensively uncurry *) + let newExternalType = + Ptyp_constr ({ loc = pstr_loc; txt = Ldot (Lident "React", "componentLike") }, [ retPropsType; innerType ]) + in + let newStructure = + { + pstr with + pstr_desc = + Pstr_primitive + { + value_description with + pval_type = { pval_type with ptyp_desc = newExternalType }; + pval_attributes = List.filter otherAttrsPure pval_attributes; + }; + } + in + externalPropsDecl :: newStructure :: returnStructures + | _ -> raise (Invalid_argument "Only one react.component call can exist on a component at one time") ) + (* let component = ... *) + | { pstr_loc; pstr_desc = Pstr_value (recFlag, valueBindings) } -> + let fileName = filenameFromLoc pstr_loc in + let emptyLoc = Location.in_file fileName in + let mapBinding binding = + if hasAttrOnBinding binding then + let bindingLoc = binding.pvb_loc in + let bindingPatLoc = binding.pvb_pat.ppat_loc in + let binding = { binding with pvb_pat = { binding.pvb_pat with ppat_loc = emptyLoc }; pvb_loc = emptyLoc } in + let fnName = getFnName binding in + let internalFnName = fnName ^ "$Internal" in + let fullModuleName = makeModuleName fileName !nestedModules fnName in + let modifiedBindingOld binding = + let expression = binding.pvb_expr in + (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) + let rec spelunkForFunExpression expression = + match expression with + (* let make = (~prop) => ... *) + | { pexp_desc = Pexp_fun _ } -> expression + (* let make = {let foo = bar in (~prop) => ...} *) + | { pexp_desc = Pexp_let (_recursive, _vbs, returnExpression) } -> + (* here's where we spelunk! *) + spelunkForFunExpression returnExpression + (* let make = React.forwardRef((~prop) => ...) *) + | { pexp_desc = Pexp_apply (_wrapperExpression, [ (Nolabel, innerFunctionExpression) ]) } -> + spelunkForFunExpression innerFunctionExpression + | { pexp_desc = Pexp_sequence (_wrapperExpression, innerFunctionExpression) } -> + spelunkForFunExpression innerFunctionExpression + | _ -> + raise + (Invalid_argument + "react.component calls can only be on function definitions or component wrappers (forwardRef, \ + memo).") + [@@raises Invalid_argument] + in + spelunkForFunExpression expression + in + let modifiedBinding binding = + let hasApplication = ref false in + let wrapExpressionWithBinding expressionFn expression = + Vb.mk ~loc:bindingLoc + ~attrs:(List.filter otherAttrsPure binding.pvb_attributes) + (Pat.var ~loc:bindingPatLoc { loc = bindingPatLoc; txt = fnName }) + (expressionFn expression) + in + let expression = binding.pvb_expr in + let unerasableIgnoreExp exp = + { exp with pexp_attributes = unerasableIgnore emptyLoc :: exp.pexp_attributes } + in + (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) + let rec spelunkForFunExpression expression = + match expression with + (* let make = (~prop) => ... with no final unit *) + | { + pexp_desc = + Pexp_fun + ( ((Labelled _ | Optional _) as label), + default, + pattern, + ({ pexp_desc = Pexp_fun _ } as internalExpression) ); + } -> + let wrap, hasUnit, exp = spelunkForFunExpression internalExpression in + ( wrap, + hasUnit, + unerasableIgnoreExp { expression with pexp_desc = Pexp_fun (label, default, pattern, exp) } ) + (* let make = (()) => ... *) + (* let make = (_) => ... *) + | { + pexp_desc = + Pexp_fun + ( Nolabel, + _default, + { ppat_desc = Ppat_construct ({ txt = Lident "()" }, _) | Ppat_any }, + _internalExpression ); + } -> + ((fun a -> a), true, expression) + (* let make = (~prop) => ... *) + | { pexp_desc = Pexp_fun ((Labelled _ | Optional _), _default, _pattern, _internalExpression) } -> + ((fun a -> a), false, unerasableIgnoreExp expression) + (* let make = (prop) => ... *) + | { pexp_desc = Pexp_fun (_nolabel, _default, pattern, _internalExpression) } -> + if hasApplication.contents then ((fun a -> a), false, unerasableIgnoreExp expression) + else + Location.raise_errorf ~loc:pattern.ppat_loc + "ReasonReact: props need to be labelled arguments.\n\ + \ If you are working with refs be sure to wrap with React.forwardRef.\n\ + \ If your component doesn't have any props use () or _ instead of a name." + (* let make = {let foo = bar in (~prop) => ...} *) + | { pexp_desc = Pexp_let (recursive, vbs, internalExpression) } -> + (* here's where we spelunk! *) + let wrap, hasUnit, exp = spelunkForFunExpression internalExpression in + (wrap, hasUnit, { expression with pexp_desc = Pexp_let (recursive, vbs, exp) }) + (* let make = React.forwardRef((~prop) => ...) *) + | { pexp_desc = Pexp_apply (wrapperExpression, [ (Nolabel, internalExpression) ]) } -> + let () = hasApplication := true in + let _, hasUnit, exp = spelunkForFunExpression internalExpression in + ((fun exp -> Exp.apply wrapperExpression [ (nolabel, exp) ]), hasUnit, exp) + | { pexp_desc = Pexp_sequence (wrapperExpression, internalExpression) } -> + let wrap, hasUnit, exp = spelunkForFunExpression internalExpression in + (wrap, hasUnit, { expression with pexp_desc = Pexp_sequence (wrapperExpression, exp) }) + | e -> ((fun a -> a), false, e) + in + let wrapExpression, hasUnit, expression = spelunkForFunExpression expression in + (wrapExpressionWithBinding wrapExpression, hasUnit, expression) + in + let bindingWrapper, hasUnit, expression = modifiedBinding binding in + let reactComponentAttribute = + try Some (List.find hasAttr binding.pvb_attributes) with Not_found -> None + in + let _attr_loc, payload = + match reactComponentAttribute with + | Some (loc, payload) -> (loc.loc, Some payload) + | None -> (emptyLoc, None) + in + let props = getPropsAttr payload in + (* do stuff here! *) + let namedArgList, forwardRef = + recursivelyTransformNamedArgsForMake mapper (modifiedBindingOld binding) [] + in + let namedArgListWithKeyAndRef = + (optional "key", None, Pat.var { txt = "key"; loc = emptyLoc }, "key", emptyLoc, Some (keyType emptyLoc)) + :: namedArgList + in + let namedArgListWithKeyAndRef = + match forwardRef with + | Some _ -> + (optional "ref", None, Pat.var { txt = "key"; loc = emptyLoc }, "ref", emptyLoc, None) + :: namedArgListWithKeyAndRef + | None -> namedArgListWithKeyAndRef + in + let namedArgListWithKeyAndRefForNew = + match forwardRef with + | Some txt -> namedArgList @ [ (nolabel, None, Pat.var { txt; loc = emptyLoc }, txt, emptyLoc, None) ] + | None -> namedArgList + in + let pluckArg (label, _, _, alias, loc, _) = + let labelString = + match label with label when isOptional label || isLabelled label -> getLabel label | _ -> "" + in + ( label, + match labelString with + | "" -> Exp.ident ~loc { txt = Lident alias; loc } + | labelString -> + Exp.apply ~loc + (Exp.ident ~loc { txt = Lident "##"; loc }) + [ + (nolabel, Exp.ident ~loc { txt = Lident props.propsName; loc }); + (nolabel, Exp.ident ~loc { txt = Lident labelString; loc }); + ] ) + in + let namedTypeList = List.fold_left argToType [] namedArgList in + let loc = emptyLoc in + let externalDecl = makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList in + let innerExpressionArgs = + List.map pluckArg namedArgListWithKeyAndRefForNew + @ if hasUnit then [ (Nolabel, Exp.construct { loc; txt = Lident "()" } None) ] else [] + in + let innerExpression = + Exp.apply + (Exp.ident + { loc; txt = Lident (match recFlag with Recursive -> internalFnName | Nonrecursive -> fnName) }) + innerExpressionArgs + in + let innerExpressionWithRef = + match forwardRef with + | Some txt -> + { + innerExpression with + pexp_desc = + Pexp_fun + ( nolabel, + None, + { ppat_desc = Ppat_var { txt; loc = emptyLoc }; ppat_loc = emptyLoc; ppat_attributes = [] }, + innerExpression ); + } + | None -> innerExpression + in + let fullExpression = + Exp.fun_ nolabel None + { + ppat_desc = + Ppat_constraint + (makePropsName ~loc:emptyLoc props.propsName, makePropsType ~loc:emptyLoc namedTypeList); + ppat_loc = emptyLoc; + ppat_attributes = []; + } + innerExpressionWithRef + in + let fullExpression = + match fullModuleName with + | "" -> fullExpression + | txt -> + Exp.let_ Nonrecursive + [ Vb.mk ~loc:emptyLoc (Pat.var ~loc:emptyLoc { loc = emptyLoc; txt }) fullExpression ] + (Exp.ident ~loc:emptyLoc { loc = emptyLoc; txt = Lident txt }) + in + let bindings, newBinding = + match recFlag with + | Recursive -> + ( [ + bindingWrapper + (Exp.let_ ~loc:emptyLoc Recursive + [ + makeNewBinding binding expression internalFnName; + Vb.mk (Pat.var { loc = emptyLoc; txt = fnName }) fullExpression; + ] + (Exp.ident { loc = emptyLoc; txt = Lident fnName })); + ], + None ) + | Nonrecursive -> + ([ { binding with pvb_expr = expression; pvb_attributes = [] } ], Some (bindingWrapper fullExpression)) + in + (Some externalDecl, bindings, newBinding) + else (None, [ binding ], None) + [@@raises Invalid_argument] in - let pluckArg (label, _, _, alias, loc, _) = - let labelString = (match label with | label when isOptional label || isLabelled label -> getLabel label | _ -> "") in - (label, - (match labelString with - | "" -> (Exp.ident ~loc { - txt = (Lident alias); - loc - }) - | labelString -> (Exp.apply ~loc - (Exp.ident ~loc {txt = (Lident "##"); loc }) - [ - (nolabel, Exp.ident ~loc {txt = (Lident props.propsName); loc }); - (nolabel, Exp.ident ~loc { - txt = (Lident labelString); - loc - }) - ] - ) - ) - ) in - let namedTypeList = List.fold_left argToType [] namedArgList in - let loc = emptyLoc in - let externalDecl = makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList in - let innerExpressionArgs = (List.map pluckArg namedArgListWithKeyAndRefForNew) @ - if hasUnit then [(Nolabel, Exp.construct {loc; txt = Lident "()"} None)] else [] in - let innerExpression = Exp.apply (Exp.ident {loc; txt = Lident( - match recFlag with - | Recursive -> internalFnName - | Nonrecursive -> fnName - )}) innerExpressionArgs in - let innerExpressionWithRef = match (forwardRef) with - | Some txt -> - {innerExpression with pexp_desc = Pexp_fun (nolabel, None, { - ppat_desc = Ppat_var { txt; loc = emptyLoc }; - ppat_loc = emptyLoc; - ppat_attributes = []; - }, innerExpression)} - | None -> innerExpression + let structuresAndBinding = List.map mapBinding valueBindings in + let otherStructures (extern, binding, newBinding) (externs, bindings, newBindings) = + let externs = match extern with Some extern -> extern :: externs | None -> externs in + let newBindings = + match newBinding with Some newBinding -> newBinding :: newBindings | None -> newBindings + in + (externs, binding @ bindings, newBindings) in - let fullExpression = Exp.fun_ - nolabel - None - { - ppat_desc = Ppat_constraint ( - makePropsName ~loc:emptyLoc props.propsName, - makePropsType ~loc:emptyLoc namedTypeList - ); - ppat_loc = emptyLoc; - ppat_attributes = []; - } - innerExpressionWithRef in - let fullExpression = match (fullModuleName) with - | ("") -> fullExpression - | (txt) -> Exp.let_ - Nonrecursive - [Vb.mk - ~loc:emptyLoc - (Pat.var ~loc:emptyLoc {loc = emptyLoc; txt}) - fullExpression - ] - (Exp.ident ~loc:emptyLoc {loc = emptyLoc; txt = Lident txt}) in - let (bindings, newBinding) = - match recFlag with - | Recursive -> ([bindingWrapper (Exp.let_ - ~loc:(emptyLoc) - Recursive - [ - makeNewBinding binding expression internalFnName; - Vb.mk (Pat.var {loc = emptyLoc; txt = fnName}) fullExpression - ] - (Exp.ident {loc = emptyLoc; txt = Lident fnName}))], None) - | Nonrecursive -> ([{ binding with pvb_expr = expression; pvb_attributes = [] }], Some(bindingWrapper fullExpression)) - in - (Some externalDecl, bindings, newBinding) - else - (None, [binding], None) - in - let structuresAndBinding = List.map mapBinding valueBindings in - let otherStructures (extern, binding, newBinding) (externs, bindings, newBindings) = - let externs = match extern with - | Some extern -> extern :: externs - | None -> externs in - let newBindings = match newBinding with - | Some newBinding -> newBinding :: newBindings - | None -> newBindings in - (externs, binding @ bindings, newBindings) - in - let (externs, bindings, newBindings) = List.fold_right otherStructures structuresAndBinding ([], [], []) in - externs @ [{ - pstr_loc; - pstr_desc = Pstr_value ( - recFlag, - bindings - ) - }] @ (match newBindings with - | [] -> [] - | newBindings -> [{ - pstr_loc = emptyLoc; - pstr_desc = Pstr_value ( - recFlag, - newBindings - ) - }]) @ returnStructures - | structure -> structure :: returnStructures in + let externs, bindings, newBindings = List.fold_right otherStructures structuresAndBinding ([], [], []) in + externs + @ [ { pstr_loc; pstr_desc = Pstr_value (recFlag, bindings) } ] + @ ( match newBindings with + | [] -> [] + | newBindings -> [ { pstr_loc = emptyLoc; pstr_desc = Pstr_value (recFlag, newBindings) } ] ) + @ returnStructures + | structure -> structure :: returnStructures + [@@raises Invalid_argument] + in let reactComponentTransform mapper structures = - List.fold_right (transformComponentDefinition mapper) structures [] in - - let transformComponentSignature _mapper signature returnSignatures = match signature with - | ({ - psig_loc; - psig_desc = Psig_value ({ - pval_name = { txt = fnName }; - pval_attributes; - pval_type; - } as psig_desc) - } as psig) -> - (match List.filter hasAttr pval_attributes with - | [] -> signature :: returnSignatures - | [_] -> - let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = - (match ptyp_desc with - | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) when isOptional name || isLabelled name -> - getPropTypes ((name, ptyp_loc, type_)::types) rest - | Ptyp_arrow (Nolabel, _type, rest) -> - getPropTypes types rest - | Ptyp_arrow (name, type_, returnValue) when isOptional name || isLabelled name -> - (returnValue, (name, returnValue.ptyp_loc, type_)::types) - | _ -> (fullType, types)) - in - let (innerType, propTypes) = getPropTypes [] pval_type in - let namedTypeList = List.fold_left argToConcreteType [] propTypes in - let pluckLabelAndLoc (label, loc, type_) = (label, None, loc, Some type_) in - let retPropsType = makePropsType ~loc:psig_loc namedTypeList in - let externalPropsDecl = makePropsExternalSig fnName psig_loc (( - optional "key", - None, - psig_loc, - Some(keyType psig_loc) - ) :: List.map pluckLabelAndLoc propTypes) retPropsType in - (* can't be an arrow because it will defensively uncurry *) - let newExternalType = Ptyp_constr ( - {loc = psig_loc; txt = Ldot ((Lident "React"), "componentLike")}, - [retPropsType; innerType] - ) in - let newStructure = { - psig with psig_desc = Psig_value { - psig_desc with pval_type = { - pval_type with ptyp_desc = newExternalType; - }; - pval_attributes = List.filter otherAttrsPure pval_attributes; - } - } in - externalPropsDecl :: newStructure :: returnSignatures - | _ -> raise (Invalid_argument "Only one react.component call can exist on a component at one time")) - | signature -> signature :: returnSignatures in + List.fold_right (transformComponentDefinition mapper) structures [] + [@@raises Invalid_argument] + in - let reactComponentSignatureTransform mapper signatures = - List.fold_right (transformComponentSignature mapper) signatures [] in + let transformComponentSignature _mapper signature returnSignatures = + match signature with + | { psig_loc; psig_desc = Psig_value ({ pval_name = { txt = fnName }; pval_attributes; pval_type } as psig_desc) } + as psig -> ( + match List.filter hasAttr pval_attributes with + | [] -> signature :: returnSignatures + | [ _ ] -> + let rec getPropTypes types ({ ptyp_loc; ptyp_desc } as fullType) = + match ptyp_desc with + | Ptyp_arrow (name, type_, ({ ptyp_desc = Ptyp_arrow _ } as rest)) when isOptional name || isLabelled name + -> + getPropTypes ((name, ptyp_loc, type_) :: types) rest + | Ptyp_arrow (Nolabel, _type, rest) -> getPropTypes types rest + | Ptyp_arrow (name, type_, returnValue) when isOptional name || isLabelled name -> + (returnValue, (name, returnValue.ptyp_loc, type_) :: types) + | _ -> (fullType, types) + in + let innerType, propTypes = getPropTypes [] pval_type in + let namedTypeList = List.fold_left argToConcreteType [] propTypes in + let pluckLabelAndLoc (label, loc, type_) = (label, None, loc, Some type_) in + let retPropsType = makePropsType ~loc:psig_loc namedTypeList in + let externalPropsDecl = + makePropsExternalSig fnName psig_loc + ((optional "key", None, psig_loc, Some (keyType psig_loc)) :: List.map pluckLabelAndLoc propTypes) + retPropsType + in + (* can't be an arrow because it will defensively uncurry *) + let newExternalType = + Ptyp_constr ({ loc = psig_loc; txt = Ldot (Lident "React", "componentLike") }, [ retPropsType; innerType ]) + in + let newStructure = + { + psig with + psig_desc = + Psig_value + { + psig_desc with + pval_type = { pval_type with ptyp_desc = newExternalType }; + pval_attributes = List.filter otherAttrsPure pval_attributes; + }; + } + in + externalPropsDecl :: newStructure :: returnSignatures + | _ -> raise (Invalid_argument "Only one react.component call can exist on a component at one time") ) + | signature -> signature :: returnSignatures + [@@raises Invalid_argument] + in + let reactComponentSignatureTransform mapper signatures = + List.fold_right (transformComponentSignature mapper) signatures [] + [@@raises Invalid_argument] + in let transformJsxCall mapper callExpression callArguments attrs = - (match callExpression.pexp_desc with - | Pexp_ident caller -> - (match caller with - | {txt = Lident "createElement"} -> - raise (Invalid_argument "JSX: `createElement` should be preceeded by a module name.") - + match callExpression.pexp_desc with + | Pexp_ident caller -> ( + match caller with + | { txt = Lident "createElement" } -> + raise (Invalid_argument "JSX: `createElement` should be preceeded by a module name.") (* Foo.createElement(~prop1=foo, ~prop2=bar, ~children=[], ()) *) - | {loc; txt = Ldot (modulePath, ("createElement" | "make"))} -> - (match !jsxVersion with - | None - | Some 3 -> transformUppercaseCall3 modulePath mapper loc attrs callExpression callArguments - | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 3")) - + | { loc; txt = Ldot (modulePath, ("createElement" | "make")) } -> ( + match !jsxVersion with + | None | Some 3 -> transformUppercaseCall3 modulePath mapper loc attrs callExpression callArguments + | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 3") ) (* div(~prop1=foo, ~prop2=bar, ~children=[bla], ()) *) (* turn that into - ReactDOMRe.createElement(~props=ReactDOMRe.props(~props1=foo, ~props2=bar, ()), [|bla|]) *) - | {loc; txt = Lident id} -> - (match !jsxVersion with - | None - | Some 3 -> transformLowercaseCall3 mapper loc attrs callArguments id - | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 3")) - - | {txt = Ldot (_, anythingNotCreateElementOrMake)} -> - raise ( - Invalid_argument - ("JSX: the JSX attribute should be attached to a `YourModuleName.createElement` or `YourModuleName.make` call. We saw `" - ^ anythingNotCreateElementOrMake - ^ "` instead" - ) - ) - - | {txt = Lapply _} -> - (* don't think there's ever a case where this is reached *) - raise ( - Invalid_argument "JSX: encountered a weird case while processing the code. Please report this!" - ) - ) - | _ -> - raise ( - Invalid_argument "JSX: `createElement` should be preceeded by a simple, direct module name." - ) - ) in + ReactDOMRe.createElement(~props=ReactDOMRe.props(~props1=foo, ~props2=bar, ()), [|bla|]) *) + | { loc; txt = Lident id } -> ( + match !jsxVersion with + | None | Some 3 -> transformLowercaseCall3 mapper loc attrs callArguments id + | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 3") ) + | { txt = Ldot (_, anythingNotCreateElementOrMake) } -> + raise + (Invalid_argument + ( "JSX: the JSX attribute should be attached to a `YourModuleName.createElement` or \ + `YourModuleName.make` call. We saw `" ^ anythingNotCreateElementOrMake ^ "` instead" )) + | { txt = Lapply _ } -> + (* don't think there's ever a case where this is reached *) + raise (Invalid_argument "JSX: encountered a weird case while processing the code. Please report this!") ) + | _ -> raise (Invalid_argument "JSX: `createElement` should be preceeded by a simple, direct module name.") + [@@raises Invalid_argument] + in - let signature = - (fun mapper signature -> default_mapper.signature mapper @@ reactComponentSignatureTransform mapper signature) in + let signature mapper signature = + default_mapper.signature mapper @@ reactComponentSignatureTransform mapper signature + [@@raises Invalid_argument] + in - let structure = - (fun mapper structure -> match structure with - | structures -> begin - default_mapper.structure mapper @@ reactComponentTransform mapper structures - end - ) in + let structure mapper structure = + match structure with structures -> default_mapper.structure mapper @@ reactComponentTransform mapper structures + [@@raises Invalid_argument] + in - let expr = - (fun mapper expression -> match expression with - (* Does the function application have the @JSX attribute? *) - | { - pexp_desc = Pexp_apply (callExpression, callArguments); - pexp_attributes - } -> - let (jsxAttribute, nonJSXAttributes) = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - (match (jsxAttribute, nonJSXAttributes) with - (* no JSX attribute *) - | ([], _) -> default_mapper.expr mapper expression - | (_, nonJSXAttributes) -> transformJsxCall mapper callExpression callArguments nonJSXAttributes) - - (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) - | { - pexp_desc = - Pexp_construct ({txt = Lident "::"; loc}, Some {pexp_desc = Pexp_tuple _}) - | Pexp_construct ({txt = Lident "[]"; loc}, None); - pexp_attributes - } as listItems -> - let (jsxAttribute, nonJSXAttributes) = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - (match (jsxAttribute, nonJSXAttributes) with - (* no JSX attribute *) - | ([], _) -> default_mapper.expr mapper expression - | (_, nonJSXAttributes) -> - let fragment = Exp.ident ~loc {loc; txt = Ldot (Lident "ReasonReact", "fragment")} in + let expr mapper expression = + match expression with + (* Does the function application have the @JSX attribute? *) + | { pexp_desc = Pexp_apply (callExpression, callArguments); pexp_attributes } -> ( + let jsxAttribute, nonJSXAttributes = + List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes + in + match (jsxAttribute, nonJSXAttributes) with + (* no JSX attribute *) + | [], _ -> default_mapper.expr mapper expression + | _, nonJSXAttributes -> transformJsxCall mapper callExpression callArguments nonJSXAttributes ) + (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) + | { + pexp_desc = + ( Pexp_construct ({ txt = Lident "::"; loc }, Some { pexp_desc = Pexp_tuple _ }) + | Pexp_construct ({ txt = Lident "[]"; loc }, None) ); + pexp_attributes; + } as listItems -> ( + let jsxAttribute, nonJSXAttributes = + List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes + in + match (jsxAttribute, nonJSXAttributes) with + (* no JSX attribute *) + | [], _ -> default_mapper.expr mapper expression + | _, nonJSXAttributes -> + let fragment = Exp.ident ~loc { loc; txt = Ldot (Lident "ReasonReact", "fragment") } in let childrenExpr = transformChildrenIfList ~loc ~mapper listItems in - let args = [ - (* "div" *) - (nolabel, fragment); - (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] in - Exp.apply - ~loc - (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs:nonJSXAttributes + let args = + [ (* "div" *) (nolabel, fragment); (* [|moreCreateElementCallsHere|] *) (nolabel, childrenExpr) ] + in + Exp.apply ~loc (* throw away the [@JSX] attribute and keep the others, if any *) ~attrs:nonJSXAttributes (* ReactDOMRe.createElement *) - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "createElement")}) - args - ) - (* Delegate to the default mapper, a deep identity traversal *) - | e -> default_mapper.expr mapper e) in - - let module_binding = - (fun mapper module_binding -> - let _ = nestedModules := module_binding.pmb_name.txt :: !nestedModules in - let mapped = default_mapper.module_binding mapper module_binding in - let _ = nestedModules := List.tl !nestedModules in - mapped - ) in + (Exp.ident ~loc { loc; txt = Ldot (Lident "ReactDOMRe", "createElement") }) + args ) + (* Delegate to the default mapper, a deep identity traversal *) + | e -> default_mapper.expr mapper e + [@@raises Invalid_argument] + in - { default_mapper with structure; expr; signature; module_binding; } + let module_binding mapper module_binding = + let _ = nestedModules := module_binding.pmb_name.txt :: !nestedModules in + let mapped = default_mapper.module_binding mapper module_binding in + let _ = nestedModules := List.tl !nestedModules in + mapped + [@@raises Failure] + in + { default_mapper with structure; expr; signature; module_binding } + [@@raises Invalid_argument, Failure] -let rewrite_implementation (code: Parsetree.structure) : Parsetree.structure = +let rewrite_implementation (code : Parsetree.structure) : Parsetree.structure = let mapper = jsxMapper () in mapper.structure mapper code + [@@raises Invalid_argument, Failure] + let rewrite_signature (code : Parsetree.signature) : Parsetree.signature = let mapper = jsxMapper () in mapper.signature mapper code - + [@@raises Invalid_argument, Failure] end module Ppx_entry diff --git a/lib/4.06.1/unstable/js_compiler.ml.d b/lib/4.06.1/unstable/js_compiler.ml.d index fb82dc653c..bed82fe89b 100644 --- a/lib/4.06.1/unstable/js_compiler.ml.d +++ b/lib/4.06.1/unstable/js_compiler.ml.d @@ -1 +1 @@ -../lib/4.06.1/unstable/js_compiler.ml: ../ocaml/bytecomp/lambda.ml ../ocaml/bytecomp/lambda.mli ../ocaml/bytecomp/matching.ml ../ocaml/bytecomp/matching.mli ../ocaml/bytecomp/printlambda.ml ../ocaml/bytecomp/printlambda.mli ../ocaml/bytecomp/switch.ml ../ocaml/bytecomp/switch.mli ../ocaml/bytecomp/translattribute.ml ../ocaml/bytecomp/translattribute.mli ../ocaml/bytecomp/translclass.ml ../ocaml/bytecomp/translclass.mli ../ocaml/bytecomp/translcore.ml ../ocaml/bytecomp/translcore.mli ../ocaml/bytecomp/translmod.ml ../ocaml/bytecomp/translmod.mli ../ocaml/bytecomp/translobj.ml ../ocaml/bytecomp/translobj.mli ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/ast_iterator.ml ../ocaml/parsing/ast_iterator.mli ../ocaml/parsing/ast_mapper.ml ../ocaml/parsing/ast_mapper.mli ../ocaml/parsing/asttypes.mli ../ocaml/parsing/attr_helper.ml ../ocaml/parsing/attr_helper.mli ../ocaml/parsing/builtin_attributes.ml ../ocaml/parsing/builtin_attributes.mli ../ocaml/parsing/docstrings.ml ../ocaml/parsing/docstrings.mli ../ocaml/parsing/lexer.ml ../ocaml/parsing/lexer.mli ../ocaml/parsing/location.ml ../ocaml/parsing/location.mli ../ocaml/parsing/longident.ml ../ocaml/parsing/longident.mli ../ocaml/parsing/parse.ml ../ocaml/parsing/parse.mli ../ocaml/parsing/parser.ml ../ocaml/parsing/parser.mli ../ocaml/parsing/parsetree.mli ../ocaml/parsing/syntaxerr.ml ../ocaml/parsing/syntaxerr.mli ../ocaml/typing/annot.mli ../ocaml/typing/btype.ml ../ocaml/typing/btype.mli ../ocaml/typing/cmi_format.ml ../ocaml/typing/cmi_format.mli ../ocaml/typing/cmt_format.ml ../ocaml/typing/cmt_format.mli ../ocaml/typing/ctype.ml ../ocaml/typing/ctype.mli ../ocaml/typing/datarepr.ml ../ocaml/typing/datarepr.mli ../ocaml/typing/env.ml ../ocaml/typing/env.mli ../ocaml/typing/ident.ml ../ocaml/typing/ident.mli ../ocaml/typing/includeclass.ml ../ocaml/typing/includeclass.mli ../ocaml/typing/includecore.ml ../ocaml/typing/includecore.mli ../ocaml/typing/includemod.ml ../ocaml/typing/includemod.mli ../ocaml/typing/mtype.ml ../ocaml/typing/mtype.mli ../ocaml/typing/oprint.ml ../ocaml/typing/oprint.mli ../ocaml/typing/outcometree.mli ../ocaml/typing/parmatch.ml ../ocaml/typing/parmatch.mli ../ocaml/typing/path.ml ../ocaml/typing/path.mli ../ocaml/typing/predef.ml ../ocaml/typing/predef.mli ../ocaml/typing/primitive.ml ../ocaml/typing/primitive.mli ../ocaml/typing/printtyp.ml ../ocaml/typing/printtyp.mli ../ocaml/typing/stypes.ml ../ocaml/typing/stypes.mli ../ocaml/typing/subst.ml ../ocaml/typing/subst.mli ../ocaml/typing/tast_mapper.ml ../ocaml/typing/tast_mapper.mli ../ocaml/typing/typeclass.ml ../ocaml/typing/typeclass.mli ../ocaml/typing/typecore.ml ../ocaml/typing/typecore.mli ../ocaml/typing/typedecl.ml ../ocaml/typing/typedecl.mli ../ocaml/typing/typedtree.ml ../ocaml/typing/typedtree.mli ../ocaml/typing/typedtreeIter.ml ../ocaml/typing/typedtreeIter.mli ../ocaml/typing/typemod.ml ../ocaml/typing/typemod.mli ../ocaml/typing/typeopt.ml ../ocaml/typing/typeopt.mli ../ocaml/typing/types.ml ../ocaml/typing/types.mli ../ocaml/typing/typetexp.ml ../ocaml/typing/typetexp.mli ../ocaml/typing/untypeast.ml ../ocaml/typing/untypeast.mli ../ocaml/utils/arg_helper.ml ../ocaml/utils/arg_helper.mli ../ocaml/utils/ccomp.ml ../ocaml/utils/ccomp.mli ../ocaml/utils/clflags.ml ../ocaml/utils/clflags.mli ../ocaml/utils/consistbl.ml ../ocaml/utils/consistbl.mli ../ocaml/utils/identifiable.ml ../ocaml/utils/identifiable.mli ../ocaml/utils/misc.ml ../ocaml/utils/misc.mli ../ocaml/utils/numbers.ml ../ocaml/utils/numbers.mli ../ocaml/utils/profile.ml ../ocaml/utils/profile.mli ../ocaml/utils/tbl.ml ../ocaml/utils/tbl.mli ../ocaml/utils/warnings.ml ../ocaml/utils/warnings.mli ./common/bs_loc.ml ./common/bs_loc.mli ./common/bs_version.ml ./common/bs_version.mli ./common/bs_warnings.ml ./common/bs_warnings.mli ./common/ext_log.ml ./common/ext_log.mli ./common/js_config.ml ./common/js_config.mli ./common/lam_methname.ml ./common/lam_methname.mli ./core/bs_cmi_load.ml ./core/bs_conditional_initial.ml ./core/bs_conditional_initial.mli ./core/compile_rec_module.ml ./core/config_util.ml ./core/config_util.mli ./core/config_whole_compiler.ml ./core/config_whole_compiler.mli ./core/j.ml ./core/js_analyzer.ml ./core/js_analyzer.mli ./core/js_arr.ml ./core/js_arr.mli ./core/js_ast_util.ml ./core/js_ast_util.mli ./core/js_block_runtime.ml ./core/js_block_runtime.mli ./core/js_call_info.ml ./core/js_call_info.mli ./core/js_closure.ml ./core/js_closure.mli ./core/js_cmj_format.ml ./core/js_cmj_format.mli ./core/js_cmj_load.ml ./core/js_cmj_load.mli ./core/js_cmj_load_builtin_unit.ml ./core/js_dump.ml ./core/js_dump.mli ./core/js_dump_import_export.ml ./core/js_dump_import_export.mli ./core/js_dump_lit.ml ./core/js_dump_program.ml ./core/js_dump_program.mli ./core/js_dump_property.ml ./core/js_dump_property.mli ./core/js_dump_string.ml ./core/js_dump_string.mli ./core/js_exp_make.ml ./core/js_exp_make.mli ./core/js_fold.ml ./core/js_fold_basic.ml ./core/js_fold_basic.mli ./core/js_fun_env.ml ./core/js_fun_env.mli ./core/js_long.ml ./core/js_long.mli ./core/js_map.ml ./core/js_name_of_module_id.ml ./core/js_name_of_module_id.mli ./core/js_number.ml ./core/js_number.mli ./core/js_of_lam_array.ml ./core/js_of_lam_array.mli ./core/js_of_lam_block.ml ./core/js_of_lam_block.mli ./core/js_of_lam_exception.ml ./core/js_of_lam_exception.mli ./core/js_of_lam_option.ml ./core/js_of_lam_option.mli ./core/js_of_lam_string.ml ./core/js_of_lam_string.mli ./core/js_of_lam_variant.ml ./core/js_of_lam_variant.mli ./core/js_op.ml ./core/js_op_util.ml ./core/js_op_util.mli ./core/js_output.ml ./core/js_output.mli ./core/js_packages_info.ml ./core/js_packages_info.mli ./core/js_packages_state.ml ./core/js_packages_state.mli ./core/js_pass_debug.ml ./core/js_pass_debug.mli ./core/js_pass_flatten.ml ./core/js_pass_flatten.mli ./core/js_pass_flatten_and_mark_dead.ml ./core/js_pass_flatten_and_mark_dead.mli ./core/js_pass_get_used.ml ./core/js_pass_get_used.mli ./core/js_pass_scope.ml ./core/js_pass_scope.mli ./core/js_pass_tailcall_inline.ml ./core/js_pass_tailcall_inline.mli ./core/js_raw_info.ml ./core/js_shake.ml ./core/js_shake.mli ./core/js_stmt_make.ml ./core/js_stmt_make.mli ./core/lam.ml ./core/lam.mli ./core/lam_analysis.ml ./core/lam_analysis.mli ./core/lam_arity.ml ./core/lam_arity.mli ./core/lam_arity_analysis.ml ./core/lam_arity_analysis.mli ./core/lam_beta_reduce.ml ./core/lam_beta_reduce.mli ./core/lam_beta_reduce_util.ml ./core/lam_beta_reduce_util.mli ./core/lam_bounded_vars.ml ./core/lam_bounded_vars.mli ./core/lam_closure.ml ./core/lam_closure.mli ./core/lam_coercion.ml ./core/lam_coercion.mli ./core/lam_compat.ml ./core/lam_compat.mli ./core/lam_compile.ml ./core/lam_compile.mli ./core/lam_compile_const.ml ./core/lam_compile_const.mli ./core/lam_compile_context.ml ./core/lam_compile_context.mli ./core/lam_compile_env.ml ./core/lam_compile_env.mli ./core/lam_compile_external_call.ml ./core/lam_compile_external_call.mli ./core/lam_compile_external_obj.ml ./core/lam_compile_external_obj.mli ./core/lam_compile_main.ml ./core/lam_compile_main.mli ./core/lam_compile_primitive.ml ./core/lam_compile_primitive.mli ./core/lam_compile_util.ml ./core/lam_compile_util.mli ./core/lam_constant.ml ./core/lam_constant.mli ./core/lam_constant_convert.ml ./core/lam_constant_convert.mli ./core/lam_convert.ml ./core/lam_convert.mli ./core/lam_dce.ml ./core/lam_dce.mli ./core/lam_dispatch_primitive.ml ./core/lam_dispatch_primitive.mli ./core/lam_eta_conversion.ml ./core/lam_eta_conversion.mli ./core/lam_exit_code.ml ./core/lam_exit_code.mli ./core/lam_exit_count.ml ./core/lam_exit_count.mli ./core/lam_free_variables.ml ./core/lam_free_variables.mli ./core/lam_group.ml ./core/lam_group.mli ./core/lam_hit.ml ./core/lam_hit.mli ./core/lam_id_kind.ml ./core/lam_id_kind.mli ./core/lam_iter.ml ./core/lam_iter.mli ./core/lam_module_ident.ml ./core/lam_module_ident.mli ./core/lam_pass_alpha_conversion.ml ./core/lam_pass_alpha_conversion.mli ./core/lam_pass_collect.ml ./core/lam_pass_collect.mli ./core/lam_pass_count.ml ./core/lam_pass_count.mli ./core/lam_pass_deep_flatten.ml ./core/lam_pass_deep_flatten.mli ./core/lam_pass_eliminate_ref.ml ./core/lam_pass_eliminate_ref.mli ./core/lam_pass_exits.ml ./core/lam_pass_exits.mli ./core/lam_pass_lets_dce.ml ./core/lam_pass_lets_dce.mli ./core/lam_pass_remove_alias.ml ./core/lam_pass_remove_alias.mli ./core/lam_pointer_info.ml ./core/lam_pointer_info.mli ./core/lam_primitive.ml ./core/lam_primitive.mli ./core/lam_print.ml ./core/lam_print.mli ./core/lam_scc.ml ./core/lam_scc.mli ./core/lam_stats.ml ./core/lam_stats.mli ./core/lam_stats_export.ml ./core/lam_stats_export.mli ./core/lam_subst.ml ./core/lam_subst.mli ./core/lam_tag_info.ml ./core/lam_util.ml ./core/lam_util.mli ./core/lam_var_stats.ml ./core/lam_var_stats.mli ./core/matching_polyfill.ml ./core/matching_polyfill.mli ./core/polyvar_pattern_match.ml ./core/record_attributes_check.ml ./core/res_compmisc.ml ./core/res_compmisc.mli ./core/transl_single_field_record.ml ./depends/bs_exception.ml ./depends/bs_exception.mli ./ext/bsc_args.ml ./ext/bsc_args.mli ./ext/bsc_warnings.ml ./ext/ext_array.ml ./ext/ext_array.mli ./ext/ext_buffer.ml ./ext/ext_buffer.mli ./ext/ext_bytes.ml ./ext/ext_bytes.mli ./ext/ext_char.ml ./ext/ext_char.mli ./ext/ext_digest.ml ./ext/ext_digest.mli ./ext/ext_filename.ml ./ext/ext_filename.mli ./ext/ext_fmt.ml ./ext/ext_ident.ml ./ext/ext_ident.mli ./ext/ext_int.ml ./ext/ext_int.mli ./ext/ext_io.ml ./ext/ext_io.mli ./ext/ext_js_file_kind.ml ./ext/ext_js_suffix.ml ./ext/ext_list.ml ./ext/ext_list.mli ./ext/ext_marshal.ml ./ext/ext_marshal.mli ./ext/ext_modulename.ml ./ext/ext_modulename.mli ./ext/ext_namespace.ml ./ext/ext_namespace.mli ./ext/ext_option.ml ./ext/ext_option.mli ./ext/ext_path.ml ./ext/ext_path.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli ./ext/ext_pp.ml ./ext/ext_pp.mli ./ext/ext_pp_scope.ml ./ext/ext_pp_scope.mli ./ext/ext_ref.ml ./ext/ext_ref.mli ./ext/ext_scc.ml ./ext/ext_scc.mli ./ext/ext_spec.ml ./ext/ext_spec.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_string_array.ml ./ext/ext_string_array.mli ./ext/ext_sys.ml ./ext/ext_sys.mli ./ext/ext_utf8.ml ./ext/ext_utf8.mli ./ext/ext_util.ml ./ext/ext_util.mli ./ext/hash.ml ./ext/hash.mli ./ext/hash_gen.ml ./ext/hash_ident.ml ./ext/hash_ident.mli ./ext/hash_int.ml ./ext/hash_int.mli ./ext/hash_set.ml ./ext/hash_set.mli ./ext/hash_set_gen.ml ./ext/hash_set_ident.ml ./ext/hash_set_ident.mli ./ext/hash_set_ident_mask.ml ./ext/hash_set_ident_mask.mli ./ext/hash_set_poly.ml ./ext/hash_set_poly.mli ./ext/hash_set_string.ml ./ext/hash_set_string.mli ./ext/hash_string.ml ./ext/hash_string.mli ./ext/int_vec_util.ml ./ext/int_vec_util.mli ./ext/int_vec_vec.ml ./ext/int_vec_vec.mli ./ext/js_reserved_map.ml ./ext/js_reserved_map.mli ./ext/js_runtime_modules.ml ./ext/literals.ml ./ext/map_gen.ml ./ext/map_gen.mli ./ext/map_ident.ml ./ext/map_ident.mli ./ext/map_int.ml ./ext/map_int.mli ./ext/map_string.ml ./ext/map_string.mli ./ext/ordered_hash_map_gen.ml ./ext/ordered_hash_map_local_ident.ml ./ext/ordered_hash_map_local_ident.mli ./ext/set_gen.ml ./ext/set_gen.mli ./ext/set_ident.ml ./ext/set_ident.mli ./ext/set_string.ml ./ext/set_string.mli ./ext/vec.ml ./ext/vec.mli ./ext/vec_gen.ml ./ext/vec_int.ml ./ext/vec_int.mli ./js_parser/declaration_parser.ml ./js_parser/enum_common.ml ./js_parser/enum_parser.ml ./js_parser/expression_parser.ml ./js_parser/file_key.ml ./js_parser/flow_ast.ml ./js_parser/flow_ast_utils.ml ./js_parser/flow_ast_utils.mli ./js_parser/flow_lexer.ml ./js_parser/flow_lexer.mli ./js_parser/jsx_parser.ml ./js_parser/lex_env.ml ./js_parser/lex_result.ml ./js_parser/loc.ml ./js_parser/loc.mli ./js_parser/object_parser.ml ./js_parser/parse_error.ml ./js_parser/parser_common.ml ./js_parser/parser_env.ml ./js_parser/parser_env.mli ./js_parser/parser_flow.ml ./js_parser/pattern_cover.ml ./js_parser/pattern_parser.ml ./js_parser/sedlexing.ml ./js_parser/sedlexing.mli ./js_parser/statement_parser.ml ./js_parser/token.ml ./js_parser/type_parser.ml ./js_parser/wtf8.ml ./js_parser/wtf8.mli ./main/builtin_cmi_datasets.ml ./main/builtin_cmi_datasets.mli ./main/builtin_cmj_datasets.ml ./main/builtin_cmj_datasets.mli ./main/jsoo_common.ml ./main/jsoo_common.mli ./main/jsoo_main.ml ./main/jsoo_main.mli ./outcome_printer/outcome_printer_ns.ml ./outcome_printer/outcome_printer_ns.mli ./stubs/bs_hash_stubs.ml ./super_errors/super_env.ml ./super_errors/super_location.ml ./super_errors/super_location.mli ./super_errors/super_main.ml ./super_errors/super_misc.ml ./super_errors/super_misc.mli ./super_errors/super_pparse.ml ./super_errors/super_typecore.ml ./super_errors/super_typemod.ml ./super_errors/super_typetexp.ml ./syntax/ast_attributes.ml ./syntax/ast_attributes.mli ./syntax/ast_bs_open.ml ./syntax/ast_bs_open.mli ./syntax/ast_comb.ml ./syntax/ast_comb.mli ./syntax/ast_compatible.ml ./syntax/ast_compatible.mli ./syntax/ast_config.ml ./syntax/ast_config.mli ./syntax/ast_core_type.ml ./syntax/ast_core_type.mli ./syntax/ast_core_type_class_type.ml ./syntax/ast_core_type_class_type.mli ./syntax/ast_derive.ml ./syntax/ast_derive.mli ./syntax/ast_derive_abstract.ml ./syntax/ast_derive_abstract.mli ./syntax/ast_derive_js_mapper.ml ./syntax/ast_derive_js_mapper.mli ./syntax/ast_derive_projector.ml ./syntax/ast_derive_projector.mli ./syntax/ast_derive_util.ml ./syntax/ast_derive_util.mli ./syntax/ast_exp.ml ./syntax/ast_exp.mli ./syntax/ast_exp_apply.ml ./syntax/ast_exp_apply.mli ./syntax/ast_exp_extension.ml ./syntax/ast_exp_extension.mli ./syntax/ast_exp_handle_external.ml ./syntax/ast_exp_handle_external.mli ./syntax/ast_external.ml ./syntax/ast_external.mli ./syntax/ast_external_mk.ml ./syntax/ast_external_mk.mli ./syntax/ast_external_process.ml ./syntax/ast_external_process.mli ./syntax/ast_literal.ml ./syntax/ast_literal.mli ./syntax/ast_open_cxt.ml ./syntax/ast_open_cxt.mli ./syntax/ast_pat.ml ./syntax/ast_pat.mli ./syntax/ast_payload.ml ./syntax/ast_payload.mli ./syntax/ast_polyvar.ml ./syntax/ast_polyvar.mli ./syntax/ast_reason_pp.ml ./syntax/ast_reason_pp.mli ./syntax/ast_signature.ml ./syntax/ast_signature.mli ./syntax/ast_structure.ml ./syntax/ast_structure.mli ./syntax/ast_tdcls.ml ./syntax/ast_tdcls.mli ./syntax/ast_tuple_pattern_flatten.ml ./syntax/ast_tuple_pattern_flatten.mli ./syntax/ast_typ_uncurry.ml ./syntax/ast_typ_uncurry.mli ./syntax/ast_uncurry_apply.ml ./syntax/ast_uncurry_apply.mli ./syntax/ast_uncurry_gen.ml ./syntax/ast_uncurry_gen.mli ./syntax/ast_utf8_string.ml ./syntax/ast_utf8_string.mli ./syntax/ast_utf8_string_interp.ml ./syntax/ast_utf8_string_interp.mli ./syntax/ast_util.ml ./syntax/ast_util.mli ./syntax/bs_ast_invariant.ml ./syntax/bs_ast_invariant.mli ./syntax/bs_ast_mapper.ml ./syntax/bs_ast_mapper.mli ./syntax/bs_builtin_ppx.ml ./syntax/bs_builtin_ppx.mli ./syntax/bs_flow_ast_utils.ml ./syntax/bs_flow_ast_utils.mli ./syntax/bs_syntaxerr.ml ./syntax/bs_syntaxerr.mli ./syntax/classify_function.ml ./syntax/classify_function.mli ./syntax/external_arg_spec.ml ./syntax/external_arg_spec.mli ./syntax/external_ffi_types.ml ./syntax/external_ffi_types.mli ./syntax/ppx_entry.ml ./syntax/reactjs_jsx_ppx_v3.ml ./syntax/typemod_hide.ml \ No newline at end of file +../lib/4.06.1/unstable/js_compiler.ml: ../ocaml/bytecomp/lambda.ml ../ocaml/bytecomp/lambda.mli ../ocaml/bytecomp/matching.ml ../ocaml/bytecomp/matching.mli ../ocaml/bytecomp/printlambda.ml ../ocaml/bytecomp/printlambda.mli ../ocaml/bytecomp/switch.ml ../ocaml/bytecomp/switch.mli ../ocaml/bytecomp/translattribute.ml ../ocaml/bytecomp/translattribute.mli ../ocaml/bytecomp/translclass.ml ../ocaml/bytecomp/translclass.mli ../ocaml/bytecomp/translcore.ml ../ocaml/bytecomp/translcore.mli ../ocaml/bytecomp/translmod.ml ../ocaml/bytecomp/translmod.mli ../ocaml/bytecomp/translobj.ml ../ocaml/bytecomp/translobj.mli ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/ast_iterator.ml ../ocaml/parsing/ast_iterator.mli ../ocaml/parsing/ast_mapper.ml ../ocaml/parsing/ast_mapper.mli ../ocaml/parsing/asttypes.mli ../ocaml/parsing/attr_helper.ml ../ocaml/parsing/attr_helper.mli ../ocaml/parsing/builtin_attributes.ml ../ocaml/parsing/builtin_attributes.mli ../ocaml/parsing/docstrings.ml ../ocaml/parsing/docstrings.mli ../ocaml/parsing/lexer.ml ../ocaml/parsing/lexer.mli ../ocaml/parsing/location.ml ../ocaml/parsing/location.mli ../ocaml/parsing/longident.ml ../ocaml/parsing/longident.mli ../ocaml/parsing/parse.ml ../ocaml/parsing/parse.mli ../ocaml/parsing/parser.ml ../ocaml/parsing/parser.mli ../ocaml/parsing/parsetree.mli ../ocaml/parsing/syntaxerr.ml ../ocaml/parsing/syntaxerr.mli ../ocaml/typing/annot.mli ../ocaml/typing/btype.ml ../ocaml/typing/btype.mli ../ocaml/typing/cmi_format.ml ../ocaml/typing/cmi_format.mli ../ocaml/typing/cmt_format.ml ../ocaml/typing/cmt_format.mli ../ocaml/typing/ctype.ml ../ocaml/typing/ctype.mli ../ocaml/typing/datarepr.ml ../ocaml/typing/datarepr.mli ../ocaml/typing/env.ml ../ocaml/typing/env.mli ../ocaml/typing/ident.ml ../ocaml/typing/ident.mli ../ocaml/typing/includeclass.ml ../ocaml/typing/includeclass.mli ../ocaml/typing/includecore.ml ../ocaml/typing/includecore.mli ../ocaml/typing/includemod.ml ../ocaml/typing/includemod.mli ../ocaml/typing/mtype.ml ../ocaml/typing/mtype.mli ../ocaml/typing/oprint.ml ../ocaml/typing/oprint.mli ../ocaml/typing/outcometree.mli ../ocaml/typing/parmatch.ml ../ocaml/typing/parmatch.mli ../ocaml/typing/path.ml ../ocaml/typing/path.mli ../ocaml/typing/predef.ml ../ocaml/typing/predef.mli ../ocaml/typing/primitive.ml ../ocaml/typing/primitive.mli ../ocaml/typing/printtyp.ml ../ocaml/typing/printtyp.mli ../ocaml/typing/stypes.ml ../ocaml/typing/stypes.mli ../ocaml/typing/subst.ml ../ocaml/typing/subst.mli ../ocaml/typing/tast_mapper.ml ../ocaml/typing/tast_mapper.mli ../ocaml/typing/typeclass.ml ../ocaml/typing/typeclass.mli ../ocaml/typing/typecore.ml ../ocaml/typing/typecore.mli ../ocaml/typing/typedecl.ml ../ocaml/typing/typedecl.mli ../ocaml/typing/typedtree.ml ../ocaml/typing/typedtree.mli ../ocaml/typing/typedtreeIter.ml ../ocaml/typing/typedtreeIter.mli ../ocaml/typing/typemod.ml ../ocaml/typing/typemod.mli ../ocaml/typing/typeopt.ml ../ocaml/typing/typeopt.mli ../ocaml/typing/types.ml ../ocaml/typing/types.mli ../ocaml/typing/typetexp.ml ../ocaml/typing/typetexp.mli ../ocaml/typing/untypeast.ml ../ocaml/typing/untypeast.mli ../ocaml/utils/arg_helper.ml ../ocaml/utils/arg_helper.mli ../ocaml/utils/ccomp.ml ../ocaml/utils/ccomp.mli ../ocaml/utils/clflags.ml ../ocaml/utils/clflags.mli ../ocaml/utils/consistbl.ml ../ocaml/utils/consistbl.mli ../ocaml/utils/identifiable.ml ../ocaml/utils/identifiable.mli ../ocaml/utils/misc.ml ../ocaml/utils/misc.mli ../ocaml/utils/numbers.ml ../ocaml/utils/numbers.mli ../ocaml/utils/profile.ml ../ocaml/utils/profile.mli ../ocaml/utils/tbl.ml ../ocaml/utils/tbl.mli ../ocaml/utils/warnings.ml ../ocaml/utils/warnings.mli ./common/bs_loc.ml ./common/bs_loc.mli ./common/bs_version.ml ./common/bs_version.mli ./common/bs_warnings.ml ./common/bs_warnings.mli ./common/ext_log.ml ./common/ext_log.mli ./common/js_config.ml ./common/js_config.mli ./common/lam_methname.ml ./common/lam_methname.mli ./core/bs_cmi_load.ml ./core/bs_conditional_initial.ml ./core/bs_conditional_initial.mli ./core/compile_rec_module.ml ./core/config_util.ml ./core/config_util.mli ./core/config_whole_compiler.ml ./core/config_whole_compiler.mli ./core/j.ml ./core/js_analyzer.ml ./core/js_analyzer.mli ./core/js_arr.ml ./core/js_arr.mli ./core/js_ast_util.ml ./core/js_ast_util.mli ./core/js_block_runtime.ml ./core/js_block_runtime.mli ./core/js_call_info.ml ./core/js_call_info.mli ./core/js_closure.ml ./core/js_closure.mli ./core/js_cmj_format.ml ./core/js_cmj_format.mli ./core/js_cmj_load.ml ./core/js_cmj_load.mli ./core/js_cmj_load_builtin_unit.ml ./core/js_dump.ml ./core/js_dump.mli ./core/js_dump_import_export.ml ./core/js_dump_import_export.mli ./core/js_dump_lit.ml ./core/js_dump_program.ml ./core/js_dump_program.mli ./core/js_dump_property.ml ./core/js_dump_property.mli ./core/js_dump_string.ml ./core/js_dump_string.mli ./core/js_exp_make.ml ./core/js_exp_make.mli ./core/js_fold.ml ./core/js_fold_basic.ml ./core/js_fold_basic.mli ./core/js_fun_env.ml ./core/js_fun_env.mli ./core/js_long.ml ./core/js_long.mli ./core/js_map.ml ./core/js_name_of_module_id.ml ./core/js_name_of_module_id.mli ./core/js_number.ml ./core/js_number.mli ./core/js_of_lam_array.ml ./core/js_of_lam_array.mli ./core/js_of_lam_block.ml ./core/js_of_lam_block.mli ./core/js_of_lam_exception.ml ./core/js_of_lam_exception.mli ./core/js_of_lam_option.ml ./core/js_of_lam_option.mli ./core/js_of_lam_string.ml ./core/js_of_lam_string.mli ./core/js_of_lam_variant.ml ./core/js_of_lam_variant.mli ./core/js_op.ml ./core/js_op_util.ml ./core/js_op_util.mli ./core/js_output.ml ./core/js_output.mli ./core/js_packages_info.ml ./core/js_packages_info.mli ./core/js_packages_state.ml ./core/js_packages_state.mli ./core/js_pass_debug.ml ./core/js_pass_debug.mli ./core/js_pass_flatten.ml ./core/js_pass_flatten.mli ./core/js_pass_flatten_and_mark_dead.ml ./core/js_pass_flatten_and_mark_dead.mli ./core/js_pass_get_used.ml ./core/js_pass_get_used.mli ./core/js_pass_scope.ml ./core/js_pass_scope.mli ./core/js_pass_tailcall_inline.ml ./core/js_pass_tailcall_inline.mli ./core/js_raw_info.ml ./core/js_shake.ml ./core/js_shake.mli ./core/js_stmt_make.ml ./core/js_stmt_make.mli ./core/lam.ml ./core/lam.mli ./core/lam_analysis.ml ./core/lam_analysis.mli ./core/lam_arity.ml ./core/lam_arity.mli ./core/lam_arity_analysis.ml ./core/lam_arity_analysis.mli ./core/lam_beta_reduce.ml ./core/lam_beta_reduce.mli ./core/lam_beta_reduce_util.ml ./core/lam_beta_reduce_util.mli ./core/lam_bounded_vars.ml ./core/lam_bounded_vars.mli ./core/lam_closure.ml ./core/lam_closure.mli ./core/lam_coercion.ml ./core/lam_coercion.mli ./core/lam_compat.ml ./core/lam_compat.mli ./core/lam_compile.ml ./core/lam_compile.mli ./core/lam_compile_const.ml ./core/lam_compile_const.mli ./core/lam_compile_context.ml ./core/lam_compile_context.mli ./core/lam_compile_env.ml ./core/lam_compile_env.mli ./core/lam_compile_external_call.ml ./core/lam_compile_external_call.mli ./core/lam_compile_external_obj.ml ./core/lam_compile_external_obj.mli ./core/lam_compile_main.ml ./core/lam_compile_main.mli ./core/lam_compile_primitive.ml ./core/lam_compile_primitive.mli ./core/lam_compile_util.ml ./core/lam_compile_util.mli ./core/lam_constant.ml ./core/lam_constant.mli ./core/lam_constant_convert.ml ./core/lam_constant_convert.mli ./core/lam_convert.ml ./core/lam_convert.mli ./core/lam_dce.ml ./core/lam_dce.mli ./core/lam_dispatch_primitive.ml ./core/lam_dispatch_primitive.mli ./core/lam_eta_conversion.ml ./core/lam_eta_conversion.mli ./core/lam_exit_code.ml ./core/lam_exit_code.mli ./core/lam_exit_count.ml ./core/lam_exit_count.mli ./core/lam_free_variables.ml ./core/lam_free_variables.mli ./core/lam_group.ml ./core/lam_group.mli ./core/lam_hit.ml ./core/lam_hit.mli ./core/lam_id_kind.ml ./core/lam_id_kind.mli ./core/lam_iter.ml ./core/lam_iter.mli ./core/lam_module_ident.ml ./core/lam_module_ident.mli ./core/lam_pass_alpha_conversion.ml ./core/lam_pass_alpha_conversion.mli ./core/lam_pass_collect.ml ./core/lam_pass_collect.mli ./core/lam_pass_count.ml ./core/lam_pass_count.mli ./core/lam_pass_deep_flatten.ml ./core/lam_pass_deep_flatten.mli ./core/lam_pass_eliminate_ref.ml ./core/lam_pass_eliminate_ref.mli ./core/lam_pass_exits.ml ./core/lam_pass_exits.mli ./core/lam_pass_lets_dce.ml ./core/lam_pass_lets_dce.mli ./core/lam_pass_remove_alias.ml ./core/lam_pass_remove_alias.mli ./core/lam_pointer_info.ml ./core/lam_pointer_info.mli ./core/lam_primitive.ml ./core/lam_primitive.mli ./core/lam_print.ml ./core/lam_print.mli ./core/lam_scc.ml ./core/lam_scc.mli ./core/lam_stats.ml ./core/lam_stats.mli ./core/lam_stats_export.ml ./core/lam_stats_export.mli ./core/lam_subst.ml ./core/lam_subst.mli ./core/lam_tag_info.ml ./core/lam_util.ml ./core/lam_util.mli ./core/lam_var_stats.ml ./core/lam_var_stats.mli ./core/matching_polyfill.ml ./core/matching_polyfill.mli ./core/polyvar_pattern_match.ml ./core/record_attributes_check.ml ./core/res_compmisc.ml ./core/res_compmisc.mli ./core/transl_single_field_record.ml ./depends/bs_exception.ml ./depends/bs_exception.mli ./ext/bsc_args.ml ./ext/bsc_args.mli ./ext/bsc_warnings.ml ./ext/ext_array.ml ./ext/ext_array.mli ./ext/ext_buffer.ml ./ext/ext_buffer.mli ./ext/ext_bytes.ml ./ext/ext_bytes.mli ./ext/ext_char.ml ./ext/ext_char.mli ./ext/ext_digest.ml ./ext/ext_digest.mli ./ext/ext_filename.ml ./ext/ext_filename.mli ./ext/ext_fmt.ml ./ext/ext_ident.ml ./ext/ext_ident.mli ./ext/ext_int.ml ./ext/ext_int.mli ./ext/ext_io.ml ./ext/ext_io.mli ./ext/ext_js_file_kind.ml ./ext/ext_js_suffix.ml ./ext/ext_list.ml ./ext/ext_list.mli ./ext/ext_marshal.ml ./ext/ext_marshal.mli ./ext/ext_modulename.ml ./ext/ext_modulename.mli ./ext/ext_namespace.ml ./ext/ext_namespace.mli ./ext/ext_option.ml ./ext/ext_option.mli ./ext/ext_path.ml ./ext/ext_path.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli ./ext/ext_pp.ml ./ext/ext_pp.mli ./ext/ext_pp_scope.ml ./ext/ext_pp_scope.mli ./ext/ext_ref.ml ./ext/ext_ref.mli ./ext/ext_scc.ml ./ext/ext_scc.mli ./ext/ext_spec.ml ./ext/ext_spec.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_string_array.ml ./ext/ext_string_array.mli ./ext/ext_sys.ml ./ext/ext_sys.mli ./ext/ext_utf8.ml ./ext/ext_utf8.mli ./ext/ext_util.ml ./ext/ext_util.mli ./ext/hash.ml ./ext/hash.mli ./ext/hash_gen.ml ./ext/hash_ident.ml ./ext/hash_ident.mli ./ext/hash_int.ml ./ext/hash_int.mli ./ext/hash_set.ml ./ext/hash_set.mli ./ext/hash_set_gen.ml ./ext/hash_set_ident.ml ./ext/hash_set_ident.mli ./ext/hash_set_ident_mask.ml ./ext/hash_set_ident_mask.mli ./ext/hash_set_poly.ml ./ext/hash_set_poly.mli ./ext/hash_set_string.ml ./ext/hash_set_string.mli ./ext/hash_string.ml ./ext/hash_string.mli ./ext/int_vec_util.ml ./ext/int_vec_util.mli ./ext/int_vec_vec.ml ./ext/int_vec_vec.mli ./ext/js_reserved_map.ml ./ext/js_reserved_map.mli ./ext/js_runtime_modules.ml ./ext/literals.ml ./ext/map_gen.ml ./ext/map_gen.mli ./ext/map_ident.ml ./ext/map_ident.mli ./ext/map_int.ml ./ext/map_int.mli ./ext/map_string.ml ./ext/map_string.mli ./ext/ordered_hash_map_gen.ml ./ext/ordered_hash_map_local_ident.ml ./ext/ordered_hash_map_local_ident.mli ./ext/set_gen.ml ./ext/set_gen.mli ./ext/set_ident.ml ./ext/set_ident.mli ./ext/set_string.ml ./ext/set_string.mli ./ext/vec.ml ./ext/vec.mli ./ext/vec_gen.ml ./ext/vec_int.ml ./ext/vec_int.mli ./js_parser/declaration_parser.ml ./js_parser/enum_common.ml ./js_parser/enum_parser.ml ./js_parser/expression_parser.ml ./js_parser/file_key.ml ./js_parser/flow_ast.ml ./js_parser/flow_ast_utils.ml ./js_parser/flow_ast_utils.mli ./js_parser/flow_lexer.ml ./js_parser/flow_lexer.mli ./js_parser/jsx_parser.ml ./js_parser/lex_env.ml ./js_parser/lex_result.ml ./js_parser/loc.ml ./js_parser/loc.mli ./js_parser/object_parser.ml ./js_parser/parse_error.ml ./js_parser/parser_common.ml ./js_parser/parser_env.ml ./js_parser/parser_env.mli ./js_parser/parser_flow.ml ./js_parser/pattern_cover.ml ./js_parser/pattern_parser.ml ./js_parser/sedlexing.ml ./js_parser/sedlexing.mli ./js_parser/statement_parser.ml ./js_parser/token.ml ./js_parser/type_parser.ml ./js_parser/wtf8.ml ./js_parser/wtf8.mli ./main/builtin_cmi_datasets.ml ./main/builtin_cmi_datasets.mli ./main/builtin_cmj_datasets.ml ./main/builtin_cmj_datasets.mli ./main/jsoo_common.ml ./main/jsoo_common.mli ./main/jsoo_main.ml ./main/jsoo_main.mli ./napkin/reactjs_jsx_ppx_v3.ml ./napkin/reactjs_jsx_ppx_v3.mli ./outcome_printer/outcome_printer_ns.ml ./outcome_printer/outcome_printer_ns.mli ./stubs/bs_hash_stubs.ml ./super_errors/super_env.ml ./super_errors/super_location.ml ./super_errors/super_location.mli ./super_errors/super_main.ml ./super_errors/super_misc.ml ./super_errors/super_misc.mli ./super_errors/super_pparse.ml ./super_errors/super_typecore.ml ./super_errors/super_typemod.ml ./super_errors/super_typetexp.ml ./syntax/ast_attributes.ml ./syntax/ast_attributes.mli ./syntax/ast_bs_open.ml ./syntax/ast_bs_open.mli ./syntax/ast_comb.ml ./syntax/ast_comb.mli ./syntax/ast_compatible.ml ./syntax/ast_compatible.mli ./syntax/ast_config.ml ./syntax/ast_config.mli ./syntax/ast_core_type.ml ./syntax/ast_core_type.mli ./syntax/ast_core_type_class_type.ml ./syntax/ast_core_type_class_type.mli ./syntax/ast_derive.ml ./syntax/ast_derive.mli ./syntax/ast_derive_abstract.ml ./syntax/ast_derive_abstract.mli ./syntax/ast_derive_js_mapper.ml ./syntax/ast_derive_js_mapper.mli ./syntax/ast_derive_projector.ml ./syntax/ast_derive_projector.mli ./syntax/ast_derive_util.ml ./syntax/ast_derive_util.mli ./syntax/ast_exp.ml ./syntax/ast_exp.mli ./syntax/ast_exp_apply.ml ./syntax/ast_exp_apply.mli ./syntax/ast_exp_extension.ml ./syntax/ast_exp_extension.mli ./syntax/ast_exp_handle_external.ml ./syntax/ast_exp_handle_external.mli ./syntax/ast_external.ml ./syntax/ast_external.mli ./syntax/ast_external_mk.ml ./syntax/ast_external_mk.mli ./syntax/ast_external_process.ml ./syntax/ast_external_process.mli ./syntax/ast_literal.ml ./syntax/ast_literal.mli ./syntax/ast_open_cxt.ml ./syntax/ast_open_cxt.mli ./syntax/ast_pat.ml ./syntax/ast_pat.mli ./syntax/ast_payload.ml ./syntax/ast_payload.mli ./syntax/ast_polyvar.ml ./syntax/ast_polyvar.mli ./syntax/ast_reason_pp.ml ./syntax/ast_reason_pp.mli ./syntax/ast_signature.ml ./syntax/ast_signature.mli ./syntax/ast_structure.ml ./syntax/ast_structure.mli ./syntax/ast_tdcls.ml ./syntax/ast_tdcls.mli ./syntax/ast_tuple_pattern_flatten.ml ./syntax/ast_tuple_pattern_flatten.mli ./syntax/ast_typ_uncurry.ml ./syntax/ast_typ_uncurry.mli ./syntax/ast_uncurry_apply.ml ./syntax/ast_uncurry_apply.mli ./syntax/ast_uncurry_gen.ml ./syntax/ast_uncurry_gen.mli ./syntax/ast_utf8_string.ml ./syntax/ast_utf8_string.mli ./syntax/ast_utf8_string_interp.ml ./syntax/ast_utf8_string_interp.mli ./syntax/ast_util.ml ./syntax/ast_util.mli ./syntax/bs_ast_invariant.ml ./syntax/bs_ast_invariant.mli ./syntax/bs_ast_mapper.ml ./syntax/bs_ast_mapper.mli ./syntax/bs_builtin_ppx.ml ./syntax/bs_builtin_ppx.mli ./syntax/bs_flow_ast_utils.ml ./syntax/bs_flow_ast_utils.mli ./syntax/bs_syntaxerr.ml ./syntax/bs_syntaxerr.mli ./syntax/classify_function.ml ./syntax/classify_function.mli ./syntax/external_arg_spec.ml ./syntax/external_arg_spec.mli ./syntax/external_ffi_types.ml ./syntax/external_ffi_types.mli ./syntax/ppx_entry.ml ./syntax/typemod_hide.ml \ No newline at end of file diff --git a/lib/4.06.1/unstable/js_refmt_compiler.ml b/lib/4.06.1/unstable/js_refmt_compiler.ml index 2db83befb2..f03d85762a 100644 --- a/lib/4.06.1/unstable/js_refmt_compiler.ml +++ b/lib/4.06.1/unstable/js_refmt_compiler.ml @@ -408272,16 +408272,14 @@ let mapper : mapper = end -module Reactjs_jsx_ppx_v3 -= struct -#1 "reactjs_jsx_ppx_v3.ml" -# 1 "syntax/reactjs_jsx_ppx.cppo.ml" +module Reactjs_jsx_ppx_v3 : sig +#1 "reactjs_jsx_ppx_v3.mli" (* - This is the file that handles turning Reason JSX' agnostic function call into + This is the module that handles turning Reason JSX' agnostic function call into a ReasonReact-specific function call. Aka, this is a macro, using OCaml's ppx facilities; https://whitequark.org/blog/2014/04/16/a-guide-to-extension- points-in-ocaml/ - You wouldn't use this file directly; it's used by BuckleScript's + You wouldn't use this file directly; it's used by ReScript's bsconfig.json. Specifically, there's a field called `react-jsx` inside the field `reason`, which enables this ppx through some internal call in bsb *) @@ -408312,49 +408310,46 @@ module Reactjs_jsx_ppx_v3 `ReactDOMRe.createElement(ReasonReact.fragment, [|foo|])` *) +val rewrite_implementation : Parsetree.structure -> Parsetree.structure + +val rewrite_signature : Parsetree.signature -> Parsetree.signature + +end = struct +#1 "reactjs_jsx_ppx_v3.ml" open Ast_helper open Ast_mapper open Asttypes open Parsetree open Longident -let rec find_opt p = function - | [] -> None - | x :: l -> if p x then Some x else find_opt p l - - +let rec find_opt p = function [] -> None | x :: l -> if p x then Some x else find_opt p l let nolabel = Nolabel + let labelled str = Labelled str + let optional str = Optional str -let isOptional str = match str with -| Optional _ -> true -| _ -> false -let isLabelled str = match str with -| Labelled _ -> true -| _ -> false -let getLabel str = match str with -| Optional str | Labelled str -> str -| Nolabel -> "" + +let isOptional str = match str with Optional _ -> true | _ -> false + +let isLabelled str = match str with Labelled _ -> true | _ -> false + +let getLabel str = match str with Optional str | Labelled str -> str | Nolabel -> "" + let optionIdent = Lident "option" -let argIsKeyRef = function - | (Labelled ("key" | "ref"), _) | (Optional ("key" | "ref"), _) -> true - | _ -> false let constantString ~loc str = Ast_helper.Exp.constant ~loc (Pconst_string (str, None)) - let safeTypeFromValue valueStr = -let valueStr = getLabel valueStr in -match String.sub valueStr 0 1 with -| "_" -> "T" ^ valueStr -| _ -> valueStr -let keyType loc = Typ.constr ~loc {loc; txt=optionIdent} [Typ.constr ~loc {loc; txt=Lident "string"} []] - -type 'a children = | ListLiteral of 'a | Exact of 'a -type componentConfig = { - propsName: string; -} + let valueStr = getLabel valueStr in + match String.sub valueStr 0 1 with "_" -> "T" ^ valueStr | _ -> valueStr + [@@raises Invalid_argument] + +let keyType loc = Typ.constr ~loc { loc; txt = optionIdent } [ Typ.constr ~loc { loc; txt = Lident "string" } [] ] + +type 'a children = ListLiteral of 'a | Exact of 'a + +type componentConfig = { propsName : string } (* if children is a list, convert it to an array while mapping each element. If not, just map over it, as usual *) let transformChildrenIfListUpper ~loc ~mapper theList = @@ -408362,16 +408357,12 @@ let transformChildrenIfListUpper ~loc ~mapper theList = (* not in the sense of converting a list to an array; convert the AST reprensentation of a list to the AST reprensentation of an array *) match theList with - | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> begin - match accum with - | [singleElement] -> Exact singleElement - | accum -> ListLiteral (List.rev accum |> Exp.array ~loc) - end - | {pexp_desc = Pexp_construct ( - {txt = Lident "::"}, - Some {pexp_desc = Pexp_tuple (v::acc::[])} - )} -> - transformChildren_ acc ((mapper.expr mapper v)::accum) + | { pexp_desc = Pexp_construct ({ txt = Lident "[]" }, None) } -> ( + match accum with + | [ singleElement ] -> Exact singleElement + | accum -> ListLiteral (Exp.array ~loc (List.rev accum)) ) + | { pexp_desc = Pexp_construct ({ txt = Lident "::" }, Some { pexp_desc = Pexp_tuple [ v; acc ] }) } -> + transformChildren_ acc (mapper.expr mapper v :: accum) | notAList -> Exact (mapper.expr mapper notAList) in transformChildren_ theList [] @@ -408381,114 +408372,103 @@ let transformChildrenIfList ~loc ~mapper theList = (* not in the sense of converting a list to an array; convert the AST reprensentation of a list to the AST reprensentation of an array *) match theList with - | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> - List.rev accum |> Exp.array ~loc - | {pexp_desc = Pexp_construct ( - {txt = Lident "::"}, - Some {pexp_desc = Pexp_tuple (v::acc::[])} - )} -> - transformChildren_ acc ((mapper.expr mapper v)::accum) + | { pexp_desc = Pexp_construct ({ txt = Lident "[]" }, None) } -> Exp.array ~loc (List.rev accum) + | { pexp_desc = Pexp_construct ({ txt = Lident "::" }, Some { pexp_desc = Pexp_tuple [ v; acc ] }) } -> + transformChildren_ acc (mapper.expr mapper v :: accum) | notAList -> mapper.expr mapper notAList in transformChildren_ theList [] -let extractChildren ?(removeLastPositionUnit=false) ~loc propsAndChildren = - let rec allButLast_ lst acc = match lst with +let extractChildren ?(removeLastPositionUnit = false) ~loc propsAndChildren = + let rec allButLast_ lst acc = + match lst with | [] -> [] - | (Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})::[] -> acc + | [ (Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) }) ] -> acc | (Nolabel, _) :: _rest -> raise (Invalid_argument "JSX: found non-labelled argument before the last position") - | arg::rest -> allButLast_ rest (arg::acc) + | arg :: rest -> allButLast_ rest (arg :: acc) + [@@raises Invalid_argument] in - let allButLast lst = allButLast_ lst [] |> List.rev in - match (List.partition (fun (label, _) -> label = labelled "children") propsAndChildren) with - | ([], props) -> - (* no children provided? Place a placeholder list *) - (Exp.construct ~loc {loc; txt = Lident "[]"} None, if removeLastPositionUnit then allButLast props else props) - | ([(_, childrenExpr)], props) -> - (childrenExpr, if removeLastPositionUnit then allButLast props else props) + let allButLast lst = allButLast_ lst [] |> List.rev [@@raises Invalid_argument] in + match List.partition (fun (label, _) -> label = labelled "children") propsAndChildren with + | [], props -> + (* no children provided? Place a placeholder list *) + (Exp.construct ~loc { loc; txt = Lident "[]" } None, if removeLastPositionUnit then allButLast props else props) + | [ (_, childrenExpr) ], props -> (childrenExpr, if removeLastPositionUnit then allButLast props else props) | _ -> raise (Invalid_argument "JSX: somehow there's more than one `children` label") + [@@raises Invalid_argument] + +let unerasableIgnore loc = ({ loc; txt = "warning" }, PStr [ Str.eval (Exp.constant (Pconst_string ("-16", None))) ]) -let unerasableIgnore loc = ({loc; txt = "warning"}, (PStr [Str.eval (Exp.constant (Pconst_string ("-16", None)))])) -let merlinFocus = ({loc = Location.none; txt = "merlin.focus"}, (PStr [])) +let merlinFocus = ({ loc = Location.none; txt = "merlin.focus" }, PStr []) (* Helper method to look up the [@react.component] attribute *) -let hasAttr (loc, _) = - loc.txt = "react.component" +let hasAttr (loc, _) = loc.txt = "react.component" (* Helper method to filter out any attribute that isn't [@react.component] *) -let otherAttrsPure (loc, _) = - loc.txt <> "react.component" +let otherAttrsPure (loc, _) = loc.txt <> "react.component" (* Iterate over the attributes and try to find the [@react.component] attribute *) -let hasAttrOnBinding {pvb_attributes} = find_opt hasAttr pvb_attributes <> None - -(* Filter the [@react.component] attribute and immutably replace them on the binding *) -let filterAttrOnBinding binding = {binding with pvb_attributes = List.filter otherAttrsPure binding.pvb_attributes} +let hasAttrOnBinding { pvb_attributes } = find_opt hasAttr pvb_attributes <> None (* Finds the name of the variable the binding is assigned to, otherwise raises Invalid_argument *) let getFnName binding = match binding with - | {pvb_pat = { - ppat_desc = Ppat_var {txt} - }} -> txt + | { pvb_pat = { ppat_desc = Ppat_var { txt } } } -> txt | _ -> raise (Invalid_argument "react.component calls cannot be destructured.") + [@@raises Invalid_argument] let makeNewBinding binding expression newName = match binding with - | {pvb_pat = { - ppat_desc = Ppat_var ( ppat_var) - } as pvb_pat} ->{ binding with pvb_pat = { - pvb_pat with - ppat_desc = Ppat_var {ppat_var with txt = newName}; - }; - pvb_expr = expression; - pvb_attributes = [merlinFocus]; - } + | { pvb_pat = { ppat_desc = Ppat_var ppat_var } as pvb_pat } -> + { + binding with + pvb_pat = { pvb_pat with ppat_desc = Ppat_var { ppat_var with txt = newName } }; + pvb_expr = expression; + pvb_attributes = [ merlinFocus ]; + } | _ -> raise (Invalid_argument "react.component calls cannot be destructured.") + [@@raises Invalid_argument] (* Lookup the value of `props` otherwise raise Invalid_argument error *) let getPropsNameValue _acc (loc, exp) = - match (loc, exp) with - | ({ txt = Lident "props" }, { pexp_desc = Pexp_ident {txt = Lident str} }) -> { propsName = str } - | ({ txt }, _) -> raise (Invalid_argument ("react.component only accepts props as an option, given: " ^ Longident.last txt)) + match (loc, exp) with + | { txt = Lident "props" }, { pexp_desc = Pexp_ident { txt = Lident str } } -> { propsName = str } + | { txt }, _ -> + raise (Invalid_argument ("react.component only accepts props as an option, given: " ^ Longident.last txt)) + [@@raises Invalid_argument] (* Lookup the `props` record or string as part of [@react.component] and store the name for use when rewriting *) let getPropsAttr payload = - let defaultProps = {propsName = "Props"} in + let defaultProps = { propsName = "Props" } in match payload with - | Some(PStr( - {pstr_desc = Pstr_eval ({ - pexp_desc = Pexp_record (recordFields, None) - }, _)}::_rest - )) -> + | Some (PStr ({ pstr_desc = Pstr_eval ({ pexp_desc = Pexp_record (recordFields, None) }, _) } :: _rest)) -> List.fold_left getPropsNameValue defaultProps recordFields - | Some(PStr({pstr_desc = Pstr_eval ({pexp_desc = Pexp_ident {txt = Lident "props"}}, _)}::_rest)) -> {propsName = "props"} - | Some(PStr({pstr_desc = Pstr_eval (_, _)}::_rest)) -> raise (Invalid_argument ("react.component accepts a record config with props as an options.")) + | Some (PStr ({ pstr_desc = Pstr_eval ({ pexp_desc = Pexp_ident { txt = Lident "props" } }, _) } :: _rest)) -> + { propsName = "props" } + | Some (PStr ({ pstr_desc = Pstr_eval (_, _) } :: _rest)) -> + raise (Invalid_argument "react.component accepts a record config with props as an options.") | _ -> defaultProps + [@@raises Invalid_argument] (* Plucks the label, loc, and type_ from an AST node *) let pluckLabelDefaultLocType (label, default, _, _, loc, type_) = (label, default, loc, type_) (* Lookup the filename from the location information on the AST node and turn it into a valid module identifier *) -let filenameFromLoc (pstr_loc: Location.t) = - let fileName = match pstr_loc.loc_start.pos_fname with - | "" -> !Location.input_name - | fileName -> fileName - in - let fileName = try - Filename.chop_extension (Filename.basename fileName) - with | Invalid_argument _-> fileName in +let filenameFromLoc (pstr_loc : Location.t) = + let fileName = match pstr_loc.loc_start.pos_fname with "" -> !Location.input_name | fileName -> fileName in + let fileName = try Filename.chop_extension (Filename.basename fileName) with Invalid_argument _ -> fileName in let fileName = String.capitalize_ascii fileName in fileName (* Build a string representation of a module name with segments separated by $ *) let makeModuleName fileName nestedModules fnName = - let fullModuleName = match (fileName, nestedModules, fnName) with - (* TODO: is this even reachable? It seems like the fileName always exists *) - | ("", nestedModules, "make") -> nestedModules - | ("", nestedModules, fnName) -> List.rev (fnName :: nestedModules) - | (fileName, nestedModules, "make") -> fileName :: (List.rev nestedModules) - | (fileName, nestedModules, fnName) -> fileName :: (List.rev (fnName :: nestedModules)) + let fullModuleName = + match (fileName, nestedModules, fnName) with + (* TODO: is this even reachable? It seems like the fileName always exists *) + | "", nestedModules, "make" -> nestedModules + | "", nestedModules, fnName -> List.rev (fnName :: nestedModules) + | fileName, nestedModules, "make" -> fileName :: List.rev nestedModules + | fileName, nestedModules, fnName -> fileName :: List.rev (fnName :: nestedModules) in let fullModuleName = String.concat "$" fullModuleName in fullModuleName @@ -408502,202 +408482,167 @@ let makeModuleName fileName nestedModules fnName = (* Build an AST node representing all named args for the `external` definition for a component's props *) let rec recursivelyMakeNamedArgsForExternal list args = match list with - | (label, default, loc, interiorType)::tl -> - recursivelyMakeNamedArgsForExternal tl (Typ.arrow - ~loc - label - (match (label, interiorType, default) with - (* ~foo=1 *) - | (label, None, Some _) -> - { - ptyp_desc = Ptyp_var (safeTypeFromValue label); - ptyp_loc = loc; - ptyp_attributes = []; - } - (* ~foo: int=1 *) - | (_label, Some type_, Some _) -> - type_ - - (* ~foo: option(int)=? *) - | (label, Some ({ptyp_desc = Ptyp_constr ({txt=(Lident "option")}, [type_])}), _) - | (label, Some ({ptyp_desc = Ptyp_constr ({txt=(Ldot (Lident "*predef*", "option"))}, [type_])}), _) - (* ~foo: int=? - note this isnt valid. but we want to get a type error *) - | (label, Some type_, _) when isOptional label -> - type_ - (* ~foo=? *) - | (label, None, _) when isOptional label -> - { - ptyp_desc = Ptyp_var (safeTypeFromValue label); - ptyp_loc = loc; - ptyp_attributes = []; - } - - (* ~foo *) - | (label, None, _) -> - { - ptyp_desc = Ptyp_var (safeTypeFromValue label); - ptyp_loc = loc; - ptyp_attributes = []; - } - | (_label, Some type_, _) -> - type_ - ) - args) + | (label, default, loc, interiorType) :: tl -> + recursivelyMakeNamedArgsForExternal tl + (Typ.arrow ~loc label + ( match (label, interiorType, default) with + (* ~foo=1 *) + | label, None, Some _ -> + { ptyp_desc = Ptyp_var (safeTypeFromValue label); ptyp_loc = loc; ptyp_attributes = [] } + (* ~foo: int=1 *) + | _label, Some type_, Some _ -> type_ + (* ~foo: option(int)=? *) + | label, Some { ptyp_desc = Ptyp_constr ({ txt = Lident "option" }, [ type_ ]) }, _ + | label, Some { ptyp_desc = Ptyp_constr ({ txt = Ldot (Lident "*predef*", "option") }, [ type_ ]) }, _ + (* ~foo: int=? - note this isnt valid. but we want to get a type error *) + | label, Some type_, _ + when isOptional label -> + type_ + (* ~foo=? *) + | label, None, _ when isOptional label -> + { ptyp_desc = Ptyp_var (safeTypeFromValue label); ptyp_loc = loc; ptyp_attributes = [] } + (* ~foo *) + | label, None, _ -> { ptyp_desc = Ptyp_var (safeTypeFromValue label); ptyp_loc = loc; ptyp_attributes = [] } + | _label, Some type_, _ -> type_ ) + args) | [] -> args + [@@raises Invalid_argument] (* Build an AST node for the [@bs.obj] representing props for a component *) let makePropsValue fnName loc namedArgListWithKeyAndRef propsType = - let propsName = fnName ^ "Props" in { - pval_name = {txt = propsName; loc}; - pval_type = - recursivelyMakeNamedArgsForExternal - namedArgListWithKeyAndRef - (Typ.arrow - nolabel - { - ptyp_desc = Ptyp_constr ({txt= Lident("unit"); loc}, []); - ptyp_loc = loc; - ptyp_attributes = []; - } - propsType - ); - pval_prim = [""]; - pval_attributes = [({txt = "bs.obj"; loc = loc}, PStr [])]; - pval_loc = loc; -} + let propsName = fnName ^ "Props" in + { + pval_name = { txt = propsName; loc }; + pval_type = + recursivelyMakeNamedArgsForExternal namedArgListWithKeyAndRef + (Typ.arrow nolabel + { ptyp_desc = Ptyp_constr ({ txt = Lident "unit"; loc }, []); ptyp_loc = loc; ptyp_attributes = [] } + propsType); + pval_prim = [ "" ]; + pval_attributes = [ ({ txt = "bs.obj"; loc }, PStr []) ]; + pval_loc = loc; + } + [@@raises Invalid_argument] (* Build an AST node representing an `external` with the definition of the [@bs.obj] *) let makePropsExternal fnName loc namedArgListWithKeyAndRef propsType = - { - pstr_loc = loc; - pstr_desc = Pstr_primitive (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) - } + { pstr_loc = loc; pstr_desc = Pstr_primitive (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) } + [@@raises Invalid_argument] (* Build an AST node for the signature of the `external` definition *) let makePropsExternalSig fnName loc namedArgListWithKeyAndRef propsType = - { - psig_loc = loc; - psig_desc = Psig_value (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) - } + { psig_loc = loc; psig_desc = Psig_value (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) } + [@@raises Invalid_argument] (* Build an AST node for the props name when converted to a Js.t inside the function signature *) -let makePropsName ~loc name = - { - ppat_desc = Ppat_var {txt = name; loc}; - ppat_loc = loc; - ppat_attributes = []; - } - - -let makeObjectField loc (str, attrs, type_) = - Otag ({ loc; txt = str }, attrs, type_) +let makePropsName ~loc name = { ppat_desc = Ppat_var { txt = name; loc }; ppat_loc = loc; ppat_attributes = [] } +let makeObjectField loc (str, attrs, type_) = Otag ({ loc; txt = str }, attrs, type_) (* Build an AST node representing a "closed" Js.t object representing a component's props *) let makePropsType ~loc namedTypeList = - Typ.mk ~loc ( - Ptyp_constr({txt= Ldot (Lident("Js"), "t"); loc}, [{ - ptyp_desc = Ptyp_object( - List.map (makeObjectField loc) namedTypeList, - Closed - ); - ptyp_loc = loc; - ptyp_attributes = []; - }]) - ) + Typ.mk ~loc + (Ptyp_constr + ( { txt = Ldot (Lident "Js", "t"); loc }, + [ + { + ptyp_desc = Ptyp_object (List.map (makeObjectField loc) namedTypeList, Closed); + ptyp_loc = loc; + ptyp_attributes = []; + }; + ] )) (* Builds an AST node for the entire `external` definition of props *) let makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList = - makePropsExternal - fnName - loc + makePropsExternal fnName loc (List.map pluckLabelDefaultLocType namedArgListWithKeyAndRef) (makePropsType ~loc namedTypeList) + [@@raises Invalid_argument] (* TODO: some line number might still be wrong *) let jsxMapper () = - let jsxVersion = ref None in let transformUppercaseCall3 modulePath mapper loc attrs _ callArguments = - let (children, argsWithLabels) = extractChildren ~loc ~removeLastPositionUnit:true callArguments in + let children, argsWithLabels = extractChildren ~loc ~removeLastPositionUnit:true callArguments in let argsForMake = argsWithLabels in let childrenExpr = transformChildrenIfListUpper ~loc ~mapper children in - let recursivelyTransformedArgsForMake = argsForMake |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) in + let recursivelyTransformedArgsForMake = + argsForMake |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) + in let childrenArg = ref None in - let args = recursivelyTransformedArgsForMake - @ (match childrenExpr with - | Exact children -> [(labelled "children", children)] - | ListLiteral ({ pexp_desc = Pexp_array list }) when list = [] -> [] + let args = + recursivelyTransformedArgsForMake + @ ( match childrenExpr with + | Exact children -> [ (labelled "children", children) ] + | ListLiteral { pexp_desc = Pexp_array list } when list = [] -> [] | ListLiteral expression -> - (* this is a hack to support react components that introspect into their children *) - (childrenArg := Some expression; - [(labelled "children", Exp.ident ~loc {loc; txt = Ldot (Lident "React", "null")})])) - @ [(nolabel, Exp.construct ~loc {loc; txt = Lident "()"} None)] in - let isCap str = let first = String.sub str 0 1 in - let capped = String.uppercase_ascii first in first = capped in - let ident = match modulePath with - | Lident _ -> Ldot (modulePath, "make") - | (Ldot (_modulePath, value) as fullPath) when isCap value -> Ldot (fullPath, "make") - | modulePath -> modulePath in - let propsIdent = match ident with - | Lident path -> Lident (path ^ "Props") - | Ldot(ident, path) -> Ldot (ident, path ^ "Props") - | _ -> raise (Invalid_argument "JSX name can't be the result of function applications") in - let props = - Exp.apply ~attrs ~loc (Exp.ident ~loc {loc; txt = propsIdent}) args in + (* this is a hack to support react components that introspect into their children *) + childrenArg := Some expression; + [ (labelled "children", Exp.ident ~loc { loc; txt = Ldot (Lident "React", "null") }) ] ) + @ [ (nolabel, Exp.construct ~loc { loc; txt = Lident "()" } None) ] + in + let isCap str = + let first = String.sub str 0 1 [@@raises Invalid_argument] in + let capped = String.uppercase_ascii first in + first = capped + [@@raises Invalid_argument] + in + let ident = + match modulePath with + | Lident _ -> Ldot (modulePath, "make") + | Ldot (_modulePath, value) as fullPath when isCap value -> Ldot (fullPath, "make") + | modulePath -> modulePath + in + let propsIdent = + match ident with + | Lident path -> Lident (path ^ "Props") + | Ldot (ident, path) -> Ldot (ident, path ^ "Props") + | _ -> raise (Invalid_argument "JSX name can't be the result of function applications") + in + let props = Exp.apply ~attrs ~loc (Exp.ident ~loc { loc; txt = propsIdent }) args in (* handle key, ref, children *) - (* React.createElement(Component.make, props, ...children) *) - match (!childrenArg) with + (* React.createElement(Component.make, props, ...children) *) + match !childrenArg with | None -> - (Exp.apply - ~loc - ~attrs - (Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElement")}) - ([ - (nolabel, Exp.ident ~loc {txt = ident; loc}); - (nolabel, props) - ])) - | Some children -> - (Exp.apply - ~loc - ~attrs - (Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElementVariadic")}) - ([ - (nolabel, Exp.ident ~loc {txt = ident; loc}); - (nolabel, props); - (nolabel, children) - ])) - in + Exp.apply ~loc ~attrs + (Exp.ident ~loc { loc; txt = Ldot (Lident "React", "createElement") }) + [ (nolabel, Exp.ident ~loc { txt = ident; loc }); (nolabel, props) ] + | Some children -> + Exp.apply ~loc ~attrs + (Exp.ident ~loc { loc; txt = Ldot (Lident "React", "createElementVariadic") }) + [ (nolabel, Exp.ident ~loc { txt = ident; loc }); (nolabel, props); (nolabel, children) ] + [@@raises Invalid_argument] + in - let transformLowercaseCall3 mapper loc attrs callArguments id = - let (children, nonChildrenProps) = extractChildren ~loc callArguments in - let componentNameExpr = constantString ~loc id in - let childrenExpr = transformChildrenIfList ~loc ~mapper children in - let createElementCall = match children with - (* [@JSX] div(~children=[a]), coming from
a
*) - | { - pexp_desc = - Pexp_construct ({txt = Lident "::"}, Some {pexp_desc = Pexp_tuple _ }) - | Pexp_construct ({txt = Lident "[]"}, None) - } -> "createDOMElementVariadic" - (* [@JSX] div(~children= value), coming from
...(value)
*) - | _ -> raise (Invalid_argument "A spread as a DOM element's \ - children don't make sense written together. You can simply remove the spread.") - in - let args = match nonChildrenProps with - | [_justTheUnitArgumentAtEnd] -> - [ - (* "div" *) - (nolabel, componentNameExpr); - (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] - | nonEmptyProps -> + let transformLowercaseCall3 mapper loc attrs callArguments id = + let children, nonChildrenProps = extractChildren ~loc callArguments in + let componentNameExpr = constantString ~loc id in + let childrenExpr = transformChildrenIfList ~loc ~mapper children in + let createElementCall = + match children with + (* [@JSX] div(~children=[a]), coming from
a
*) + | { + pexp_desc = + ( Pexp_construct ({ txt = Lident "::" }, Some { pexp_desc = Pexp_tuple _ }) + | Pexp_construct ({ txt = Lident "[]" }, None) ); + } -> + "createDOMElementVariadic" + (* [@JSX] div(~children= value), coming from
...(value)
*) + | _ -> + raise + (Invalid_argument + "A spread as a DOM element's children don't make sense written together. You can simply remove the \ + spread.") + in + let args = + match nonChildrenProps with + | [ _justTheUnitArgumentAtEnd ] -> + [ (* "div" *) (nolabel, componentNameExpr); (* [|moreCreateElementCallsHere|] *) (nolabel, childrenExpr) ] + | nonEmptyProps -> let propsCall = - Exp.apply - ~loc - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "domProps")}) + Exp.apply ~loc + (Exp.ident ~loc { loc; txt = Ldot (Lident "ReactDOMRe", "domProps") }) (nonEmptyProps |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression))) in [ @@ -408706,547 +408651,551 @@ let jsxMapper () = (* ReactDOMRe.props(~className=blabla, ~foo=bar, ()) *) (labelled "props", propsCall); (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] in - Exp.apply - ~loc - (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs - (* ReactDOMRe.createElement *) - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", createElementCall)}) - args + (nolabel, childrenExpr); + ] in - - - + Exp.apply ~loc (* throw away the [@JSX] attribute and keep the others, if any *) ~attrs + (* ReactDOMRe.createElement *) + (Exp.ident ~loc { loc; txt = Ldot (Lident "ReactDOMRe", createElementCall) }) + args + [@@raises Invalid_argument] + in let rec recursivelyTransformNamedArgsForMake mapper expr list = let expr = mapper.expr mapper expr in match expr.pexp_desc with (* TODO: make this show up with a loc. *) - | Pexp_fun (Labelled "key", _, _, _) - | Pexp_fun (Optional "key", _, _, _) -> raise (Invalid_argument "Key cannot be accessed inside of a component. Don't worry - you can always key a component from its parent!") - | Pexp_fun (Labelled "ref", _, _, _) - | Pexp_fun (Optional "ref", _, _, _) -> raise (Invalid_argument "Ref cannot be passed as a normal prop. Please use `forwardRef` API instead.") + | Pexp_fun (Labelled "key", _, _, _) | Pexp_fun (Optional "key", _, _, _) -> + raise + (Invalid_argument + "Key cannot be accessed inside of a component. Don't worry - you can always key a component from its \ + parent!") + | Pexp_fun (Labelled "ref", _, _, _) | Pexp_fun (Optional "ref", _, _, _) -> + raise (Invalid_argument "Ref cannot be passed as a normal prop. Please use `forwardRef` API instead.") | Pexp_fun (arg, default, pattern, expression) when isOptional arg || isLabelled arg -> - let () = - (match (isOptional arg, pattern, default) with - | (true, { ppat_desc = Ppat_constraint (_, { ptyp_desc })}, None) -> - (match ptyp_desc with - | Ptyp_constr({txt=(Lident "option")}, [_]) -> () - | _ -> - let currentType = (match ptyp_desc with - | Ptyp_constr({txt}, []) -> String.concat "." (Longident.flatten txt) - | Ptyp_constr({txt}, _innerTypeArgs) -> String.concat "." (Longident.flatten txt) ^ "(...)" - | _ -> "...") - in - Location.prerr_warning pattern.ppat_loc - (Preprocessor - (Printf.sprintf "ReasonReact: optional argument annotations must have explicit `option`. Did you mean `option(%s)=?`?" currentType))) - | _ -> ()) in - let alias = (match pattern with - | {ppat_desc = Ppat_alias (_, {txt}) | Ppat_var {txt}} -> txt - | {ppat_desc = Ppat_any} -> "_" - | _ -> getLabel arg) in - let type_ = (match pattern with - | {ppat_desc = Ppat_constraint (_, type_)} -> Some type_ - | _ -> None) in - - recursivelyTransformNamedArgsForMake mapper expression ((arg, default, pattern, alias, pattern.ppat_loc, type_) :: list) - | Pexp_fun (Nolabel, _, { ppat_desc = (Ppat_construct ({txt = Lident "()"}, _) | Ppat_any)}, _expression) -> + let () = + match (isOptional arg, pattern, default) with + | true, { ppat_desc = Ppat_constraint (_, { ptyp_desc }) }, None -> ( + match ptyp_desc with + | Ptyp_constr ({ txt = Lident "option" }, [ _ ]) -> () + | _ -> + let currentType = + match ptyp_desc with + | Ptyp_constr ({ txt }, []) -> String.concat "." (Longident.flatten txt) + | Ptyp_constr ({ txt }, _innerTypeArgs) -> String.concat "." (Longident.flatten txt) ^ "(...)" + | _ -> "..." + in + Location.prerr_warning pattern.ppat_loc + (Preprocessor + (Printf.sprintf + "ReasonReact: optional argument annotations must have explicit `option`. Did you mean \ + `option(%s)=?`?" + currentType)) ) + | _ -> () + in + let alias = + match pattern with + | { ppat_desc = Ppat_alias (_, { txt }) | Ppat_var { txt } } -> txt + | { ppat_desc = Ppat_any } -> "_" + | _ -> getLabel arg + in + let type_ = match pattern with { ppat_desc = Ppat_constraint (_, type_) } -> Some type_ | _ -> None in + + recursivelyTransformNamedArgsForMake mapper expression + ((arg, default, pattern, alias, pattern.ppat_loc, type_) :: list) + | Pexp_fun (Nolabel, _, { ppat_desc = Ppat_construct ({ txt = Lident "()" }, _) | Ppat_any }, _expression) -> (list, None) - | Pexp_fun (Nolabel, _, { ppat_desc = Ppat_var ({txt}) | Ppat_constraint ({ ppat_desc = Ppat_var ({txt})}, _)}, _expression) -> + | Pexp_fun + ( Nolabel, + _, + { ppat_desc = Ppat_var { txt } | Ppat_constraint ({ ppat_desc = Ppat_var { txt } }, _) }, + _expression ) -> (list, Some txt) | Pexp_fun (Nolabel, _, pattern, _expression) -> - Location.raise_errorf ~loc:pattern.ppat_loc "ReasonReact: react.component refs only support plain arguments and type annotations." + Location.raise_errorf ~loc:pattern.ppat_loc + "ReasonReact: react.component refs only support plain arguments and type annotations." | _ -> (list, None) + [@@raises Invalid_argument] in - - let argToType types (name, default, _noLabelName, _alias, loc, type_) = match (type_, name, default) with - | (Some ({ptyp_desc = Ptyp_constr ({txt=(Lident "option")}, [type_])}), name, _) when isOptional name -> - (getLabel name, [], { - type_ with - ptyp_desc = Ptyp_constr ({loc=type_.ptyp_loc; txt=optionIdent}, [type_]); - }) :: types - | (Some type_, name, Some _default) -> - (getLabel name, [], { - ptyp_desc = Ptyp_constr ({loc; txt=optionIdent}, [type_]); - ptyp_loc = loc; - ptyp_attributes = []; - }) :: types - | (Some type_, name, _) -> - (getLabel name, [], type_) :: types - | (None, name, _) when isOptional name -> - (getLabel name, [], { - ptyp_desc = Ptyp_constr ({loc; txt=optionIdent}, [{ - ptyp_desc = Ptyp_var (safeTypeFromValue name); - ptyp_loc = loc; - ptyp_attributes = []; - }]); - ptyp_loc = loc; - ptyp_attributes = []; - }) :: types - | (None, name, _) when isLabelled name -> - (getLabel name, [], { - ptyp_desc = Ptyp_var (safeTypeFromValue name); - ptyp_loc = loc; - ptyp_attributes = []; - }) :: types + let argToType types (name, default, _noLabelName, _alias, loc, type_) = + match (type_, name, default) with + | Some { ptyp_desc = Ptyp_constr ({ txt = Lident "option" }, [ type_ ]) }, name, _ when isOptional name -> + ( getLabel name, + [], + { type_ with ptyp_desc = Ptyp_constr ({ loc = type_.ptyp_loc; txt = optionIdent }, [ type_ ]) } ) + :: types + | Some type_, name, Some _default -> + ( getLabel name, + [], + { ptyp_desc = Ptyp_constr ({ loc; txt = optionIdent }, [ type_ ]); ptyp_loc = loc; ptyp_attributes = [] } ) + :: types + | Some type_, name, _ -> (getLabel name, [], type_) :: types + | None, name, _ when isOptional name -> + ( getLabel name, + [], + { + ptyp_desc = + Ptyp_constr + ( { loc; txt = optionIdent }, + [ { ptyp_desc = Ptyp_var (safeTypeFromValue name); ptyp_loc = loc; ptyp_attributes = [] } ] ); + ptyp_loc = loc; + ptyp_attributes = []; + } ) + :: types + | None, name, _ when isLabelled name -> + (getLabel name, [], { ptyp_desc = Ptyp_var (safeTypeFromValue name); ptyp_loc = loc; ptyp_attributes = [] }) + :: types | _ -> types + [@@raises Invalid_argument] in - let argToConcreteType types (name, loc, type_) = match name with - | name when isLabelled name -> - (getLabel name, [], type_) :: types - | name when isOptional name -> - (getLabel name, [], Typ.constr ~loc {loc; txt=optionIdent} [type_]) :: types + let argToConcreteType types (name, loc, type_) = + match name with + | name when isLabelled name -> (getLabel name, [], type_) :: types + | name when isOptional name -> (getLabel name, [], Typ.constr ~loc { loc; txt = optionIdent } [ type_ ]) :: types | _ -> types in - let nestedModules = ref([]) in - let transformComponentDefinition mapper structure returnStructures = match structure with - (* external *) - | ({ - pstr_loc; - pstr_desc = Pstr_primitive ({ - pval_name = { txt = fnName }; - pval_attributes; - pval_type; - } as value_description) - } as pstr) -> - (match List.filter hasAttr pval_attributes with - | [] -> structure :: returnStructures - | [_] -> - let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = - (match ptyp_desc with - | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) when isLabelled name || isOptional name -> - getPropTypes ((name, ptyp_loc, type_)::types) rest - | Ptyp_arrow (Nolabel, _type, rest) -> - getPropTypes types rest - | Ptyp_arrow (name, type_, returnValue) when isLabelled name || isOptional name -> - (returnValue, (name, returnValue.ptyp_loc, type_)::types) - | _ -> (fullType, types)) - in - let (innerType, propTypes) = getPropTypes [] pval_type in - let namedTypeList = List.fold_left argToConcreteType [] propTypes in - let pluckLabelAndLoc (label, loc, type_) = (label, None (* default *), loc, Some type_) in - let retPropsType = makePropsType ~loc:pstr_loc namedTypeList in - let externalPropsDecl = makePropsExternal fnName pstr_loc (( - optional "key", - None, - pstr_loc, - Some(keyType pstr_loc) - ) :: List.map pluckLabelAndLoc propTypes) retPropsType in - (* can't be an arrow because it will defensively uncurry *) - let newExternalType = Ptyp_constr ( - {loc = pstr_loc; txt = Ldot ((Lident "React"), "componentLike")}, - [retPropsType; innerType] - ) in - let newStructure = { - pstr with pstr_desc = Pstr_primitive { - value_description with pval_type = { - pval_type with ptyp_desc = newExternalType; - }; - pval_attributes = List.filter otherAttrsPure pval_attributes; - } - } in - externalPropsDecl :: newStructure :: returnStructures - | _ -> raise (Invalid_argument "Only one react.component call can exist on a component at one time")) - (* let component = ... *) - | { - pstr_loc; - pstr_desc = Pstr_value ( - recFlag, - valueBindings - ) - } -> - let fileName = filenameFromLoc pstr_loc in - let emptyLoc = Location.in_file fileName in - let mapBinding binding = if (hasAttrOnBinding binding) then - let bindingLoc = binding.pvb_loc in - let bindingPatLoc = binding.pvb_pat.ppat_loc in - let binding = { binding with pvb_pat = { binding.pvb_pat with ppat_loc = emptyLoc}; pvb_loc = emptyLoc} in - let fnName = getFnName binding in - let internalFnName = fnName ^ "$Internal" in - let fullModuleName = makeModuleName fileName !nestedModules fnName in - let modifiedBindingOld binding = - let expression = binding.pvb_expr in - (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) - let rec spelunkForFunExpression expression = (match expression with - (* let make = (~prop) => ... *) - | { - pexp_desc = Pexp_fun _ - } -> expression - (* let make = {let foo = bar in (~prop) => ...} *) - | { - pexp_desc = Pexp_let (_recursive, _vbs, returnExpression) - } -> - (* here's where we spelunk! *) - spelunkForFunExpression returnExpression - (* let make = React.forwardRef((~prop) => ...) *) - - | { pexp_desc = Pexp_apply (_wrapperExpression, [(Nolabel, innerFunctionExpression)]) } -> - spelunkForFunExpression innerFunctionExpression - | { - pexp_desc = Pexp_sequence (_wrapperExpression, innerFunctionExpression) - } -> - spelunkForFunExpression innerFunctionExpression - | _ -> raise (Invalid_argument "react.component calls can only be on function definitions or component wrappers (forwardRef, memo).") - ) in - spelunkForFunExpression expression - in - let modifiedBinding binding = - let hasApplication = ref(false) in - let wrapExpressionWithBinding expressionFn expression = - Vb.mk - ~loc:bindingLoc - ~attrs:(List.filter otherAttrsPure binding.pvb_attributes) - (Pat.var ~loc:bindingPatLoc {loc = bindingPatLoc; txt = fnName}) (expressionFn expression) in - let expression = binding.pvb_expr in - let unerasableIgnoreExp exp = { exp with pexp_attributes = (unerasableIgnore emptyLoc) :: exp.pexp_attributes } in - (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) - let rec spelunkForFunExpression expression = (match expression with - (* let make = (~prop) => ... with no final unit *) - | { - pexp_desc = Pexp_fun ((Labelled(_) | Optional(_) as label), default, pattern, ({pexp_desc = Pexp_fun _} as internalExpression)) - } -> - let (wrap, hasUnit, exp) = spelunkForFunExpression internalExpression in - (wrap, hasUnit, unerasableIgnoreExp {expression with pexp_desc = Pexp_fun (label, default, pattern, exp)}) - (* let make = (()) => ... *) - (* let make = (_) => ... *) - | { - pexp_desc = Pexp_fun (Nolabel, _default, { ppat_desc = Ppat_construct ({txt = Lident "()"}, _) | Ppat_any}, _internalExpression) - } -> ((fun a -> a), true, expression) - (* let make = (~prop) => ... *) - | { - pexp_desc = Pexp_fun ((Labelled(_) | Optional(_)), _default, _pattern, _internalExpression) - } -> ((fun a -> a), false, unerasableIgnoreExp expression) - (* let make = (prop) => ... *) - | { - pexp_desc = Pexp_fun (_nolabel, _default, pattern, _internalExpression) - } -> - if (hasApplication.contents) then - ((fun a -> a), false, unerasableIgnoreExp expression) - else - Location.raise_errorf ~loc:pattern.ppat_loc "ReasonReact: props need to be labelled arguments.\n If you are working with refs be sure to wrap with React.forwardRef.\n If your component doesn't have any props use () or _ instead of a name." - (* let make = {let foo = bar in (~prop) => ...} *) - | { - pexp_desc = Pexp_let (recursive, vbs, internalExpression) - } -> - (* here's where we spelunk! *) - let (wrap, hasUnit, exp) = spelunkForFunExpression internalExpression in - (wrap, hasUnit, {expression with pexp_desc = Pexp_let (recursive, vbs, exp)}) - (* let make = React.forwardRef((~prop) => ...) *) - | { pexp_desc = Pexp_apply (wrapperExpression, [(Nolabel, internalExpression)]) } -> - let () = hasApplication := true in - let (_, hasUnit, exp) = spelunkForFunExpression internalExpression in - ((fun exp -> Exp.apply wrapperExpression [(nolabel, exp)]), hasUnit, exp) - | { - pexp_desc = Pexp_sequence (wrapperExpression, internalExpression) - } -> - let (wrap, hasUnit, exp) = spelunkForFunExpression internalExpression in - (wrap, hasUnit, {expression with pexp_desc = Pexp_sequence (wrapperExpression, exp)}) - | e -> ((fun a -> a), false, e) - ) in - let (wrapExpression, hasUnit, expression) = spelunkForFunExpression expression in - (wrapExpressionWithBinding wrapExpression, hasUnit, expression) - in - let (bindingWrapper, hasUnit, expression) = modifiedBinding binding in - let reactComponentAttribute = try - Some(List.find hasAttr binding.pvb_attributes) - with | Not_found -> None in - let (_attr_loc, payload) = match reactComponentAttribute with - | Some (loc, payload) -> (loc.loc, Some payload) - | None -> (emptyLoc, None) in - let props = getPropsAttr payload in - (* do stuff here! *) - let (namedArgList, forwardRef) = recursivelyTransformNamedArgsForMake mapper (modifiedBindingOld binding) [] in - let namedArgListWithKeyAndRef = (optional("key"), None, Pat.var {txt = "key"; loc = emptyLoc}, "key", emptyLoc, Some(keyType emptyLoc)) :: namedArgList in - let namedArgListWithKeyAndRef = match forwardRef with - | Some(_) -> (optional("ref"), None, Pat.var {txt = "key"; loc = emptyLoc}, "ref", emptyLoc, None) :: namedArgListWithKeyAndRef - | None -> namedArgListWithKeyAndRef - in - let namedArgListWithKeyAndRefForNew = match forwardRef with - | Some(txt) -> namedArgList @ [(nolabel, None, Pat.var {txt; loc = emptyLoc}, txt, emptyLoc, None)] - | None -> namedArgList + let nestedModules = ref [] in + let transformComponentDefinition mapper structure returnStructures = + match structure with + (* external *) + | { + pstr_loc; + pstr_desc = Pstr_primitive ({ pval_name = { txt = fnName }; pval_attributes; pval_type } as value_description); + } as pstr -> ( + match List.filter hasAttr pval_attributes with + | [] -> structure :: returnStructures + | [ _ ] -> + let rec getPropTypes types ({ ptyp_loc; ptyp_desc } as fullType) = + match ptyp_desc with + | Ptyp_arrow (name, type_, ({ ptyp_desc = Ptyp_arrow _ } as rest)) when isLabelled name || isOptional name + -> + getPropTypes ((name, ptyp_loc, type_) :: types) rest + | Ptyp_arrow (Nolabel, _type, rest) -> getPropTypes types rest + | Ptyp_arrow (name, type_, returnValue) when isLabelled name || isOptional name -> + (returnValue, (name, returnValue.ptyp_loc, type_) :: types) + | _ -> (fullType, types) + in + let innerType, propTypes = getPropTypes [] pval_type in + let namedTypeList = List.fold_left argToConcreteType [] propTypes in + let pluckLabelAndLoc (label, loc, type_) = (label, None (* default *), loc, Some type_) in + let retPropsType = makePropsType ~loc:pstr_loc namedTypeList in + let externalPropsDecl = + makePropsExternal fnName pstr_loc + ((optional "key", None, pstr_loc, Some (keyType pstr_loc)) :: List.map pluckLabelAndLoc propTypes) + retPropsType + in + (* can't be an arrow because it will defensively uncurry *) + let newExternalType = + Ptyp_constr ({ loc = pstr_loc; txt = Ldot (Lident "React", "componentLike") }, [ retPropsType; innerType ]) + in + let newStructure = + { + pstr with + pstr_desc = + Pstr_primitive + { + value_description with + pval_type = { pval_type with ptyp_desc = newExternalType }; + pval_attributes = List.filter otherAttrsPure pval_attributes; + }; + } + in + externalPropsDecl :: newStructure :: returnStructures + | _ -> raise (Invalid_argument "Only one react.component call can exist on a component at one time") ) + (* let component = ... *) + | { pstr_loc; pstr_desc = Pstr_value (recFlag, valueBindings) } -> + let fileName = filenameFromLoc pstr_loc in + let emptyLoc = Location.in_file fileName in + let mapBinding binding = + if hasAttrOnBinding binding then + let bindingLoc = binding.pvb_loc in + let bindingPatLoc = binding.pvb_pat.ppat_loc in + let binding = { binding with pvb_pat = { binding.pvb_pat with ppat_loc = emptyLoc }; pvb_loc = emptyLoc } in + let fnName = getFnName binding in + let internalFnName = fnName ^ "$Internal" in + let fullModuleName = makeModuleName fileName !nestedModules fnName in + let modifiedBindingOld binding = + let expression = binding.pvb_expr in + (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) + let rec spelunkForFunExpression expression = + match expression with + (* let make = (~prop) => ... *) + | { pexp_desc = Pexp_fun _ } -> expression + (* let make = {let foo = bar in (~prop) => ...} *) + | { pexp_desc = Pexp_let (_recursive, _vbs, returnExpression) } -> + (* here's where we spelunk! *) + spelunkForFunExpression returnExpression + (* let make = React.forwardRef((~prop) => ...) *) + | { pexp_desc = Pexp_apply (_wrapperExpression, [ (Nolabel, innerFunctionExpression) ]) } -> + spelunkForFunExpression innerFunctionExpression + | { pexp_desc = Pexp_sequence (_wrapperExpression, innerFunctionExpression) } -> + spelunkForFunExpression innerFunctionExpression + | _ -> + raise + (Invalid_argument + "react.component calls can only be on function definitions or component wrappers (forwardRef, \ + memo).") + [@@raises Invalid_argument] + in + spelunkForFunExpression expression + in + let modifiedBinding binding = + let hasApplication = ref false in + let wrapExpressionWithBinding expressionFn expression = + Vb.mk ~loc:bindingLoc + ~attrs:(List.filter otherAttrsPure binding.pvb_attributes) + (Pat.var ~loc:bindingPatLoc { loc = bindingPatLoc; txt = fnName }) + (expressionFn expression) + in + let expression = binding.pvb_expr in + let unerasableIgnoreExp exp = + { exp with pexp_attributes = unerasableIgnore emptyLoc :: exp.pexp_attributes } + in + (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) + let rec spelunkForFunExpression expression = + match expression with + (* let make = (~prop) => ... with no final unit *) + | { + pexp_desc = + Pexp_fun + ( ((Labelled _ | Optional _) as label), + default, + pattern, + ({ pexp_desc = Pexp_fun _ } as internalExpression) ); + } -> + let wrap, hasUnit, exp = spelunkForFunExpression internalExpression in + ( wrap, + hasUnit, + unerasableIgnoreExp { expression with pexp_desc = Pexp_fun (label, default, pattern, exp) } ) + (* let make = (()) => ... *) + (* let make = (_) => ... *) + | { + pexp_desc = + Pexp_fun + ( Nolabel, + _default, + { ppat_desc = Ppat_construct ({ txt = Lident "()" }, _) | Ppat_any }, + _internalExpression ); + } -> + ((fun a -> a), true, expression) + (* let make = (~prop) => ... *) + | { pexp_desc = Pexp_fun ((Labelled _ | Optional _), _default, _pattern, _internalExpression) } -> + ((fun a -> a), false, unerasableIgnoreExp expression) + (* let make = (prop) => ... *) + | { pexp_desc = Pexp_fun (_nolabel, _default, pattern, _internalExpression) } -> + if hasApplication.contents then ((fun a -> a), false, unerasableIgnoreExp expression) + else + Location.raise_errorf ~loc:pattern.ppat_loc + "ReasonReact: props need to be labelled arguments.\n\ + \ If you are working with refs be sure to wrap with React.forwardRef.\n\ + \ If your component doesn't have any props use () or _ instead of a name." + (* let make = {let foo = bar in (~prop) => ...} *) + | { pexp_desc = Pexp_let (recursive, vbs, internalExpression) } -> + (* here's where we spelunk! *) + let wrap, hasUnit, exp = spelunkForFunExpression internalExpression in + (wrap, hasUnit, { expression with pexp_desc = Pexp_let (recursive, vbs, exp) }) + (* let make = React.forwardRef((~prop) => ...) *) + | { pexp_desc = Pexp_apply (wrapperExpression, [ (Nolabel, internalExpression) ]) } -> + let () = hasApplication := true in + let _, hasUnit, exp = spelunkForFunExpression internalExpression in + ((fun exp -> Exp.apply wrapperExpression [ (nolabel, exp) ]), hasUnit, exp) + | { pexp_desc = Pexp_sequence (wrapperExpression, internalExpression) } -> + let wrap, hasUnit, exp = spelunkForFunExpression internalExpression in + (wrap, hasUnit, { expression with pexp_desc = Pexp_sequence (wrapperExpression, exp) }) + | e -> ((fun a -> a), false, e) + in + let wrapExpression, hasUnit, expression = spelunkForFunExpression expression in + (wrapExpressionWithBinding wrapExpression, hasUnit, expression) + in + let bindingWrapper, hasUnit, expression = modifiedBinding binding in + let reactComponentAttribute = + try Some (List.find hasAttr binding.pvb_attributes) with Not_found -> None + in + let _attr_loc, payload = + match reactComponentAttribute with + | Some (loc, payload) -> (loc.loc, Some payload) + | None -> (emptyLoc, None) + in + let props = getPropsAttr payload in + (* do stuff here! *) + let namedArgList, forwardRef = + recursivelyTransformNamedArgsForMake mapper (modifiedBindingOld binding) [] + in + let namedArgListWithKeyAndRef = + (optional "key", None, Pat.var { txt = "key"; loc = emptyLoc }, "key", emptyLoc, Some (keyType emptyLoc)) + :: namedArgList + in + let namedArgListWithKeyAndRef = + match forwardRef with + | Some _ -> + (optional "ref", None, Pat.var { txt = "key"; loc = emptyLoc }, "ref", emptyLoc, None) + :: namedArgListWithKeyAndRef + | None -> namedArgListWithKeyAndRef + in + let namedArgListWithKeyAndRefForNew = + match forwardRef with + | Some txt -> namedArgList @ [ (nolabel, None, Pat.var { txt; loc = emptyLoc }, txt, emptyLoc, None) ] + | None -> namedArgList + in + let pluckArg (label, _, _, alias, loc, _) = + let labelString = + match label with label when isOptional label || isLabelled label -> getLabel label | _ -> "" + in + ( label, + match labelString with + | "" -> Exp.ident ~loc { txt = Lident alias; loc } + | labelString -> + Exp.apply ~loc + (Exp.ident ~loc { txt = Lident "##"; loc }) + [ + (nolabel, Exp.ident ~loc { txt = Lident props.propsName; loc }); + (nolabel, Exp.ident ~loc { txt = Lident labelString; loc }); + ] ) + in + let namedTypeList = List.fold_left argToType [] namedArgList in + let loc = emptyLoc in + let externalDecl = makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList in + let innerExpressionArgs = + List.map pluckArg namedArgListWithKeyAndRefForNew + @ if hasUnit then [ (Nolabel, Exp.construct { loc; txt = Lident "()" } None) ] else [] + in + let innerExpression = + Exp.apply + (Exp.ident + { loc; txt = Lident (match recFlag with Recursive -> internalFnName | Nonrecursive -> fnName) }) + innerExpressionArgs + in + let innerExpressionWithRef = + match forwardRef with + | Some txt -> + { + innerExpression with + pexp_desc = + Pexp_fun + ( nolabel, + None, + { ppat_desc = Ppat_var { txt; loc = emptyLoc }; ppat_loc = emptyLoc; ppat_attributes = [] }, + innerExpression ); + } + | None -> innerExpression + in + let fullExpression = + Exp.fun_ nolabel None + { + ppat_desc = + Ppat_constraint + (makePropsName ~loc:emptyLoc props.propsName, makePropsType ~loc:emptyLoc namedTypeList); + ppat_loc = emptyLoc; + ppat_attributes = []; + } + innerExpressionWithRef + in + let fullExpression = + match fullModuleName with + | "" -> fullExpression + | txt -> + Exp.let_ Nonrecursive + [ Vb.mk ~loc:emptyLoc (Pat.var ~loc:emptyLoc { loc = emptyLoc; txt }) fullExpression ] + (Exp.ident ~loc:emptyLoc { loc = emptyLoc; txt = Lident txt }) + in + let bindings, newBinding = + match recFlag with + | Recursive -> + ( [ + bindingWrapper + (Exp.let_ ~loc:emptyLoc Recursive + [ + makeNewBinding binding expression internalFnName; + Vb.mk (Pat.var { loc = emptyLoc; txt = fnName }) fullExpression; + ] + (Exp.ident { loc = emptyLoc; txt = Lident fnName })); + ], + None ) + | Nonrecursive -> + ([ { binding with pvb_expr = expression; pvb_attributes = [] } ], Some (bindingWrapper fullExpression)) + in + (Some externalDecl, bindings, newBinding) + else (None, [ binding ], None) + [@@raises Invalid_argument] in - let pluckArg (label, _, _, alias, loc, _) = - let labelString = (match label with | label when isOptional label || isLabelled label -> getLabel label | _ -> "") in - (label, - (match labelString with - | "" -> (Exp.ident ~loc { - txt = (Lident alias); - loc - }) - | labelString -> (Exp.apply ~loc - (Exp.ident ~loc {txt = (Lident "##"); loc }) - [ - (nolabel, Exp.ident ~loc {txt = (Lident props.propsName); loc }); - (nolabel, Exp.ident ~loc { - txt = (Lident labelString); - loc - }) - ] - ) - ) - ) in - let namedTypeList = List.fold_left argToType [] namedArgList in - let loc = emptyLoc in - let externalDecl = makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList in - let innerExpressionArgs = (List.map pluckArg namedArgListWithKeyAndRefForNew) @ - if hasUnit then [(Nolabel, Exp.construct {loc; txt = Lident "()"} None)] else [] in - let innerExpression = Exp.apply (Exp.ident {loc; txt = Lident( - match recFlag with - | Recursive -> internalFnName - | Nonrecursive -> fnName - )}) innerExpressionArgs in - let innerExpressionWithRef = match (forwardRef) with - | Some txt -> - {innerExpression with pexp_desc = Pexp_fun (nolabel, None, { - ppat_desc = Ppat_var { txt; loc = emptyLoc }; - ppat_loc = emptyLoc; - ppat_attributes = []; - }, innerExpression)} - | None -> innerExpression + let structuresAndBinding = List.map mapBinding valueBindings in + let otherStructures (extern, binding, newBinding) (externs, bindings, newBindings) = + let externs = match extern with Some extern -> extern :: externs | None -> externs in + let newBindings = + match newBinding with Some newBinding -> newBinding :: newBindings | None -> newBindings + in + (externs, binding @ bindings, newBindings) in - let fullExpression = Exp.fun_ - nolabel - None - { - ppat_desc = Ppat_constraint ( - makePropsName ~loc:emptyLoc props.propsName, - makePropsType ~loc:emptyLoc namedTypeList - ); - ppat_loc = emptyLoc; - ppat_attributes = []; - } - innerExpressionWithRef in - let fullExpression = match (fullModuleName) with - | ("") -> fullExpression - | (txt) -> Exp.let_ - Nonrecursive - [Vb.mk - ~loc:emptyLoc - (Pat.var ~loc:emptyLoc {loc = emptyLoc; txt}) - fullExpression - ] - (Exp.ident ~loc:emptyLoc {loc = emptyLoc; txt = Lident txt}) in - let (bindings, newBinding) = - match recFlag with - | Recursive -> ([bindingWrapper (Exp.let_ - ~loc:(emptyLoc) - Recursive - [ - makeNewBinding binding expression internalFnName; - Vb.mk (Pat.var {loc = emptyLoc; txt = fnName}) fullExpression - ] - (Exp.ident {loc = emptyLoc; txt = Lident fnName}))], None) - | Nonrecursive -> ([{ binding with pvb_expr = expression; pvb_attributes = [] }], Some(bindingWrapper fullExpression)) - in - (Some externalDecl, bindings, newBinding) - else - (None, [binding], None) - in - let structuresAndBinding = List.map mapBinding valueBindings in - let otherStructures (extern, binding, newBinding) (externs, bindings, newBindings) = - let externs = match extern with - | Some extern -> extern :: externs - | None -> externs in - let newBindings = match newBinding with - | Some newBinding -> newBinding :: newBindings - | None -> newBindings in - (externs, binding @ bindings, newBindings) - in - let (externs, bindings, newBindings) = List.fold_right otherStructures structuresAndBinding ([], [], []) in - externs @ [{ - pstr_loc; - pstr_desc = Pstr_value ( - recFlag, - bindings - ) - }] @ (match newBindings with - | [] -> [] - | newBindings -> [{ - pstr_loc = emptyLoc; - pstr_desc = Pstr_value ( - recFlag, - newBindings - ) - }]) @ returnStructures - | structure -> structure :: returnStructures in + let externs, bindings, newBindings = List.fold_right otherStructures structuresAndBinding ([], [], []) in + externs + @ [ { pstr_loc; pstr_desc = Pstr_value (recFlag, bindings) } ] + @ ( match newBindings with + | [] -> [] + | newBindings -> [ { pstr_loc = emptyLoc; pstr_desc = Pstr_value (recFlag, newBindings) } ] ) + @ returnStructures + | structure -> structure :: returnStructures + [@@raises Invalid_argument] + in let reactComponentTransform mapper structures = - List.fold_right (transformComponentDefinition mapper) structures [] in - - let transformComponentSignature _mapper signature returnSignatures = match signature with - | ({ - psig_loc; - psig_desc = Psig_value ({ - pval_name = { txt = fnName }; - pval_attributes; - pval_type; - } as psig_desc) - } as psig) -> - (match List.filter hasAttr pval_attributes with - | [] -> signature :: returnSignatures - | [_] -> - let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = - (match ptyp_desc with - | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) when isOptional name || isLabelled name -> - getPropTypes ((name, ptyp_loc, type_)::types) rest - | Ptyp_arrow (Nolabel, _type, rest) -> - getPropTypes types rest - | Ptyp_arrow (name, type_, returnValue) when isOptional name || isLabelled name -> - (returnValue, (name, returnValue.ptyp_loc, type_)::types) - | _ -> (fullType, types)) - in - let (innerType, propTypes) = getPropTypes [] pval_type in - let namedTypeList = List.fold_left argToConcreteType [] propTypes in - let pluckLabelAndLoc (label, loc, type_) = (label, None, loc, Some type_) in - let retPropsType = makePropsType ~loc:psig_loc namedTypeList in - let externalPropsDecl = makePropsExternalSig fnName psig_loc (( - optional "key", - None, - psig_loc, - Some(keyType psig_loc) - ) :: List.map pluckLabelAndLoc propTypes) retPropsType in - (* can't be an arrow because it will defensively uncurry *) - let newExternalType = Ptyp_constr ( - {loc = psig_loc; txt = Ldot ((Lident "React"), "componentLike")}, - [retPropsType; innerType] - ) in - let newStructure = { - psig with psig_desc = Psig_value { - psig_desc with pval_type = { - pval_type with ptyp_desc = newExternalType; - }; - pval_attributes = List.filter otherAttrsPure pval_attributes; - } - } in - externalPropsDecl :: newStructure :: returnSignatures - | _ -> raise (Invalid_argument "Only one react.component call can exist on a component at one time")) - | signature -> signature :: returnSignatures in + List.fold_right (transformComponentDefinition mapper) structures [] + [@@raises Invalid_argument] + in - let reactComponentSignatureTransform mapper signatures = - List.fold_right (transformComponentSignature mapper) signatures [] in + let transformComponentSignature _mapper signature returnSignatures = + match signature with + | { psig_loc; psig_desc = Psig_value ({ pval_name = { txt = fnName }; pval_attributes; pval_type } as psig_desc) } + as psig -> ( + match List.filter hasAttr pval_attributes with + | [] -> signature :: returnSignatures + | [ _ ] -> + let rec getPropTypes types ({ ptyp_loc; ptyp_desc } as fullType) = + match ptyp_desc with + | Ptyp_arrow (name, type_, ({ ptyp_desc = Ptyp_arrow _ } as rest)) when isOptional name || isLabelled name + -> + getPropTypes ((name, ptyp_loc, type_) :: types) rest + | Ptyp_arrow (Nolabel, _type, rest) -> getPropTypes types rest + | Ptyp_arrow (name, type_, returnValue) when isOptional name || isLabelled name -> + (returnValue, (name, returnValue.ptyp_loc, type_) :: types) + | _ -> (fullType, types) + in + let innerType, propTypes = getPropTypes [] pval_type in + let namedTypeList = List.fold_left argToConcreteType [] propTypes in + let pluckLabelAndLoc (label, loc, type_) = (label, None, loc, Some type_) in + let retPropsType = makePropsType ~loc:psig_loc namedTypeList in + let externalPropsDecl = + makePropsExternalSig fnName psig_loc + ((optional "key", None, psig_loc, Some (keyType psig_loc)) :: List.map pluckLabelAndLoc propTypes) + retPropsType + in + (* can't be an arrow because it will defensively uncurry *) + let newExternalType = + Ptyp_constr ({ loc = psig_loc; txt = Ldot (Lident "React", "componentLike") }, [ retPropsType; innerType ]) + in + let newStructure = + { + psig with + psig_desc = + Psig_value + { + psig_desc with + pval_type = { pval_type with ptyp_desc = newExternalType }; + pval_attributes = List.filter otherAttrsPure pval_attributes; + }; + } + in + externalPropsDecl :: newStructure :: returnSignatures + | _ -> raise (Invalid_argument "Only one react.component call can exist on a component at one time") ) + | signature -> signature :: returnSignatures + [@@raises Invalid_argument] + in + let reactComponentSignatureTransform mapper signatures = + List.fold_right (transformComponentSignature mapper) signatures [] + [@@raises Invalid_argument] + in let transformJsxCall mapper callExpression callArguments attrs = - (match callExpression.pexp_desc with - | Pexp_ident caller -> - (match caller with - | {txt = Lident "createElement"} -> - raise (Invalid_argument "JSX: `createElement` should be preceeded by a module name.") - + match callExpression.pexp_desc with + | Pexp_ident caller -> ( + match caller with + | { txt = Lident "createElement" } -> + raise (Invalid_argument "JSX: `createElement` should be preceeded by a module name.") (* Foo.createElement(~prop1=foo, ~prop2=bar, ~children=[], ()) *) - | {loc; txt = Ldot (modulePath, ("createElement" | "make"))} -> - (match !jsxVersion with - | None - | Some 3 -> transformUppercaseCall3 modulePath mapper loc attrs callExpression callArguments - | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 3")) - + | { loc; txt = Ldot (modulePath, ("createElement" | "make")) } -> ( + match !jsxVersion with + | None | Some 3 -> transformUppercaseCall3 modulePath mapper loc attrs callExpression callArguments + | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 3") ) (* div(~prop1=foo, ~prop2=bar, ~children=[bla], ()) *) (* turn that into - ReactDOMRe.createElement(~props=ReactDOMRe.props(~props1=foo, ~props2=bar, ()), [|bla|]) *) - | {loc; txt = Lident id} -> - (match !jsxVersion with - | None - | Some 3 -> transformLowercaseCall3 mapper loc attrs callArguments id - | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 3")) - - | {txt = Ldot (_, anythingNotCreateElementOrMake)} -> - raise ( - Invalid_argument - ("JSX: the JSX attribute should be attached to a `YourModuleName.createElement` or `YourModuleName.make` call. We saw `" - ^ anythingNotCreateElementOrMake - ^ "` instead" - ) - ) - - | {txt = Lapply _} -> - (* don't think there's ever a case where this is reached *) - raise ( - Invalid_argument "JSX: encountered a weird case while processing the code. Please report this!" - ) - ) - | _ -> - raise ( - Invalid_argument "JSX: `createElement` should be preceeded by a simple, direct module name." - ) - ) in + ReactDOMRe.createElement(~props=ReactDOMRe.props(~props1=foo, ~props2=bar, ()), [|bla|]) *) + | { loc; txt = Lident id } -> ( + match !jsxVersion with + | None | Some 3 -> transformLowercaseCall3 mapper loc attrs callArguments id + | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 3") ) + | { txt = Ldot (_, anythingNotCreateElementOrMake) } -> + raise + (Invalid_argument + ( "JSX: the JSX attribute should be attached to a `YourModuleName.createElement` or \ + `YourModuleName.make` call. We saw `" ^ anythingNotCreateElementOrMake ^ "` instead" )) + | { txt = Lapply _ } -> + (* don't think there's ever a case where this is reached *) + raise (Invalid_argument "JSX: encountered a weird case while processing the code. Please report this!") ) + | _ -> raise (Invalid_argument "JSX: `createElement` should be preceeded by a simple, direct module name.") + [@@raises Invalid_argument] + in - let signature = - (fun mapper signature -> default_mapper.signature mapper @@ reactComponentSignatureTransform mapper signature) in + let signature mapper signature = + default_mapper.signature mapper @@ reactComponentSignatureTransform mapper signature + [@@raises Invalid_argument] + in - let structure = - (fun mapper structure -> match structure with - | structures -> begin - default_mapper.structure mapper @@ reactComponentTransform mapper structures - end - ) in + let structure mapper structure = + match structure with structures -> default_mapper.structure mapper @@ reactComponentTransform mapper structures + [@@raises Invalid_argument] + in - let expr = - (fun mapper expression -> match expression with - (* Does the function application have the @JSX attribute? *) - | { - pexp_desc = Pexp_apply (callExpression, callArguments); - pexp_attributes - } -> - let (jsxAttribute, nonJSXAttributes) = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - (match (jsxAttribute, nonJSXAttributes) with - (* no JSX attribute *) - | ([], _) -> default_mapper.expr mapper expression - | (_, nonJSXAttributes) -> transformJsxCall mapper callExpression callArguments nonJSXAttributes) - - (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) - | { - pexp_desc = - Pexp_construct ({txt = Lident "::"; loc}, Some {pexp_desc = Pexp_tuple _}) - | Pexp_construct ({txt = Lident "[]"; loc}, None); - pexp_attributes - } as listItems -> - let (jsxAttribute, nonJSXAttributes) = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - (match (jsxAttribute, nonJSXAttributes) with - (* no JSX attribute *) - | ([], _) -> default_mapper.expr mapper expression - | (_, nonJSXAttributes) -> - let fragment = Exp.ident ~loc {loc; txt = Ldot (Lident "ReasonReact", "fragment")} in + let expr mapper expression = + match expression with + (* Does the function application have the @JSX attribute? *) + | { pexp_desc = Pexp_apply (callExpression, callArguments); pexp_attributes } -> ( + let jsxAttribute, nonJSXAttributes = + List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes + in + match (jsxAttribute, nonJSXAttributes) with + (* no JSX attribute *) + | [], _ -> default_mapper.expr mapper expression + | _, nonJSXAttributes -> transformJsxCall mapper callExpression callArguments nonJSXAttributes ) + (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) + | { + pexp_desc = + ( Pexp_construct ({ txt = Lident "::"; loc }, Some { pexp_desc = Pexp_tuple _ }) + | Pexp_construct ({ txt = Lident "[]"; loc }, None) ); + pexp_attributes; + } as listItems -> ( + let jsxAttribute, nonJSXAttributes = + List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes + in + match (jsxAttribute, nonJSXAttributes) with + (* no JSX attribute *) + | [], _ -> default_mapper.expr mapper expression + | _, nonJSXAttributes -> + let fragment = Exp.ident ~loc { loc; txt = Ldot (Lident "ReasonReact", "fragment") } in let childrenExpr = transformChildrenIfList ~loc ~mapper listItems in - let args = [ - (* "div" *) - (nolabel, fragment); - (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] in - Exp.apply - ~loc - (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs:nonJSXAttributes + let args = + [ (* "div" *) (nolabel, fragment); (* [|moreCreateElementCallsHere|] *) (nolabel, childrenExpr) ] + in + Exp.apply ~loc (* throw away the [@JSX] attribute and keep the others, if any *) ~attrs:nonJSXAttributes (* ReactDOMRe.createElement *) - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "createElement")}) - args - ) - (* Delegate to the default mapper, a deep identity traversal *) - | e -> default_mapper.expr mapper e) in - - let module_binding = - (fun mapper module_binding -> - let _ = nestedModules := module_binding.pmb_name.txt :: !nestedModules in - let mapped = default_mapper.module_binding mapper module_binding in - let _ = nestedModules := List.tl !nestedModules in - mapped - ) in + (Exp.ident ~loc { loc; txt = Ldot (Lident "ReactDOMRe", "createElement") }) + args ) + (* Delegate to the default mapper, a deep identity traversal *) + | e -> default_mapper.expr mapper e + [@@raises Invalid_argument] + in - { default_mapper with structure; expr; signature; module_binding; } + let module_binding mapper module_binding = + let _ = nestedModules := module_binding.pmb_name.txt :: !nestedModules in + let mapped = default_mapper.module_binding mapper module_binding in + let _ = nestedModules := List.tl !nestedModules in + mapped + [@@raises Failure] + in + { default_mapper with structure; expr; signature; module_binding } + [@@raises Invalid_argument, Failure] -let rewrite_implementation (code: Parsetree.structure) : Parsetree.structure = +let rewrite_implementation (code : Parsetree.structure) : Parsetree.structure = let mapper = jsxMapper () in mapper.structure mapper code + [@@raises Invalid_argument, Failure] + let rewrite_signature (code : Parsetree.signature) : Parsetree.signature = let mapper = jsxMapper () in mapper.signature mapper code - + [@@raises Invalid_argument, Failure] end module Ppx_entry diff --git a/lib/4.06.1/unstable/js_refmt_compiler.ml.d b/lib/4.06.1/unstable/js_refmt_compiler.ml.d index ad38a05e5a..a4e8c19ac7 100644 --- a/lib/4.06.1/unstable/js_refmt_compiler.ml.d +++ b/lib/4.06.1/unstable/js_refmt_compiler.ml.d @@ -1 +1 @@ -../lib/4.06.1/unstable/js_refmt_compiler.ml: ../ocaml/bytecomp/lambda.ml ../ocaml/bytecomp/lambda.mli ../ocaml/bytecomp/matching.ml ../ocaml/bytecomp/matching.mli ../ocaml/bytecomp/printlambda.ml ../ocaml/bytecomp/printlambda.mli ../ocaml/bytecomp/switch.ml ../ocaml/bytecomp/switch.mli ../ocaml/bytecomp/translattribute.ml ../ocaml/bytecomp/translattribute.mli ../ocaml/bytecomp/translclass.ml ../ocaml/bytecomp/translclass.mli ../ocaml/bytecomp/translcore.ml ../ocaml/bytecomp/translcore.mli ../ocaml/bytecomp/translmod.ml ../ocaml/bytecomp/translmod.mli ../ocaml/bytecomp/translobj.ml ../ocaml/bytecomp/translobj.mli ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/ast_iterator.ml ../ocaml/parsing/ast_iterator.mli ../ocaml/parsing/ast_mapper.ml ../ocaml/parsing/ast_mapper.mli ../ocaml/parsing/asttypes.mli ../ocaml/parsing/attr_helper.ml ../ocaml/parsing/attr_helper.mli ../ocaml/parsing/builtin_attributes.ml ../ocaml/parsing/builtin_attributes.mli ../ocaml/parsing/docstrings.ml ../ocaml/parsing/docstrings.mli ../ocaml/parsing/lexer.ml ../ocaml/parsing/lexer.mli ../ocaml/parsing/location.ml ../ocaml/parsing/location.mli ../ocaml/parsing/longident.ml ../ocaml/parsing/longident.mli ../ocaml/parsing/parse.ml ../ocaml/parsing/parse.mli ../ocaml/parsing/parser.ml ../ocaml/parsing/parser.mli ../ocaml/parsing/parsetree.mli ../ocaml/parsing/pprintast.ml ../ocaml/parsing/pprintast.mli ../ocaml/parsing/syntaxerr.ml ../ocaml/parsing/syntaxerr.mli ../ocaml/typing/annot.mli ../ocaml/typing/btype.ml ../ocaml/typing/btype.mli ../ocaml/typing/cmi_format.ml ../ocaml/typing/cmi_format.mli ../ocaml/typing/cmt_format.ml ../ocaml/typing/cmt_format.mli ../ocaml/typing/ctype.ml ../ocaml/typing/ctype.mli ../ocaml/typing/datarepr.ml ../ocaml/typing/datarepr.mli ../ocaml/typing/env.ml ../ocaml/typing/env.mli ../ocaml/typing/ident.ml ../ocaml/typing/ident.mli ../ocaml/typing/includeclass.ml ../ocaml/typing/includeclass.mli ../ocaml/typing/includecore.ml ../ocaml/typing/includecore.mli ../ocaml/typing/includemod.ml ../ocaml/typing/includemod.mli ../ocaml/typing/mtype.ml ../ocaml/typing/mtype.mli ../ocaml/typing/oprint.ml ../ocaml/typing/oprint.mli ../ocaml/typing/outcometree.mli ../ocaml/typing/parmatch.ml ../ocaml/typing/parmatch.mli ../ocaml/typing/path.ml ../ocaml/typing/path.mli ../ocaml/typing/predef.ml ../ocaml/typing/predef.mli ../ocaml/typing/primitive.ml ../ocaml/typing/primitive.mli ../ocaml/typing/printtyp.ml ../ocaml/typing/printtyp.mli ../ocaml/typing/stypes.ml ../ocaml/typing/stypes.mli ../ocaml/typing/subst.ml ../ocaml/typing/subst.mli ../ocaml/typing/tast_mapper.ml ../ocaml/typing/tast_mapper.mli ../ocaml/typing/typeclass.ml ../ocaml/typing/typeclass.mli ../ocaml/typing/typecore.ml ../ocaml/typing/typecore.mli ../ocaml/typing/typedecl.ml ../ocaml/typing/typedecl.mli ../ocaml/typing/typedtree.ml ../ocaml/typing/typedtree.mli ../ocaml/typing/typedtreeIter.ml ../ocaml/typing/typedtreeIter.mli ../ocaml/typing/typemod.ml ../ocaml/typing/typemod.mli ../ocaml/typing/typeopt.ml ../ocaml/typing/typeopt.mli ../ocaml/typing/types.ml ../ocaml/typing/types.mli ../ocaml/typing/typetexp.ml ../ocaml/typing/typetexp.mli ../ocaml/typing/untypeast.ml ../ocaml/typing/untypeast.mli ../ocaml/utils/arg_helper.ml ../ocaml/utils/arg_helper.mli ../ocaml/utils/ccomp.ml ../ocaml/utils/ccomp.mli ../ocaml/utils/clflags.ml ../ocaml/utils/clflags.mli ../ocaml/utils/consistbl.ml ../ocaml/utils/consistbl.mli ../ocaml/utils/identifiable.ml ../ocaml/utils/identifiable.mli ../ocaml/utils/misc.ml ../ocaml/utils/misc.mli ../ocaml/utils/numbers.ml ../ocaml/utils/numbers.mli ../ocaml/utils/profile.ml ../ocaml/utils/profile.mli ../ocaml/utils/tbl.ml ../ocaml/utils/tbl.mli ../ocaml/utils/warnings.ml ../ocaml/utils/warnings.mli ./common/bs_loc.ml ./common/bs_loc.mli ./common/bs_version.ml ./common/bs_version.mli ./common/bs_warnings.ml ./common/bs_warnings.mli ./common/ext_log.ml ./common/ext_log.mli ./common/js_config.ml ./common/js_config.mli ./common/lam_methname.ml ./common/lam_methname.mli ./core/bs_cmi_load.ml ./core/bs_conditional_initial.ml ./core/bs_conditional_initial.mli ./core/compile_rec_module.ml ./core/config_util.ml ./core/config_util.mli ./core/config_whole_compiler.ml ./core/config_whole_compiler.mli ./core/j.ml ./core/js_analyzer.ml ./core/js_analyzer.mli ./core/js_arr.ml ./core/js_arr.mli ./core/js_ast_util.ml ./core/js_ast_util.mli ./core/js_block_runtime.ml ./core/js_block_runtime.mli ./core/js_call_info.ml ./core/js_call_info.mli ./core/js_closure.ml ./core/js_closure.mli ./core/js_cmj_format.ml ./core/js_cmj_format.mli ./core/js_cmj_load.ml ./core/js_cmj_load.mli ./core/js_cmj_load_builtin_unit.ml ./core/js_dump.ml ./core/js_dump.mli ./core/js_dump_import_export.ml ./core/js_dump_import_export.mli ./core/js_dump_lit.ml ./core/js_dump_program.ml ./core/js_dump_program.mli ./core/js_dump_property.ml ./core/js_dump_property.mli ./core/js_dump_string.ml ./core/js_dump_string.mli ./core/js_exp_make.ml ./core/js_exp_make.mli ./core/js_fold.ml ./core/js_fold_basic.ml ./core/js_fold_basic.mli ./core/js_fun_env.ml ./core/js_fun_env.mli ./core/js_long.ml ./core/js_long.mli ./core/js_map.ml ./core/js_name_of_module_id.ml ./core/js_name_of_module_id.mli ./core/js_number.ml ./core/js_number.mli ./core/js_of_lam_array.ml ./core/js_of_lam_array.mli ./core/js_of_lam_block.ml ./core/js_of_lam_block.mli ./core/js_of_lam_exception.ml ./core/js_of_lam_exception.mli ./core/js_of_lam_option.ml ./core/js_of_lam_option.mli ./core/js_of_lam_string.ml ./core/js_of_lam_string.mli ./core/js_of_lam_variant.ml ./core/js_of_lam_variant.mli ./core/js_op.ml ./core/js_op_util.ml ./core/js_op_util.mli ./core/js_output.ml ./core/js_output.mli ./core/js_packages_info.ml ./core/js_packages_info.mli ./core/js_packages_state.ml ./core/js_packages_state.mli ./core/js_pass_debug.ml ./core/js_pass_debug.mli ./core/js_pass_flatten.ml ./core/js_pass_flatten.mli ./core/js_pass_flatten_and_mark_dead.ml ./core/js_pass_flatten_and_mark_dead.mli ./core/js_pass_get_used.ml ./core/js_pass_get_used.mli ./core/js_pass_scope.ml ./core/js_pass_scope.mli ./core/js_pass_tailcall_inline.ml ./core/js_pass_tailcall_inline.mli ./core/js_raw_info.ml ./core/js_shake.ml ./core/js_shake.mli ./core/js_stmt_make.ml ./core/js_stmt_make.mli ./core/lam.ml ./core/lam.mli ./core/lam_analysis.ml ./core/lam_analysis.mli ./core/lam_arity.ml ./core/lam_arity.mli ./core/lam_arity_analysis.ml ./core/lam_arity_analysis.mli ./core/lam_beta_reduce.ml ./core/lam_beta_reduce.mli ./core/lam_beta_reduce_util.ml ./core/lam_beta_reduce_util.mli ./core/lam_bounded_vars.ml ./core/lam_bounded_vars.mli ./core/lam_closure.ml ./core/lam_closure.mli ./core/lam_coercion.ml ./core/lam_coercion.mli ./core/lam_compat.ml ./core/lam_compat.mli ./core/lam_compile.ml ./core/lam_compile.mli ./core/lam_compile_const.ml ./core/lam_compile_const.mli ./core/lam_compile_context.ml ./core/lam_compile_context.mli ./core/lam_compile_env.ml ./core/lam_compile_env.mli ./core/lam_compile_external_call.ml ./core/lam_compile_external_call.mli ./core/lam_compile_external_obj.ml ./core/lam_compile_external_obj.mli ./core/lam_compile_main.ml ./core/lam_compile_main.mli ./core/lam_compile_primitive.ml ./core/lam_compile_primitive.mli ./core/lam_compile_util.ml ./core/lam_compile_util.mli ./core/lam_constant.ml ./core/lam_constant.mli ./core/lam_constant_convert.ml ./core/lam_constant_convert.mli ./core/lam_convert.ml ./core/lam_convert.mli ./core/lam_dce.ml ./core/lam_dce.mli ./core/lam_dispatch_primitive.ml ./core/lam_dispatch_primitive.mli ./core/lam_eta_conversion.ml ./core/lam_eta_conversion.mli ./core/lam_exit_code.ml ./core/lam_exit_code.mli ./core/lam_exit_count.ml ./core/lam_exit_count.mli ./core/lam_free_variables.ml ./core/lam_free_variables.mli ./core/lam_group.ml ./core/lam_group.mli ./core/lam_hit.ml ./core/lam_hit.mli ./core/lam_id_kind.ml ./core/lam_id_kind.mli ./core/lam_iter.ml ./core/lam_iter.mli ./core/lam_module_ident.ml ./core/lam_module_ident.mli ./core/lam_pass_alpha_conversion.ml ./core/lam_pass_alpha_conversion.mli ./core/lam_pass_collect.ml ./core/lam_pass_collect.mli ./core/lam_pass_count.ml ./core/lam_pass_count.mli ./core/lam_pass_deep_flatten.ml ./core/lam_pass_deep_flatten.mli ./core/lam_pass_eliminate_ref.ml ./core/lam_pass_eliminate_ref.mli ./core/lam_pass_exits.ml ./core/lam_pass_exits.mli ./core/lam_pass_lets_dce.ml ./core/lam_pass_lets_dce.mli ./core/lam_pass_remove_alias.ml ./core/lam_pass_remove_alias.mli ./core/lam_pointer_info.ml ./core/lam_pointer_info.mli ./core/lam_primitive.ml ./core/lam_primitive.mli ./core/lam_print.ml ./core/lam_print.mli ./core/lam_scc.ml ./core/lam_scc.mli ./core/lam_stats.ml ./core/lam_stats.mli ./core/lam_stats_export.ml ./core/lam_stats_export.mli ./core/lam_subst.ml ./core/lam_subst.mli ./core/lam_tag_info.ml ./core/lam_util.ml ./core/lam_util.mli ./core/lam_var_stats.ml ./core/lam_var_stats.mli ./core/matching_polyfill.ml ./core/matching_polyfill.mli ./core/polyvar_pattern_match.ml ./core/record_attributes_check.ml ./core/res_compmisc.ml ./core/res_compmisc.mli ./core/transl_single_field_record.ml ./depends/bs_exception.ml ./depends/bs_exception.mli ./ext/bsc_args.ml ./ext/bsc_args.mli ./ext/bsc_warnings.ml ./ext/ext_array.ml ./ext/ext_array.mli ./ext/ext_buffer.ml ./ext/ext_buffer.mli ./ext/ext_bytes.ml ./ext/ext_bytes.mli ./ext/ext_char.ml ./ext/ext_char.mli ./ext/ext_digest.ml ./ext/ext_digest.mli ./ext/ext_filename.ml ./ext/ext_filename.mli ./ext/ext_fmt.ml ./ext/ext_ident.ml ./ext/ext_ident.mli ./ext/ext_int.ml ./ext/ext_int.mli ./ext/ext_io.ml ./ext/ext_io.mli ./ext/ext_js_file_kind.ml ./ext/ext_js_suffix.ml ./ext/ext_list.ml ./ext/ext_list.mli ./ext/ext_marshal.ml ./ext/ext_marshal.mli ./ext/ext_modulename.ml ./ext/ext_modulename.mli ./ext/ext_namespace.ml ./ext/ext_namespace.mli ./ext/ext_option.ml ./ext/ext_option.mli ./ext/ext_path.ml ./ext/ext_path.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli ./ext/ext_pp.ml ./ext/ext_pp.mli ./ext/ext_pp_scope.ml ./ext/ext_pp_scope.mli ./ext/ext_ref.ml ./ext/ext_ref.mli ./ext/ext_scc.ml ./ext/ext_scc.mli ./ext/ext_spec.ml ./ext/ext_spec.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_string_array.ml ./ext/ext_string_array.mli ./ext/ext_sys.ml ./ext/ext_sys.mli ./ext/ext_utf8.ml ./ext/ext_utf8.mli ./ext/ext_util.ml ./ext/ext_util.mli ./ext/hash.ml ./ext/hash.mli ./ext/hash_gen.ml ./ext/hash_ident.ml ./ext/hash_ident.mli ./ext/hash_int.ml ./ext/hash_int.mli ./ext/hash_set.ml ./ext/hash_set.mli ./ext/hash_set_gen.ml ./ext/hash_set_ident.ml ./ext/hash_set_ident.mli ./ext/hash_set_ident_mask.ml ./ext/hash_set_ident_mask.mli ./ext/hash_set_poly.ml ./ext/hash_set_poly.mli ./ext/hash_set_string.ml ./ext/hash_set_string.mli ./ext/hash_string.ml ./ext/hash_string.mli ./ext/int_vec_util.ml ./ext/int_vec_util.mli ./ext/int_vec_vec.ml ./ext/int_vec_vec.mli ./ext/js_reserved_map.ml ./ext/js_reserved_map.mli ./ext/js_runtime_modules.ml ./ext/literals.ml ./ext/map_gen.ml ./ext/map_gen.mli ./ext/map_ident.ml ./ext/map_ident.mli ./ext/map_int.ml ./ext/map_int.mli ./ext/map_string.ml ./ext/map_string.mli ./ext/ordered_hash_map_gen.ml ./ext/ordered_hash_map_local_ident.ml ./ext/ordered_hash_map_local_ident.mli ./ext/set_gen.ml ./ext/set_gen.mli ./ext/set_ident.ml ./ext/set_ident.mli ./ext/set_string.ml ./ext/set_string.mli ./ext/vec.ml ./ext/vec.mli ./ext/vec_gen.ml ./ext/vec_int.ml ./ext/vec_int.mli ./js_parser/declaration_parser.ml ./js_parser/enum_common.ml ./js_parser/enum_parser.ml ./js_parser/expression_parser.ml ./js_parser/file_key.ml ./js_parser/flow_ast.ml ./js_parser/flow_ast_utils.ml ./js_parser/flow_ast_utils.mli ./js_parser/flow_lexer.ml ./js_parser/flow_lexer.mli ./js_parser/jsx_parser.ml ./js_parser/lex_env.ml ./js_parser/lex_result.ml ./js_parser/loc.ml ./js_parser/loc.mli ./js_parser/object_parser.ml ./js_parser/parse_error.ml ./js_parser/parser_common.ml ./js_parser/parser_env.ml ./js_parser/parser_env.mli ./js_parser/parser_flow.ml ./js_parser/pattern_cover.ml ./js_parser/pattern_parser.ml ./js_parser/sedlexing.ml ./js_parser/sedlexing.mli ./js_parser/statement_parser.ml ./js_parser/token.ml ./js_parser/type_parser.ml ./js_parser/wtf8.ml ./js_parser/wtf8.mli ./main/builtin_cmi_datasets.ml ./main/builtin_cmi_datasets.mli ./main/builtin_cmj_datasets.ml ./main/builtin_cmj_datasets.mli ./main/jsoo_common.ml ./main/jsoo_common.mli ./outcome_printer/outcome_printer_ns.ml ./outcome_printer/outcome_printer_ns.mli ./refmt/jsoo_refmt_main.ml ./refmt/jsoo_refmt_main.mli ./refmt/refmt_api.ml ./stubs/bs_hash_stubs.ml ./super_errors/super_env.ml ./super_errors/super_location.ml ./super_errors/super_location.mli ./super_errors/super_main.ml ./super_errors/super_misc.ml ./super_errors/super_misc.mli ./super_errors/super_pparse.ml ./super_errors/super_typecore.ml ./super_errors/super_typemod.ml ./super_errors/super_typetexp.ml ./syntax/ast_attributes.ml ./syntax/ast_attributes.mli ./syntax/ast_bs_open.ml ./syntax/ast_bs_open.mli ./syntax/ast_comb.ml ./syntax/ast_comb.mli ./syntax/ast_compatible.ml ./syntax/ast_compatible.mli ./syntax/ast_config.ml ./syntax/ast_config.mli ./syntax/ast_core_type.ml ./syntax/ast_core_type.mli ./syntax/ast_core_type_class_type.ml ./syntax/ast_core_type_class_type.mli ./syntax/ast_derive.ml ./syntax/ast_derive.mli ./syntax/ast_derive_abstract.ml ./syntax/ast_derive_abstract.mli ./syntax/ast_derive_js_mapper.ml ./syntax/ast_derive_js_mapper.mli ./syntax/ast_derive_projector.ml ./syntax/ast_derive_projector.mli ./syntax/ast_derive_util.ml ./syntax/ast_derive_util.mli ./syntax/ast_exp.ml ./syntax/ast_exp.mli ./syntax/ast_exp_apply.ml ./syntax/ast_exp_apply.mli ./syntax/ast_exp_extension.ml ./syntax/ast_exp_extension.mli ./syntax/ast_exp_handle_external.ml ./syntax/ast_exp_handle_external.mli ./syntax/ast_external.ml ./syntax/ast_external.mli ./syntax/ast_external_mk.ml ./syntax/ast_external_mk.mli ./syntax/ast_external_process.ml ./syntax/ast_external_process.mli ./syntax/ast_literal.ml ./syntax/ast_literal.mli ./syntax/ast_open_cxt.ml ./syntax/ast_open_cxt.mli ./syntax/ast_pat.ml ./syntax/ast_pat.mli ./syntax/ast_payload.ml ./syntax/ast_payload.mli ./syntax/ast_polyvar.ml ./syntax/ast_polyvar.mli ./syntax/ast_reason_pp.ml ./syntax/ast_reason_pp.mli ./syntax/ast_signature.ml ./syntax/ast_signature.mli ./syntax/ast_structure.ml ./syntax/ast_structure.mli ./syntax/ast_tdcls.ml ./syntax/ast_tdcls.mli ./syntax/ast_tuple_pattern_flatten.ml ./syntax/ast_tuple_pattern_flatten.mli ./syntax/ast_typ_uncurry.ml ./syntax/ast_typ_uncurry.mli ./syntax/ast_uncurry_apply.ml ./syntax/ast_uncurry_apply.mli ./syntax/ast_uncurry_gen.ml ./syntax/ast_uncurry_gen.mli ./syntax/ast_utf8_string.ml ./syntax/ast_utf8_string.mli ./syntax/ast_utf8_string_interp.ml ./syntax/ast_utf8_string_interp.mli ./syntax/ast_util.ml ./syntax/ast_util.mli ./syntax/bs_ast_invariant.ml ./syntax/bs_ast_invariant.mli ./syntax/bs_ast_mapper.ml ./syntax/bs_ast_mapper.mli ./syntax/bs_builtin_ppx.ml ./syntax/bs_builtin_ppx.mli ./syntax/bs_flow_ast_utils.ml ./syntax/bs_flow_ast_utils.mli ./syntax/bs_syntaxerr.ml ./syntax/bs_syntaxerr.mli ./syntax/classify_function.ml ./syntax/classify_function.mli ./syntax/external_arg_spec.ml ./syntax/external_arg_spec.mli ./syntax/external_ffi_types.ml ./syntax/external_ffi_types.mli ./syntax/ppx_entry.ml ./syntax/reactjs_jsx_ppx_v3.ml ./syntax/typemod_hide.ml \ No newline at end of file +../lib/4.06.1/unstable/js_refmt_compiler.ml: ../ocaml/bytecomp/lambda.ml ../ocaml/bytecomp/lambda.mli ../ocaml/bytecomp/matching.ml ../ocaml/bytecomp/matching.mli ../ocaml/bytecomp/printlambda.ml ../ocaml/bytecomp/printlambda.mli ../ocaml/bytecomp/switch.ml ../ocaml/bytecomp/switch.mli ../ocaml/bytecomp/translattribute.ml ../ocaml/bytecomp/translattribute.mli ../ocaml/bytecomp/translclass.ml ../ocaml/bytecomp/translclass.mli ../ocaml/bytecomp/translcore.ml ../ocaml/bytecomp/translcore.mli ../ocaml/bytecomp/translmod.ml ../ocaml/bytecomp/translmod.mli ../ocaml/bytecomp/translobj.ml ../ocaml/bytecomp/translobj.mli ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/ast_iterator.ml ../ocaml/parsing/ast_iterator.mli ../ocaml/parsing/ast_mapper.ml ../ocaml/parsing/ast_mapper.mli ../ocaml/parsing/asttypes.mli ../ocaml/parsing/attr_helper.ml ../ocaml/parsing/attr_helper.mli ../ocaml/parsing/builtin_attributes.ml ../ocaml/parsing/builtin_attributes.mli ../ocaml/parsing/docstrings.ml ../ocaml/parsing/docstrings.mli ../ocaml/parsing/lexer.ml ../ocaml/parsing/lexer.mli ../ocaml/parsing/location.ml ../ocaml/parsing/location.mli ../ocaml/parsing/longident.ml ../ocaml/parsing/longident.mli ../ocaml/parsing/parse.ml ../ocaml/parsing/parse.mli ../ocaml/parsing/parser.ml ../ocaml/parsing/parser.mli ../ocaml/parsing/parsetree.mli ../ocaml/parsing/pprintast.ml ../ocaml/parsing/pprintast.mli ../ocaml/parsing/syntaxerr.ml ../ocaml/parsing/syntaxerr.mli ../ocaml/typing/annot.mli ../ocaml/typing/btype.ml ../ocaml/typing/btype.mli ../ocaml/typing/cmi_format.ml ../ocaml/typing/cmi_format.mli ../ocaml/typing/cmt_format.ml ../ocaml/typing/cmt_format.mli ../ocaml/typing/ctype.ml ../ocaml/typing/ctype.mli ../ocaml/typing/datarepr.ml ../ocaml/typing/datarepr.mli ../ocaml/typing/env.ml ../ocaml/typing/env.mli ../ocaml/typing/ident.ml ../ocaml/typing/ident.mli ../ocaml/typing/includeclass.ml ../ocaml/typing/includeclass.mli ../ocaml/typing/includecore.ml ../ocaml/typing/includecore.mli ../ocaml/typing/includemod.ml ../ocaml/typing/includemod.mli ../ocaml/typing/mtype.ml ../ocaml/typing/mtype.mli ../ocaml/typing/oprint.ml ../ocaml/typing/oprint.mli ../ocaml/typing/outcometree.mli ../ocaml/typing/parmatch.ml ../ocaml/typing/parmatch.mli ../ocaml/typing/path.ml ../ocaml/typing/path.mli ../ocaml/typing/predef.ml ../ocaml/typing/predef.mli ../ocaml/typing/primitive.ml ../ocaml/typing/primitive.mli ../ocaml/typing/printtyp.ml ../ocaml/typing/printtyp.mli ../ocaml/typing/stypes.ml ../ocaml/typing/stypes.mli ../ocaml/typing/subst.ml ../ocaml/typing/subst.mli ../ocaml/typing/tast_mapper.ml ../ocaml/typing/tast_mapper.mli ../ocaml/typing/typeclass.ml ../ocaml/typing/typeclass.mli ../ocaml/typing/typecore.ml ../ocaml/typing/typecore.mli ../ocaml/typing/typedecl.ml ../ocaml/typing/typedecl.mli ../ocaml/typing/typedtree.ml ../ocaml/typing/typedtree.mli ../ocaml/typing/typedtreeIter.ml ../ocaml/typing/typedtreeIter.mli ../ocaml/typing/typemod.ml ../ocaml/typing/typemod.mli ../ocaml/typing/typeopt.ml ../ocaml/typing/typeopt.mli ../ocaml/typing/types.ml ../ocaml/typing/types.mli ../ocaml/typing/typetexp.ml ../ocaml/typing/typetexp.mli ../ocaml/typing/untypeast.ml ../ocaml/typing/untypeast.mli ../ocaml/utils/arg_helper.ml ../ocaml/utils/arg_helper.mli ../ocaml/utils/ccomp.ml ../ocaml/utils/ccomp.mli ../ocaml/utils/clflags.ml ../ocaml/utils/clflags.mli ../ocaml/utils/consistbl.ml ../ocaml/utils/consistbl.mli ../ocaml/utils/identifiable.ml ../ocaml/utils/identifiable.mli ../ocaml/utils/misc.ml ../ocaml/utils/misc.mli ../ocaml/utils/numbers.ml ../ocaml/utils/numbers.mli ../ocaml/utils/profile.ml ../ocaml/utils/profile.mli ../ocaml/utils/tbl.ml ../ocaml/utils/tbl.mli ../ocaml/utils/warnings.ml ../ocaml/utils/warnings.mli ./common/bs_loc.ml ./common/bs_loc.mli ./common/bs_version.ml ./common/bs_version.mli ./common/bs_warnings.ml ./common/bs_warnings.mli ./common/ext_log.ml ./common/ext_log.mli ./common/js_config.ml ./common/js_config.mli ./common/lam_methname.ml ./common/lam_methname.mli ./core/bs_cmi_load.ml ./core/bs_conditional_initial.ml ./core/bs_conditional_initial.mli ./core/compile_rec_module.ml ./core/config_util.ml ./core/config_util.mli ./core/config_whole_compiler.ml ./core/config_whole_compiler.mli ./core/j.ml ./core/js_analyzer.ml ./core/js_analyzer.mli ./core/js_arr.ml ./core/js_arr.mli ./core/js_ast_util.ml ./core/js_ast_util.mli ./core/js_block_runtime.ml ./core/js_block_runtime.mli ./core/js_call_info.ml ./core/js_call_info.mli ./core/js_closure.ml ./core/js_closure.mli ./core/js_cmj_format.ml ./core/js_cmj_format.mli ./core/js_cmj_load.ml ./core/js_cmj_load.mli ./core/js_cmj_load_builtin_unit.ml ./core/js_dump.ml ./core/js_dump.mli ./core/js_dump_import_export.ml ./core/js_dump_import_export.mli ./core/js_dump_lit.ml ./core/js_dump_program.ml ./core/js_dump_program.mli ./core/js_dump_property.ml ./core/js_dump_property.mli ./core/js_dump_string.ml ./core/js_dump_string.mli ./core/js_exp_make.ml ./core/js_exp_make.mli ./core/js_fold.ml ./core/js_fold_basic.ml ./core/js_fold_basic.mli ./core/js_fun_env.ml ./core/js_fun_env.mli ./core/js_long.ml ./core/js_long.mli ./core/js_map.ml ./core/js_name_of_module_id.ml ./core/js_name_of_module_id.mli ./core/js_number.ml ./core/js_number.mli ./core/js_of_lam_array.ml ./core/js_of_lam_array.mli ./core/js_of_lam_block.ml ./core/js_of_lam_block.mli ./core/js_of_lam_exception.ml ./core/js_of_lam_exception.mli ./core/js_of_lam_option.ml ./core/js_of_lam_option.mli ./core/js_of_lam_string.ml ./core/js_of_lam_string.mli ./core/js_of_lam_variant.ml ./core/js_of_lam_variant.mli ./core/js_op.ml ./core/js_op_util.ml ./core/js_op_util.mli ./core/js_output.ml ./core/js_output.mli ./core/js_packages_info.ml ./core/js_packages_info.mli ./core/js_packages_state.ml ./core/js_packages_state.mli ./core/js_pass_debug.ml ./core/js_pass_debug.mli ./core/js_pass_flatten.ml ./core/js_pass_flatten.mli ./core/js_pass_flatten_and_mark_dead.ml ./core/js_pass_flatten_and_mark_dead.mli ./core/js_pass_get_used.ml ./core/js_pass_get_used.mli ./core/js_pass_scope.ml ./core/js_pass_scope.mli ./core/js_pass_tailcall_inline.ml ./core/js_pass_tailcall_inline.mli ./core/js_raw_info.ml ./core/js_shake.ml ./core/js_shake.mli ./core/js_stmt_make.ml ./core/js_stmt_make.mli ./core/lam.ml ./core/lam.mli ./core/lam_analysis.ml ./core/lam_analysis.mli ./core/lam_arity.ml ./core/lam_arity.mli ./core/lam_arity_analysis.ml ./core/lam_arity_analysis.mli ./core/lam_beta_reduce.ml ./core/lam_beta_reduce.mli ./core/lam_beta_reduce_util.ml ./core/lam_beta_reduce_util.mli ./core/lam_bounded_vars.ml ./core/lam_bounded_vars.mli ./core/lam_closure.ml ./core/lam_closure.mli ./core/lam_coercion.ml ./core/lam_coercion.mli ./core/lam_compat.ml ./core/lam_compat.mli ./core/lam_compile.ml ./core/lam_compile.mli ./core/lam_compile_const.ml ./core/lam_compile_const.mli ./core/lam_compile_context.ml ./core/lam_compile_context.mli ./core/lam_compile_env.ml ./core/lam_compile_env.mli ./core/lam_compile_external_call.ml ./core/lam_compile_external_call.mli ./core/lam_compile_external_obj.ml ./core/lam_compile_external_obj.mli ./core/lam_compile_main.ml ./core/lam_compile_main.mli ./core/lam_compile_primitive.ml ./core/lam_compile_primitive.mli ./core/lam_compile_util.ml ./core/lam_compile_util.mli ./core/lam_constant.ml ./core/lam_constant.mli ./core/lam_constant_convert.ml ./core/lam_constant_convert.mli ./core/lam_convert.ml ./core/lam_convert.mli ./core/lam_dce.ml ./core/lam_dce.mli ./core/lam_dispatch_primitive.ml ./core/lam_dispatch_primitive.mli ./core/lam_eta_conversion.ml ./core/lam_eta_conversion.mli ./core/lam_exit_code.ml ./core/lam_exit_code.mli ./core/lam_exit_count.ml ./core/lam_exit_count.mli ./core/lam_free_variables.ml ./core/lam_free_variables.mli ./core/lam_group.ml ./core/lam_group.mli ./core/lam_hit.ml ./core/lam_hit.mli ./core/lam_id_kind.ml ./core/lam_id_kind.mli ./core/lam_iter.ml ./core/lam_iter.mli ./core/lam_module_ident.ml ./core/lam_module_ident.mli ./core/lam_pass_alpha_conversion.ml ./core/lam_pass_alpha_conversion.mli ./core/lam_pass_collect.ml ./core/lam_pass_collect.mli ./core/lam_pass_count.ml ./core/lam_pass_count.mli ./core/lam_pass_deep_flatten.ml ./core/lam_pass_deep_flatten.mli ./core/lam_pass_eliminate_ref.ml ./core/lam_pass_eliminate_ref.mli ./core/lam_pass_exits.ml ./core/lam_pass_exits.mli ./core/lam_pass_lets_dce.ml ./core/lam_pass_lets_dce.mli ./core/lam_pass_remove_alias.ml ./core/lam_pass_remove_alias.mli ./core/lam_pointer_info.ml ./core/lam_pointer_info.mli ./core/lam_primitive.ml ./core/lam_primitive.mli ./core/lam_print.ml ./core/lam_print.mli ./core/lam_scc.ml ./core/lam_scc.mli ./core/lam_stats.ml ./core/lam_stats.mli ./core/lam_stats_export.ml ./core/lam_stats_export.mli ./core/lam_subst.ml ./core/lam_subst.mli ./core/lam_tag_info.ml ./core/lam_util.ml ./core/lam_util.mli ./core/lam_var_stats.ml ./core/lam_var_stats.mli ./core/matching_polyfill.ml ./core/matching_polyfill.mli ./core/polyvar_pattern_match.ml ./core/record_attributes_check.ml ./core/res_compmisc.ml ./core/res_compmisc.mli ./core/transl_single_field_record.ml ./depends/bs_exception.ml ./depends/bs_exception.mli ./ext/bsc_args.ml ./ext/bsc_args.mli ./ext/bsc_warnings.ml ./ext/ext_array.ml ./ext/ext_array.mli ./ext/ext_buffer.ml ./ext/ext_buffer.mli ./ext/ext_bytes.ml ./ext/ext_bytes.mli ./ext/ext_char.ml ./ext/ext_char.mli ./ext/ext_digest.ml ./ext/ext_digest.mli ./ext/ext_filename.ml ./ext/ext_filename.mli ./ext/ext_fmt.ml ./ext/ext_ident.ml ./ext/ext_ident.mli ./ext/ext_int.ml ./ext/ext_int.mli ./ext/ext_io.ml ./ext/ext_io.mli ./ext/ext_js_file_kind.ml ./ext/ext_js_suffix.ml ./ext/ext_list.ml ./ext/ext_list.mli ./ext/ext_marshal.ml ./ext/ext_marshal.mli ./ext/ext_modulename.ml ./ext/ext_modulename.mli ./ext/ext_namespace.ml ./ext/ext_namespace.mli ./ext/ext_option.ml ./ext/ext_option.mli ./ext/ext_path.ml ./ext/ext_path.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli ./ext/ext_pp.ml ./ext/ext_pp.mli ./ext/ext_pp_scope.ml ./ext/ext_pp_scope.mli ./ext/ext_ref.ml ./ext/ext_ref.mli ./ext/ext_scc.ml ./ext/ext_scc.mli ./ext/ext_spec.ml ./ext/ext_spec.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_string_array.ml ./ext/ext_string_array.mli ./ext/ext_sys.ml ./ext/ext_sys.mli ./ext/ext_utf8.ml ./ext/ext_utf8.mli ./ext/ext_util.ml ./ext/ext_util.mli ./ext/hash.ml ./ext/hash.mli ./ext/hash_gen.ml ./ext/hash_ident.ml ./ext/hash_ident.mli ./ext/hash_int.ml ./ext/hash_int.mli ./ext/hash_set.ml ./ext/hash_set.mli ./ext/hash_set_gen.ml ./ext/hash_set_ident.ml ./ext/hash_set_ident.mli ./ext/hash_set_ident_mask.ml ./ext/hash_set_ident_mask.mli ./ext/hash_set_poly.ml ./ext/hash_set_poly.mli ./ext/hash_set_string.ml ./ext/hash_set_string.mli ./ext/hash_string.ml ./ext/hash_string.mli ./ext/int_vec_util.ml ./ext/int_vec_util.mli ./ext/int_vec_vec.ml ./ext/int_vec_vec.mli ./ext/js_reserved_map.ml ./ext/js_reserved_map.mli ./ext/js_runtime_modules.ml ./ext/literals.ml ./ext/map_gen.ml ./ext/map_gen.mli ./ext/map_ident.ml ./ext/map_ident.mli ./ext/map_int.ml ./ext/map_int.mli ./ext/map_string.ml ./ext/map_string.mli ./ext/ordered_hash_map_gen.ml ./ext/ordered_hash_map_local_ident.ml ./ext/ordered_hash_map_local_ident.mli ./ext/set_gen.ml ./ext/set_gen.mli ./ext/set_ident.ml ./ext/set_ident.mli ./ext/set_string.ml ./ext/set_string.mli ./ext/vec.ml ./ext/vec.mli ./ext/vec_gen.ml ./ext/vec_int.ml ./ext/vec_int.mli ./js_parser/declaration_parser.ml ./js_parser/enum_common.ml ./js_parser/enum_parser.ml ./js_parser/expression_parser.ml ./js_parser/file_key.ml ./js_parser/flow_ast.ml ./js_parser/flow_ast_utils.ml ./js_parser/flow_ast_utils.mli ./js_parser/flow_lexer.ml ./js_parser/flow_lexer.mli ./js_parser/jsx_parser.ml ./js_parser/lex_env.ml ./js_parser/lex_result.ml ./js_parser/loc.ml ./js_parser/loc.mli ./js_parser/object_parser.ml ./js_parser/parse_error.ml ./js_parser/parser_common.ml ./js_parser/parser_env.ml ./js_parser/parser_env.mli ./js_parser/parser_flow.ml ./js_parser/pattern_cover.ml ./js_parser/pattern_parser.ml ./js_parser/sedlexing.ml ./js_parser/sedlexing.mli ./js_parser/statement_parser.ml ./js_parser/token.ml ./js_parser/type_parser.ml ./js_parser/wtf8.ml ./js_parser/wtf8.mli ./main/builtin_cmi_datasets.ml ./main/builtin_cmi_datasets.mli ./main/builtin_cmj_datasets.ml ./main/builtin_cmj_datasets.mli ./main/jsoo_common.ml ./main/jsoo_common.mli ./napkin/reactjs_jsx_ppx_v3.ml ./napkin/reactjs_jsx_ppx_v3.mli ./outcome_printer/outcome_printer_ns.ml ./outcome_printer/outcome_printer_ns.mli ./refmt/jsoo_refmt_main.ml ./refmt/jsoo_refmt_main.mli ./refmt/refmt_api.ml ./stubs/bs_hash_stubs.ml ./super_errors/super_env.ml ./super_errors/super_location.ml ./super_errors/super_location.mli ./super_errors/super_main.ml ./super_errors/super_misc.ml ./super_errors/super_misc.mli ./super_errors/super_pparse.ml ./super_errors/super_typecore.ml ./super_errors/super_typemod.ml ./super_errors/super_typetexp.ml ./syntax/ast_attributes.ml ./syntax/ast_attributes.mli ./syntax/ast_bs_open.ml ./syntax/ast_bs_open.mli ./syntax/ast_comb.ml ./syntax/ast_comb.mli ./syntax/ast_compatible.ml ./syntax/ast_compatible.mli ./syntax/ast_config.ml ./syntax/ast_config.mli ./syntax/ast_core_type.ml ./syntax/ast_core_type.mli ./syntax/ast_core_type_class_type.ml ./syntax/ast_core_type_class_type.mli ./syntax/ast_derive.ml ./syntax/ast_derive.mli ./syntax/ast_derive_abstract.ml ./syntax/ast_derive_abstract.mli ./syntax/ast_derive_js_mapper.ml ./syntax/ast_derive_js_mapper.mli ./syntax/ast_derive_projector.ml ./syntax/ast_derive_projector.mli ./syntax/ast_derive_util.ml ./syntax/ast_derive_util.mli ./syntax/ast_exp.ml ./syntax/ast_exp.mli ./syntax/ast_exp_apply.ml ./syntax/ast_exp_apply.mli ./syntax/ast_exp_extension.ml ./syntax/ast_exp_extension.mli ./syntax/ast_exp_handle_external.ml ./syntax/ast_exp_handle_external.mli ./syntax/ast_external.ml ./syntax/ast_external.mli ./syntax/ast_external_mk.ml ./syntax/ast_external_mk.mli ./syntax/ast_external_process.ml ./syntax/ast_external_process.mli ./syntax/ast_literal.ml ./syntax/ast_literal.mli ./syntax/ast_open_cxt.ml ./syntax/ast_open_cxt.mli ./syntax/ast_pat.ml ./syntax/ast_pat.mli ./syntax/ast_payload.ml ./syntax/ast_payload.mli ./syntax/ast_polyvar.ml ./syntax/ast_polyvar.mli ./syntax/ast_reason_pp.ml ./syntax/ast_reason_pp.mli ./syntax/ast_signature.ml ./syntax/ast_signature.mli ./syntax/ast_structure.ml ./syntax/ast_structure.mli ./syntax/ast_tdcls.ml ./syntax/ast_tdcls.mli ./syntax/ast_tuple_pattern_flatten.ml ./syntax/ast_tuple_pattern_flatten.mli ./syntax/ast_typ_uncurry.ml ./syntax/ast_typ_uncurry.mli ./syntax/ast_uncurry_apply.ml ./syntax/ast_uncurry_apply.mli ./syntax/ast_uncurry_gen.ml ./syntax/ast_uncurry_gen.mli ./syntax/ast_utf8_string.ml ./syntax/ast_utf8_string.mli ./syntax/ast_utf8_string_interp.ml ./syntax/ast_utf8_string_interp.mli ./syntax/ast_util.ml ./syntax/ast_util.mli ./syntax/bs_ast_invariant.ml ./syntax/bs_ast_invariant.mli ./syntax/bs_ast_mapper.ml ./syntax/bs_ast_mapper.mli ./syntax/bs_builtin_ppx.ml ./syntax/bs_builtin_ppx.mli ./syntax/bs_flow_ast_utils.ml ./syntax/bs_flow_ast_utils.mli ./syntax/bs_syntaxerr.ml ./syntax/bs_syntaxerr.mli ./syntax/classify_function.ml ./syntax/classify_function.mli ./syntax/external_arg_spec.ml ./syntax/external_arg_spec.mli ./syntax/external_ffi_types.ml ./syntax/external_ffi_types.mli ./syntax/ppx_entry.ml ./syntax/typemod_hide.ml \ No newline at end of file diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 44894a571a..9fb532eb16 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -411165,16 +411165,14 @@ let mapper : mapper = end -module Reactjs_jsx_ppx_v3 -= struct -#1 "reactjs_jsx_ppx_v3.ml" -# 1 "syntax/reactjs_jsx_ppx.cppo.ml" +module Reactjs_jsx_ppx_v3 : sig +#1 "reactjs_jsx_ppx_v3.mli" (* - This is the file that handles turning Reason JSX' agnostic function call into + This is the module that handles turning Reason JSX' agnostic function call into a ReasonReact-specific function call. Aka, this is a macro, using OCaml's ppx facilities; https://whitequark.org/blog/2014/04/16/a-guide-to-extension- points-in-ocaml/ - You wouldn't use this file directly; it's used by BuckleScript's + You wouldn't use this file directly; it's used by ReScript's bsconfig.json. Specifically, there's a field called `react-jsx` inside the field `reason`, which enables this ppx through some internal call in bsb *) @@ -411205,49 +411203,46 @@ module Reactjs_jsx_ppx_v3 `ReactDOMRe.createElement(ReasonReact.fragment, [|foo|])` *) +val rewrite_implementation : Parsetree.structure -> Parsetree.structure + +val rewrite_signature : Parsetree.signature -> Parsetree.signature + +end = struct +#1 "reactjs_jsx_ppx_v3.ml" open Ast_helper open Ast_mapper open Asttypes open Parsetree open Longident -let rec find_opt p = function - | [] -> None - | x :: l -> if p x then Some x else find_opt p l - - +let rec find_opt p = function [] -> None | x :: l -> if p x then Some x else find_opt p l let nolabel = Nolabel + let labelled str = Labelled str + let optional str = Optional str -let isOptional str = match str with -| Optional _ -> true -| _ -> false -let isLabelled str = match str with -| Labelled _ -> true -| _ -> false -let getLabel str = match str with -| Optional str | Labelled str -> str -| Nolabel -> "" + +let isOptional str = match str with Optional _ -> true | _ -> false + +let isLabelled str = match str with Labelled _ -> true | _ -> false + +let getLabel str = match str with Optional str | Labelled str -> str | Nolabel -> "" + let optionIdent = Lident "option" -let argIsKeyRef = function - | (Labelled ("key" | "ref"), _) | (Optional ("key" | "ref"), _) -> true - | _ -> false let constantString ~loc str = Ast_helper.Exp.constant ~loc (Pconst_string (str, None)) - let safeTypeFromValue valueStr = -let valueStr = getLabel valueStr in -match String.sub valueStr 0 1 with -| "_" -> "T" ^ valueStr -| _ -> valueStr -let keyType loc = Typ.constr ~loc {loc; txt=optionIdent} [Typ.constr ~loc {loc; txt=Lident "string"} []] - -type 'a children = | ListLiteral of 'a | Exact of 'a -type componentConfig = { - propsName: string; -} + let valueStr = getLabel valueStr in + match String.sub valueStr 0 1 with "_" -> "T" ^ valueStr | _ -> valueStr + [@@raises Invalid_argument] + +let keyType loc = Typ.constr ~loc { loc; txt = optionIdent } [ Typ.constr ~loc { loc; txt = Lident "string" } [] ] + +type 'a children = ListLiteral of 'a | Exact of 'a + +type componentConfig = { propsName : string } (* if children is a list, convert it to an array while mapping each element. If not, just map over it, as usual *) let transformChildrenIfListUpper ~loc ~mapper theList = @@ -411255,16 +411250,12 @@ let transformChildrenIfListUpper ~loc ~mapper theList = (* not in the sense of converting a list to an array; convert the AST reprensentation of a list to the AST reprensentation of an array *) match theList with - | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> begin - match accum with - | [singleElement] -> Exact singleElement - | accum -> ListLiteral (List.rev accum |> Exp.array ~loc) - end - | {pexp_desc = Pexp_construct ( - {txt = Lident "::"}, - Some {pexp_desc = Pexp_tuple (v::acc::[])} - )} -> - transformChildren_ acc ((mapper.expr mapper v)::accum) + | { pexp_desc = Pexp_construct ({ txt = Lident "[]" }, None) } -> ( + match accum with + | [ singleElement ] -> Exact singleElement + | accum -> ListLiteral (Exp.array ~loc (List.rev accum)) ) + | { pexp_desc = Pexp_construct ({ txt = Lident "::" }, Some { pexp_desc = Pexp_tuple [ v; acc ] }) } -> + transformChildren_ acc (mapper.expr mapper v :: accum) | notAList -> Exact (mapper.expr mapper notAList) in transformChildren_ theList [] @@ -411274,114 +411265,103 @@ let transformChildrenIfList ~loc ~mapper theList = (* not in the sense of converting a list to an array; convert the AST reprensentation of a list to the AST reprensentation of an array *) match theList with - | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> - List.rev accum |> Exp.array ~loc - | {pexp_desc = Pexp_construct ( - {txt = Lident "::"}, - Some {pexp_desc = Pexp_tuple (v::acc::[])} - )} -> - transformChildren_ acc ((mapper.expr mapper v)::accum) + | { pexp_desc = Pexp_construct ({ txt = Lident "[]" }, None) } -> Exp.array ~loc (List.rev accum) + | { pexp_desc = Pexp_construct ({ txt = Lident "::" }, Some { pexp_desc = Pexp_tuple [ v; acc ] }) } -> + transformChildren_ acc (mapper.expr mapper v :: accum) | notAList -> mapper.expr mapper notAList in transformChildren_ theList [] -let extractChildren ?(removeLastPositionUnit=false) ~loc propsAndChildren = - let rec allButLast_ lst acc = match lst with +let extractChildren ?(removeLastPositionUnit = false) ~loc propsAndChildren = + let rec allButLast_ lst acc = + match lst with | [] -> [] - | (Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})::[] -> acc + | [ (Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) }) ] -> acc | (Nolabel, _) :: _rest -> raise (Invalid_argument "JSX: found non-labelled argument before the last position") - | arg::rest -> allButLast_ rest (arg::acc) + | arg :: rest -> allButLast_ rest (arg :: acc) + [@@raises Invalid_argument] in - let allButLast lst = allButLast_ lst [] |> List.rev in - match (List.partition (fun (label, _) -> label = labelled "children") propsAndChildren) with - | ([], props) -> - (* no children provided? Place a placeholder list *) - (Exp.construct ~loc {loc; txt = Lident "[]"} None, if removeLastPositionUnit then allButLast props else props) - | ([(_, childrenExpr)], props) -> - (childrenExpr, if removeLastPositionUnit then allButLast props else props) + let allButLast lst = allButLast_ lst [] |> List.rev [@@raises Invalid_argument] in + match List.partition (fun (label, _) -> label = labelled "children") propsAndChildren with + | [], props -> + (* no children provided? Place a placeholder list *) + (Exp.construct ~loc { loc; txt = Lident "[]" } None, if removeLastPositionUnit then allButLast props else props) + | [ (_, childrenExpr) ], props -> (childrenExpr, if removeLastPositionUnit then allButLast props else props) | _ -> raise (Invalid_argument "JSX: somehow there's more than one `children` label") + [@@raises Invalid_argument] -let unerasableIgnore loc = ({loc; txt = "warning"}, (PStr [Str.eval (Exp.constant (Pconst_string ("-16", None)))])) -let merlinFocus = ({loc = Location.none; txt = "merlin.focus"}, (PStr [])) +let unerasableIgnore loc = ({ loc; txt = "warning" }, PStr [ Str.eval (Exp.constant (Pconst_string ("-16", None))) ]) + +let merlinFocus = ({ loc = Location.none; txt = "merlin.focus" }, PStr []) (* Helper method to look up the [@react.component] attribute *) -let hasAttr (loc, _) = - loc.txt = "react.component" +let hasAttr (loc, _) = loc.txt = "react.component" (* Helper method to filter out any attribute that isn't [@react.component] *) -let otherAttrsPure (loc, _) = - loc.txt <> "react.component" +let otherAttrsPure (loc, _) = loc.txt <> "react.component" (* Iterate over the attributes and try to find the [@react.component] attribute *) -let hasAttrOnBinding {pvb_attributes} = find_opt hasAttr pvb_attributes <> None - -(* Filter the [@react.component] attribute and immutably replace them on the binding *) -let filterAttrOnBinding binding = {binding with pvb_attributes = List.filter otherAttrsPure binding.pvb_attributes} +let hasAttrOnBinding { pvb_attributes } = find_opt hasAttr pvb_attributes <> None (* Finds the name of the variable the binding is assigned to, otherwise raises Invalid_argument *) let getFnName binding = match binding with - | {pvb_pat = { - ppat_desc = Ppat_var {txt} - }} -> txt + | { pvb_pat = { ppat_desc = Ppat_var { txt } } } -> txt | _ -> raise (Invalid_argument "react.component calls cannot be destructured.") + [@@raises Invalid_argument] let makeNewBinding binding expression newName = match binding with - | {pvb_pat = { - ppat_desc = Ppat_var ( ppat_var) - } as pvb_pat} ->{ binding with pvb_pat = { - pvb_pat with - ppat_desc = Ppat_var {ppat_var with txt = newName}; - }; - pvb_expr = expression; - pvb_attributes = [merlinFocus]; - } + | { pvb_pat = { ppat_desc = Ppat_var ppat_var } as pvb_pat } -> + { + binding with + pvb_pat = { pvb_pat with ppat_desc = Ppat_var { ppat_var with txt = newName } }; + pvb_expr = expression; + pvb_attributes = [ merlinFocus ]; + } | _ -> raise (Invalid_argument "react.component calls cannot be destructured.") + [@@raises Invalid_argument] (* Lookup the value of `props` otherwise raise Invalid_argument error *) let getPropsNameValue _acc (loc, exp) = - match (loc, exp) with - | ({ txt = Lident "props" }, { pexp_desc = Pexp_ident {txt = Lident str} }) -> { propsName = str } - | ({ txt }, _) -> raise (Invalid_argument ("react.component only accepts props as an option, given: " ^ Longident.last txt)) + match (loc, exp) with + | { txt = Lident "props" }, { pexp_desc = Pexp_ident { txt = Lident str } } -> { propsName = str } + | { txt }, _ -> + raise (Invalid_argument ("react.component only accepts props as an option, given: " ^ Longident.last txt)) + [@@raises Invalid_argument] (* Lookup the `props` record or string as part of [@react.component] and store the name for use when rewriting *) let getPropsAttr payload = - let defaultProps = {propsName = "Props"} in + let defaultProps = { propsName = "Props" } in match payload with - | Some(PStr( - {pstr_desc = Pstr_eval ({ - pexp_desc = Pexp_record (recordFields, None) - }, _)}::_rest - )) -> + | Some (PStr ({ pstr_desc = Pstr_eval ({ pexp_desc = Pexp_record (recordFields, None) }, _) } :: _rest)) -> List.fold_left getPropsNameValue defaultProps recordFields - | Some(PStr({pstr_desc = Pstr_eval ({pexp_desc = Pexp_ident {txt = Lident "props"}}, _)}::_rest)) -> {propsName = "props"} - | Some(PStr({pstr_desc = Pstr_eval (_, _)}::_rest)) -> raise (Invalid_argument ("react.component accepts a record config with props as an options.")) + | Some (PStr ({ pstr_desc = Pstr_eval ({ pexp_desc = Pexp_ident { txt = Lident "props" } }, _) } :: _rest)) -> + { propsName = "props" } + | Some (PStr ({ pstr_desc = Pstr_eval (_, _) } :: _rest)) -> + raise (Invalid_argument "react.component accepts a record config with props as an options.") | _ -> defaultProps + [@@raises Invalid_argument] (* Plucks the label, loc, and type_ from an AST node *) let pluckLabelDefaultLocType (label, default, _, _, loc, type_) = (label, default, loc, type_) (* Lookup the filename from the location information on the AST node and turn it into a valid module identifier *) -let filenameFromLoc (pstr_loc: Location.t) = - let fileName = match pstr_loc.loc_start.pos_fname with - | "" -> !Location.input_name - | fileName -> fileName - in - let fileName = try - Filename.chop_extension (Filename.basename fileName) - with | Invalid_argument _-> fileName in +let filenameFromLoc (pstr_loc : Location.t) = + let fileName = match pstr_loc.loc_start.pos_fname with "" -> !Location.input_name | fileName -> fileName in + let fileName = try Filename.chop_extension (Filename.basename fileName) with Invalid_argument _ -> fileName in let fileName = String.capitalize_ascii fileName in fileName (* Build a string representation of a module name with segments separated by $ *) let makeModuleName fileName nestedModules fnName = - let fullModuleName = match (fileName, nestedModules, fnName) with - (* TODO: is this even reachable? It seems like the fileName always exists *) - | ("", nestedModules, "make") -> nestedModules - | ("", nestedModules, fnName) -> List.rev (fnName :: nestedModules) - | (fileName, nestedModules, "make") -> fileName :: (List.rev nestedModules) - | (fileName, nestedModules, fnName) -> fileName :: (List.rev (fnName :: nestedModules)) + let fullModuleName = + match (fileName, nestedModules, fnName) with + (* TODO: is this even reachable? It seems like the fileName always exists *) + | "", nestedModules, "make" -> nestedModules + | "", nestedModules, fnName -> List.rev (fnName :: nestedModules) + | fileName, nestedModules, "make" -> fileName :: List.rev nestedModules + | fileName, nestedModules, fnName -> fileName :: List.rev (fnName :: nestedModules) in let fullModuleName = String.concat "$" fullModuleName in fullModuleName @@ -411395,202 +411375,167 @@ let makeModuleName fileName nestedModules fnName = (* Build an AST node representing all named args for the `external` definition for a component's props *) let rec recursivelyMakeNamedArgsForExternal list args = match list with - | (label, default, loc, interiorType)::tl -> - recursivelyMakeNamedArgsForExternal tl (Typ.arrow - ~loc - label - (match (label, interiorType, default) with - (* ~foo=1 *) - | (label, None, Some _) -> - { - ptyp_desc = Ptyp_var (safeTypeFromValue label); - ptyp_loc = loc; - ptyp_attributes = []; - } - (* ~foo: int=1 *) - | (_label, Some type_, Some _) -> - type_ - - (* ~foo: option(int)=? *) - | (label, Some ({ptyp_desc = Ptyp_constr ({txt=(Lident "option")}, [type_])}), _) - | (label, Some ({ptyp_desc = Ptyp_constr ({txt=(Ldot (Lident "*predef*", "option"))}, [type_])}), _) - (* ~foo: int=? - note this isnt valid. but we want to get a type error *) - | (label, Some type_, _) when isOptional label -> - type_ - (* ~foo=? *) - | (label, None, _) when isOptional label -> - { - ptyp_desc = Ptyp_var (safeTypeFromValue label); - ptyp_loc = loc; - ptyp_attributes = []; - } - - (* ~foo *) - | (label, None, _) -> - { - ptyp_desc = Ptyp_var (safeTypeFromValue label); - ptyp_loc = loc; - ptyp_attributes = []; - } - | (_label, Some type_, _) -> - type_ - ) - args) + | (label, default, loc, interiorType) :: tl -> + recursivelyMakeNamedArgsForExternal tl + (Typ.arrow ~loc label + ( match (label, interiorType, default) with + (* ~foo=1 *) + | label, None, Some _ -> + { ptyp_desc = Ptyp_var (safeTypeFromValue label); ptyp_loc = loc; ptyp_attributes = [] } + (* ~foo: int=1 *) + | _label, Some type_, Some _ -> type_ + (* ~foo: option(int)=? *) + | label, Some { ptyp_desc = Ptyp_constr ({ txt = Lident "option" }, [ type_ ]) }, _ + | label, Some { ptyp_desc = Ptyp_constr ({ txt = Ldot (Lident "*predef*", "option") }, [ type_ ]) }, _ + (* ~foo: int=? - note this isnt valid. but we want to get a type error *) + | label, Some type_, _ + when isOptional label -> + type_ + (* ~foo=? *) + | label, None, _ when isOptional label -> + { ptyp_desc = Ptyp_var (safeTypeFromValue label); ptyp_loc = loc; ptyp_attributes = [] } + (* ~foo *) + | label, None, _ -> { ptyp_desc = Ptyp_var (safeTypeFromValue label); ptyp_loc = loc; ptyp_attributes = [] } + | _label, Some type_, _ -> type_ ) + args) | [] -> args + [@@raises Invalid_argument] (* Build an AST node for the [@bs.obj] representing props for a component *) let makePropsValue fnName loc namedArgListWithKeyAndRef propsType = - let propsName = fnName ^ "Props" in { - pval_name = {txt = propsName; loc}; - pval_type = - recursivelyMakeNamedArgsForExternal - namedArgListWithKeyAndRef - (Typ.arrow - nolabel - { - ptyp_desc = Ptyp_constr ({txt= Lident("unit"); loc}, []); - ptyp_loc = loc; - ptyp_attributes = []; - } - propsType - ); - pval_prim = [""]; - pval_attributes = [({txt = "bs.obj"; loc = loc}, PStr [])]; - pval_loc = loc; -} + let propsName = fnName ^ "Props" in + { + pval_name = { txt = propsName; loc }; + pval_type = + recursivelyMakeNamedArgsForExternal namedArgListWithKeyAndRef + (Typ.arrow nolabel + { ptyp_desc = Ptyp_constr ({ txt = Lident "unit"; loc }, []); ptyp_loc = loc; ptyp_attributes = [] } + propsType); + pval_prim = [ "" ]; + pval_attributes = [ ({ txt = "bs.obj"; loc }, PStr []) ]; + pval_loc = loc; + } + [@@raises Invalid_argument] (* Build an AST node representing an `external` with the definition of the [@bs.obj] *) let makePropsExternal fnName loc namedArgListWithKeyAndRef propsType = - { - pstr_loc = loc; - pstr_desc = Pstr_primitive (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) - } + { pstr_loc = loc; pstr_desc = Pstr_primitive (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) } + [@@raises Invalid_argument] (* Build an AST node for the signature of the `external` definition *) let makePropsExternalSig fnName loc namedArgListWithKeyAndRef propsType = - { - psig_loc = loc; - psig_desc = Psig_value (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) - } + { psig_loc = loc; psig_desc = Psig_value (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) } + [@@raises Invalid_argument] (* Build an AST node for the props name when converted to a Js.t inside the function signature *) -let makePropsName ~loc name = - { - ppat_desc = Ppat_var {txt = name; loc}; - ppat_loc = loc; - ppat_attributes = []; - } - - -let makeObjectField loc (str, attrs, type_) = - Otag ({ loc; txt = str }, attrs, type_) +let makePropsName ~loc name = { ppat_desc = Ppat_var { txt = name; loc }; ppat_loc = loc; ppat_attributes = [] } +let makeObjectField loc (str, attrs, type_) = Otag ({ loc; txt = str }, attrs, type_) (* Build an AST node representing a "closed" Js.t object representing a component's props *) let makePropsType ~loc namedTypeList = - Typ.mk ~loc ( - Ptyp_constr({txt= Ldot (Lident("Js"), "t"); loc}, [{ - ptyp_desc = Ptyp_object( - List.map (makeObjectField loc) namedTypeList, - Closed - ); - ptyp_loc = loc; - ptyp_attributes = []; - }]) - ) + Typ.mk ~loc + (Ptyp_constr + ( { txt = Ldot (Lident "Js", "t"); loc }, + [ + { + ptyp_desc = Ptyp_object (List.map (makeObjectField loc) namedTypeList, Closed); + ptyp_loc = loc; + ptyp_attributes = []; + }; + ] )) (* Builds an AST node for the entire `external` definition of props *) let makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList = - makePropsExternal - fnName - loc + makePropsExternal fnName loc (List.map pluckLabelDefaultLocType namedArgListWithKeyAndRef) (makePropsType ~loc namedTypeList) + [@@raises Invalid_argument] (* TODO: some line number might still be wrong *) let jsxMapper () = - let jsxVersion = ref None in let transformUppercaseCall3 modulePath mapper loc attrs _ callArguments = - let (children, argsWithLabels) = extractChildren ~loc ~removeLastPositionUnit:true callArguments in + let children, argsWithLabels = extractChildren ~loc ~removeLastPositionUnit:true callArguments in let argsForMake = argsWithLabels in let childrenExpr = transformChildrenIfListUpper ~loc ~mapper children in - let recursivelyTransformedArgsForMake = argsForMake |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) in + let recursivelyTransformedArgsForMake = + argsForMake |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) + in let childrenArg = ref None in - let args = recursivelyTransformedArgsForMake - @ (match childrenExpr with - | Exact children -> [(labelled "children", children)] - | ListLiteral ({ pexp_desc = Pexp_array list }) when list = [] -> [] + let args = + recursivelyTransformedArgsForMake + @ ( match childrenExpr with + | Exact children -> [ (labelled "children", children) ] + | ListLiteral { pexp_desc = Pexp_array list } when list = [] -> [] | ListLiteral expression -> - (* this is a hack to support react components that introspect into their children *) - (childrenArg := Some expression; - [(labelled "children", Exp.ident ~loc {loc; txt = Ldot (Lident "React", "null")})])) - @ [(nolabel, Exp.construct ~loc {loc; txt = Lident "()"} None)] in - let isCap str = let first = String.sub str 0 1 in - let capped = String.uppercase_ascii first in first = capped in - let ident = match modulePath with - | Lident _ -> Ldot (modulePath, "make") - | (Ldot (_modulePath, value) as fullPath) when isCap value -> Ldot (fullPath, "make") - | modulePath -> modulePath in - let propsIdent = match ident with - | Lident path -> Lident (path ^ "Props") - | Ldot(ident, path) -> Ldot (ident, path ^ "Props") - | _ -> raise (Invalid_argument "JSX name can't be the result of function applications") in - let props = - Exp.apply ~attrs ~loc (Exp.ident ~loc {loc; txt = propsIdent}) args in + (* this is a hack to support react components that introspect into their children *) + childrenArg := Some expression; + [ (labelled "children", Exp.ident ~loc { loc; txt = Ldot (Lident "React", "null") }) ] ) + @ [ (nolabel, Exp.construct ~loc { loc; txt = Lident "()" } None) ] + in + let isCap str = + let first = String.sub str 0 1 [@@raises Invalid_argument] in + let capped = String.uppercase_ascii first in + first = capped + [@@raises Invalid_argument] + in + let ident = + match modulePath with + | Lident _ -> Ldot (modulePath, "make") + | Ldot (_modulePath, value) as fullPath when isCap value -> Ldot (fullPath, "make") + | modulePath -> modulePath + in + let propsIdent = + match ident with + | Lident path -> Lident (path ^ "Props") + | Ldot (ident, path) -> Ldot (ident, path ^ "Props") + | _ -> raise (Invalid_argument "JSX name can't be the result of function applications") + in + let props = Exp.apply ~attrs ~loc (Exp.ident ~loc { loc; txt = propsIdent }) args in (* handle key, ref, children *) - (* React.createElement(Component.make, props, ...children) *) - match (!childrenArg) with + (* React.createElement(Component.make, props, ...children) *) + match !childrenArg with | None -> - (Exp.apply - ~loc - ~attrs - (Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElement")}) - ([ - (nolabel, Exp.ident ~loc {txt = ident; loc}); - (nolabel, props) - ])) - | Some children -> - (Exp.apply - ~loc - ~attrs - (Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElementVariadic")}) - ([ - (nolabel, Exp.ident ~loc {txt = ident; loc}); - (nolabel, props); - (nolabel, children) - ])) - in + Exp.apply ~loc ~attrs + (Exp.ident ~loc { loc; txt = Ldot (Lident "React", "createElement") }) + [ (nolabel, Exp.ident ~loc { txt = ident; loc }); (nolabel, props) ] + | Some children -> + Exp.apply ~loc ~attrs + (Exp.ident ~loc { loc; txt = Ldot (Lident "React", "createElementVariadic") }) + [ (nolabel, Exp.ident ~loc { txt = ident; loc }); (nolabel, props); (nolabel, children) ] + [@@raises Invalid_argument] + in - let transformLowercaseCall3 mapper loc attrs callArguments id = - let (children, nonChildrenProps) = extractChildren ~loc callArguments in - let componentNameExpr = constantString ~loc id in - let childrenExpr = transformChildrenIfList ~loc ~mapper children in - let createElementCall = match children with - (* [@JSX] div(~children=[a]), coming from
a
*) - | { - pexp_desc = - Pexp_construct ({txt = Lident "::"}, Some {pexp_desc = Pexp_tuple _ }) - | Pexp_construct ({txt = Lident "[]"}, None) - } -> "createDOMElementVariadic" - (* [@JSX] div(~children= value), coming from
...(value)
*) - | _ -> raise (Invalid_argument "A spread as a DOM element's \ - children don't make sense written together. You can simply remove the spread.") - in - let args = match nonChildrenProps with - | [_justTheUnitArgumentAtEnd] -> - [ - (* "div" *) - (nolabel, componentNameExpr); - (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] - | nonEmptyProps -> + let transformLowercaseCall3 mapper loc attrs callArguments id = + let children, nonChildrenProps = extractChildren ~loc callArguments in + let componentNameExpr = constantString ~loc id in + let childrenExpr = transformChildrenIfList ~loc ~mapper children in + let createElementCall = + match children with + (* [@JSX] div(~children=[a]), coming from
a
*) + | { + pexp_desc = + ( Pexp_construct ({ txt = Lident "::" }, Some { pexp_desc = Pexp_tuple _ }) + | Pexp_construct ({ txt = Lident "[]" }, None) ); + } -> + "createDOMElementVariadic" + (* [@JSX] div(~children= value), coming from
...(value)
*) + | _ -> + raise + (Invalid_argument + "A spread as a DOM element's children don't make sense written together. You can simply remove the \ + spread.") + in + let args = + match nonChildrenProps with + | [ _justTheUnitArgumentAtEnd ] -> + [ (* "div" *) (nolabel, componentNameExpr); (* [|moreCreateElementCallsHere|] *) (nolabel, childrenExpr) ] + | nonEmptyProps -> let propsCall = - Exp.apply - ~loc - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "domProps")}) + Exp.apply ~loc + (Exp.ident ~loc { loc; txt = Ldot (Lident "ReactDOMRe", "domProps") }) (nonEmptyProps |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression))) in [ @@ -411599,547 +411544,551 @@ let jsxMapper () = (* ReactDOMRe.props(~className=blabla, ~foo=bar, ()) *) (labelled "props", propsCall); (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] in - Exp.apply - ~loc - (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs - (* ReactDOMRe.createElement *) - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", createElementCall)}) - args + (nolabel, childrenExpr); + ] in - - - + Exp.apply ~loc (* throw away the [@JSX] attribute and keep the others, if any *) ~attrs + (* ReactDOMRe.createElement *) + (Exp.ident ~loc { loc; txt = Ldot (Lident "ReactDOMRe", createElementCall) }) + args + [@@raises Invalid_argument] + in let rec recursivelyTransformNamedArgsForMake mapper expr list = let expr = mapper.expr mapper expr in match expr.pexp_desc with (* TODO: make this show up with a loc. *) - | Pexp_fun (Labelled "key", _, _, _) - | Pexp_fun (Optional "key", _, _, _) -> raise (Invalid_argument "Key cannot be accessed inside of a component. Don't worry - you can always key a component from its parent!") - | Pexp_fun (Labelled "ref", _, _, _) - | Pexp_fun (Optional "ref", _, _, _) -> raise (Invalid_argument "Ref cannot be passed as a normal prop. Please use `forwardRef` API instead.") + | Pexp_fun (Labelled "key", _, _, _) | Pexp_fun (Optional "key", _, _, _) -> + raise + (Invalid_argument + "Key cannot be accessed inside of a component. Don't worry - you can always key a component from its \ + parent!") + | Pexp_fun (Labelled "ref", _, _, _) | Pexp_fun (Optional "ref", _, _, _) -> + raise (Invalid_argument "Ref cannot be passed as a normal prop. Please use `forwardRef` API instead.") | Pexp_fun (arg, default, pattern, expression) when isOptional arg || isLabelled arg -> - let () = - (match (isOptional arg, pattern, default) with - | (true, { ppat_desc = Ppat_constraint (_, { ptyp_desc })}, None) -> - (match ptyp_desc with - | Ptyp_constr({txt=(Lident "option")}, [_]) -> () - | _ -> - let currentType = (match ptyp_desc with - | Ptyp_constr({txt}, []) -> String.concat "." (Longident.flatten txt) - | Ptyp_constr({txt}, _innerTypeArgs) -> String.concat "." (Longident.flatten txt) ^ "(...)" - | _ -> "...") - in - Location.prerr_warning pattern.ppat_loc - (Preprocessor - (Printf.sprintf "ReasonReact: optional argument annotations must have explicit `option`. Did you mean `option(%s)=?`?" currentType))) - | _ -> ()) in - let alias = (match pattern with - | {ppat_desc = Ppat_alias (_, {txt}) | Ppat_var {txt}} -> txt - | {ppat_desc = Ppat_any} -> "_" - | _ -> getLabel arg) in - let type_ = (match pattern with - | {ppat_desc = Ppat_constraint (_, type_)} -> Some type_ - | _ -> None) in - - recursivelyTransformNamedArgsForMake mapper expression ((arg, default, pattern, alias, pattern.ppat_loc, type_) :: list) - | Pexp_fun (Nolabel, _, { ppat_desc = (Ppat_construct ({txt = Lident "()"}, _) | Ppat_any)}, _expression) -> + let () = + match (isOptional arg, pattern, default) with + | true, { ppat_desc = Ppat_constraint (_, { ptyp_desc }) }, None -> ( + match ptyp_desc with + | Ptyp_constr ({ txt = Lident "option" }, [ _ ]) -> () + | _ -> + let currentType = + match ptyp_desc with + | Ptyp_constr ({ txt }, []) -> String.concat "." (Longident.flatten txt) + | Ptyp_constr ({ txt }, _innerTypeArgs) -> String.concat "." (Longident.flatten txt) ^ "(...)" + | _ -> "..." + in + Location.prerr_warning pattern.ppat_loc + (Preprocessor + (Printf.sprintf + "ReasonReact: optional argument annotations must have explicit `option`. Did you mean \ + `option(%s)=?`?" + currentType)) ) + | _ -> () + in + let alias = + match pattern with + | { ppat_desc = Ppat_alias (_, { txt }) | Ppat_var { txt } } -> txt + | { ppat_desc = Ppat_any } -> "_" + | _ -> getLabel arg + in + let type_ = match pattern with { ppat_desc = Ppat_constraint (_, type_) } -> Some type_ | _ -> None in + + recursivelyTransformNamedArgsForMake mapper expression + ((arg, default, pattern, alias, pattern.ppat_loc, type_) :: list) + | Pexp_fun (Nolabel, _, { ppat_desc = Ppat_construct ({ txt = Lident "()" }, _) | Ppat_any }, _expression) -> (list, None) - | Pexp_fun (Nolabel, _, { ppat_desc = Ppat_var ({txt}) | Ppat_constraint ({ ppat_desc = Ppat_var ({txt})}, _)}, _expression) -> + | Pexp_fun + ( Nolabel, + _, + { ppat_desc = Ppat_var { txt } | Ppat_constraint ({ ppat_desc = Ppat_var { txt } }, _) }, + _expression ) -> (list, Some txt) | Pexp_fun (Nolabel, _, pattern, _expression) -> - Location.raise_errorf ~loc:pattern.ppat_loc "ReasonReact: react.component refs only support plain arguments and type annotations." + Location.raise_errorf ~loc:pattern.ppat_loc + "ReasonReact: react.component refs only support plain arguments and type annotations." | _ -> (list, None) + [@@raises Invalid_argument] in - - let argToType types (name, default, _noLabelName, _alias, loc, type_) = match (type_, name, default) with - | (Some ({ptyp_desc = Ptyp_constr ({txt=(Lident "option")}, [type_])}), name, _) when isOptional name -> - (getLabel name, [], { - type_ with - ptyp_desc = Ptyp_constr ({loc=type_.ptyp_loc; txt=optionIdent}, [type_]); - }) :: types - | (Some type_, name, Some _default) -> - (getLabel name, [], { - ptyp_desc = Ptyp_constr ({loc; txt=optionIdent}, [type_]); - ptyp_loc = loc; - ptyp_attributes = []; - }) :: types - | (Some type_, name, _) -> - (getLabel name, [], type_) :: types - | (None, name, _) when isOptional name -> - (getLabel name, [], { - ptyp_desc = Ptyp_constr ({loc; txt=optionIdent}, [{ - ptyp_desc = Ptyp_var (safeTypeFromValue name); - ptyp_loc = loc; - ptyp_attributes = []; - }]); - ptyp_loc = loc; - ptyp_attributes = []; - }) :: types - | (None, name, _) when isLabelled name -> - (getLabel name, [], { - ptyp_desc = Ptyp_var (safeTypeFromValue name); - ptyp_loc = loc; - ptyp_attributes = []; - }) :: types + let argToType types (name, default, _noLabelName, _alias, loc, type_) = + match (type_, name, default) with + | Some { ptyp_desc = Ptyp_constr ({ txt = Lident "option" }, [ type_ ]) }, name, _ when isOptional name -> + ( getLabel name, + [], + { type_ with ptyp_desc = Ptyp_constr ({ loc = type_.ptyp_loc; txt = optionIdent }, [ type_ ]) } ) + :: types + | Some type_, name, Some _default -> + ( getLabel name, + [], + { ptyp_desc = Ptyp_constr ({ loc; txt = optionIdent }, [ type_ ]); ptyp_loc = loc; ptyp_attributes = [] } ) + :: types + | Some type_, name, _ -> (getLabel name, [], type_) :: types + | None, name, _ when isOptional name -> + ( getLabel name, + [], + { + ptyp_desc = + Ptyp_constr + ( { loc; txt = optionIdent }, + [ { ptyp_desc = Ptyp_var (safeTypeFromValue name); ptyp_loc = loc; ptyp_attributes = [] } ] ); + ptyp_loc = loc; + ptyp_attributes = []; + } ) + :: types + | None, name, _ when isLabelled name -> + (getLabel name, [], { ptyp_desc = Ptyp_var (safeTypeFromValue name); ptyp_loc = loc; ptyp_attributes = [] }) + :: types | _ -> types + [@@raises Invalid_argument] in - let argToConcreteType types (name, loc, type_) = match name with - | name when isLabelled name -> - (getLabel name, [], type_) :: types - | name when isOptional name -> - (getLabel name, [], Typ.constr ~loc {loc; txt=optionIdent} [type_]) :: types + let argToConcreteType types (name, loc, type_) = + match name with + | name when isLabelled name -> (getLabel name, [], type_) :: types + | name when isOptional name -> (getLabel name, [], Typ.constr ~loc { loc; txt = optionIdent } [ type_ ]) :: types | _ -> types in - let nestedModules = ref([]) in - let transformComponentDefinition mapper structure returnStructures = match structure with - (* external *) - | ({ - pstr_loc; - pstr_desc = Pstr_primitive ({ - pval_name = { txt = fnName }; - pval_attributes; - pval_type; - } as value_description) - } as pstr) -> - (match List.filter hasAttr pval_attributes with - | [] -> structure :: returnStructures - | [_] -> - let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = - (match ptyp_desc with - | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) when isLabelled name || isOptional name -> - getPropTypes ((name, ptyp_loc, type_)::types) rest - | Ptyp_arrow (Nolabel, _type, rest) -> - getPropTypes types rest - | Ptyp_arrow (name, type_, returnValue) when isLabelled name || isOptional name -> - (returnValue, (name, returnValue.ptyp_loc, type_)::types) - | _ -> (fullType, types)) - in - let (innerType, propTypes) = getPropTypes [] pval_type in - let namedTypeList = List.fold_left argToConcreteType [] propTypes in - let pluckLabelAndLoc (label, loc, type_) = (label, None (* default *), loc, Some type_) in - let retPropsType = makePropsType ~loc:pstr_loc namedTypeList in - let externalPropsDecl = makePropsExternal fnName pstr_loc (( - optional "key", - None, - pstr_loc, - Some(keyType pstr_loc) - ) :: List.map pluckLabelAndLoc propTypes) retPropsType in - (* can't be an arrow because it will defensively uncurry *) - let newExternalType = Ptyp_constr ( - {loc = pstr_loc; txt = Ldot ((Lident "React"), "componentLike")}, - [retPropsType; innerType] - ) in - let newStructure = { - pstr with pstr_desc = Pstr_primitive { - value_description with pval_type = { - pval_type with ptyp_desc = newExternalType; - }; - pval_attributes = List.filter otherAttrsPure pval_attributes; - } - } in - externalPropsDecl :: newStructure :: returnStructures - | _ -> raise (Invalid_argument "Only one react.component call can exist on a component at one time")) - (* let component = ... *) - | { - pstr_loc; - pstr_desc = Pstr_value ( - recFlag, - valueBindings - ) - } -> - let fileName = filenameFromLoc pstr_loc in - let emptyLoc = Location.in_file fileName in - let mapBinding binding = if (hasAttrOnBinding binding) then - let bindingLoc = binding.pvb_loc in - let bindingPatLoc = binding.pvb_pat.ppat_loc in - let binding = { binding with pvb_pat = { binding.pvb_pat with ppat_loc = emptyLoc}; pvb_loc = emptyLoc} in - let fnName = getFnName binding in - let internalFnName = fnName ^ "$Internal" in - let fullModuleName = makeModuleName fileName !nestedModules fnName in - let modifiedBindingOld binding = - let expression = binding.pvb_expr in - (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) - let rec spelunkForFunExpression expression = (match expression with - (* let make = (~prop) => ... *) - | { - pexp_desc = Pexp_fun _ - } -> expression - (* let make = {let foo = bar in (~prop) => ...} *) - | { - pexp_desc = Pexp_let (_recursive, _vbs, returnExpression) - } -> - (* here's where we spelunk! *) - spelunkForFunExpression returnExpression - (* let make = React.forwardRef((~prop) => ...) *) - - | { pexp_desc = Pexp_apply (_wrapperExpression, [(Nolabel, innerFunctionExpression)]) } -> - spelunkForFunExpression innerFunctionExpression - | { - pexp_desc = Pexp_sequence (_wrapperExpression, innerFunctionExpression) - } -> - spelunkForFunExpression innerFunctionExpression - | _ -> raise (Invalid_argument "react.component calls can only be on function definitions or component wrappers (forwardRef, memo).") - ) in - spelunkForFunExpression expression - in - let modifiedBinding binding = - let hasApplication = ref(false) in - let wrapExpressionWithBinding expressionFn expression = - Vb.mk - ~loc:bindingLoc - ~attrs:(List.filter otherAttrsPure binding.pvb_attributes) - (Pat.var ~loc:bindingPatLoc {loc = bindingPatLoc; txt = fnName}) (expressionFn expression) in - let expression = binding.pvb_expr in - let unerasableIgnoreExp exp = { exp with pexp_attributes = (unerasableIgnore emptyLoc) :: exp.pexp_attributes } in - (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) - let rec spelunkForFunExpression expression = (match expression with - (* let make = (~prop) => ... with no final unit *) - | { - pexp_desc = Pexp_fun ((Labelled(_) | Optional(_) as label), default, pattern, ({pexp_desc = Pexp_fun _} as internalExpression)) - } -> - let (wrap, hasUnit, exp) = spelunkForFunExpression internalExpression in - (wrap, hasUnit, unerasableIgnoreExp {expression with pexp_desc = Pexp_fun (label, default, pattern, exp)}) - (* let make = (()) => ... *) - (* let make = (_) => ... *) - | { - pexp_desc = Pexp_fun (Nolabel, _default, { ppat_desc = Ppat_construct ({txt = Lident "()"}, _) | Ppat_any}, _internalExpression) - } -> ((fun a -> a), true, expression) - (* let make = (~prop) => ... *) - | { - pexp_desc = Pexp_fun ((Labelled(_) | Optional(_)), _default, _pattern, _internalExpression) - } -> ((fun a -> a), false, unerasableIgnoreExp expression) - (* let make = (prop) => ... *) - | { - pexp_desc = Pexp_fun (_nolabel, _default, pattern, _internalExpression) - } -> - if (hasApplication.contents) then - ((fun a -> a), false, unerasableIgnoreExp expression) - else - Location.raise_errorf ~loc:pattern.ppat_loc "ReasonReact: props need to be labelled arguments.\n If you are working with refs be sure to wrap with React.forwardRef.\n If your component doesn't have any props use () or _ instead of a name." - (* let make = {let foo = bar in (~prop) => ...} *) - | { - pexp_desc = Pexp_let (recursive, vbs, internalExpression) - } -> - (* here's where we spelunk! *) - let (wrap, hasUnit, exp) = spelunkForFunExpression internalExpression in - (wrap, hasUnit, {expression with pexp_desc = Pexp_let (recursive, vbs, exp)}) - (* let make = React.forwardRef((~prop) => ...) *) - | { pexp_desc = Pexp_apply (wrapperExpression, [(Nolabel, internalExpression)]) } -> - let () = hasApplication := true in - let (_, hasUnit, exp) = spelunkForFunExpression internalExpression in - ((fun exp -> Exp.apply wrapperExpression [(nolabel, exp)]), hasUnit, exp) - | { - pexp_desc = Pexp_sequence (wrapperExpression, internalExpression) - } -> - let (wrap, hasUnit, exp) = spelunkForFunExpression internalExpression in - (wrap, hasUnit, {expression with pexp_desc = Pexp_sequence (wrapperExpression, exp)}) - | e -> ((fun a -> a), false, e) - ) in - let (wrapExpression, hasUnit, expression) = spelunkForFunExpression expression in - (wrapExpressionWithBinding wrapExpression, hasUnit, expression) - in - let (bindingWrapper, hasUnit, expression) = modifiedBinding binding in - let reactComponentAttribute = try - Some(List.find hasAttr binding.pvb_attributes) - with | Not_found -> None in - let (_attr_loc, payload) = match reactComponentAttribute with - | Some (loc, payload) -> (loc.loc, Some payload) - | None -> (emptyLoc, None) in - let props = getPropsAttr payload in - (* do stuff here! *) - let (namedArgList, forwardRef) = recursivelyTransformNamedArgsForMake mapper (modifiedBindingOld binding) [] in - let namedArgListWithKeyAndRef = (optional("key"), None, Pat.var {txt = "key"; loc = emptyLoc}, "key", emptyLoc, Some(keyType emptyLoc)) :: namedArgList in - let namedArgListWithKeyAndRef = match forwardRef with - | Some(_) -> (optional("ref"), None, Pat.var {txt = "key"; loc = emptyLoc}, "ref", emptyLoc, None) :: namedArgListWithKeyAndRef - | None -> namedArgListWithKeyAndRef - in - let namedArgListWithKeyAndRefForNew = match forwardRef with - | Some(txt) -> namedArgList @ [(nolabel, None, Pat.var {txt; loc = emptyLoc}, txt, emptyLoc, None)] - | None -> namedArgList + let nestedModules = ref [] in + let transformComponentDefinition mapper structure returnStructures = + match structure with + (* external *) + | { + pstr_loc; + pstr_desc = Pstr_primitive ({ pval_name = { txt = fnName }; pval_attributes; pval_type } as value_description); + } as pstr -> ( + match List.filter hasAttr pval_attributes with + | [] -> structure :: returnStructures + | [ _ ] -> + let rec getPropTypes types ({ ptyp_loc; ptyp_desc } as fullType) = + match ptyp_desc with + | Ptyp_arrow (name, type_, ({ ptyp_desc = Ptyp_arrow _ } as rest)) when isLabelled name || isOptional name + -> + getPropTypes ((name, ptyp_loc, type_) :: types) rest + | Ptyp_arrow (Nolabel, _type, rest) -> getPropTypes types rest + | Ptyp_arrow (name, type_, returnValue) when isLabelled name || isOptional name -> + (returnValue, (name, returnValue.ptyp_loc, type_) :: types) + | _ -> (fullType, types) + in + let innerType, propTypes = getPropTypes [] pval_type in + let namedTypeList = List.fold_left argToConcreteType [] propTypes in + let pluckLabelAndLoc (label, loc, type_) = (label, None (* default *), loc, Some type_) in + let retPropsType = makePropsType ~loc:pstr_loc namedTypeList in + let externalPropsDecl = + makePropsExternal fnName pstr_loc + ((optional "key", None, pstr_loc, Some (keyType pstr_loc)) :: List.map pluckLabelAndLoc propTypes) + retPropsType + in + (* can't be an arrow because it will defensively uncurry *) + let newExternalType = + Ptyp_constr ({ loc = pstr_loc; txt = Ldot (Lident "React", "componentLike") }, [ retPropsType; innerType ]) + in + let newStructure = + { + pstr with + pstr_desc = + Pstr_primitive + { + value_description with + pval_type = { pval_type with ptyp_desc = newExternalType }; + pval_attributes = List.filter otherAttrsPure pval_attributes; + }; + } + in + externalPropsDecl :: newStructure :: returnStructures + | _ -> raise (Invalid_argument "Only one react.component call can exist on a component at one time") ) + (* let component = ... *) + | { pstr_loc; pstr_desc = Pstr_value (recFlag, valueBindings) } -> + let fileName = filenameFromLoc pstr_loc in + let emptyLoc = Location.in_file fileName in + let mapBinding binding = + if hasAttrOnBinding binding then + let bindingLoc = binding.pvb_loc in + let bindingPatLoc = binding.pvb_pat.ppat_loc in + let binding = { binding with pvb_pat = { binding.pvb_pat with ppat_loc = emptyLoc }; pvb_loc = emptyLoc } in + let fnName = getFnName binding in + let internalFnName = fnName ^ "$Internal" in + let fullModuleName = makeModuleName fileName !nestedModules fnName in + let modifiedBindingOld binding = + let expression = binding.pvb_expr in + (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) + let rec spelunkForFunExpression expression = + match expression with + (* let make = (~prop) => ... *) + | { pexp_desc = Pexp_fun _ } -> expression + (* let make = {let foo = bar in (~prop) => ...} *) + | { pexp_desc = Pexp_let (_recursive, _vbs, returnExpression) } -> + (* here's where we spelunk! *) + spelunkForFunExpression returnExpression + (* let make = React.forwardRef((~prop) => ...) *) + | { pexp_desc = Pexp_apply (_wrapperExpression, [ (Nolabel, innerFunctionExpression) ]) } -> + spelunkForFunExpression innerFunctionExpression + | { pexp_desc = Pexp_sequence (_wrapperExpression, innerFunctionExpression) } -> + spelunkForFunExpression innerFunctionExpression + | _ -> + raise + (Invalid_argument + "react.component calls can only be on function definitions or component wrappers (forwardRef, \ + memo).") + [@@raises Invalid_argument] + in + spelunkForFunExpression expression + in + let modifiedBinding binding = + let hasApplication = ref false in + let wrapExpressionWithBinding expressionFn expression = + Vb.mk ~loc:bindingLoc + ~attrs:(List.filter otherAttrsPure binding.pvb_attributes) + (Pat.var ~loc:bindingPatLoc { loc = bindingPatLoc; txt = fnName }) + (expressionFn expression) + in + let expression = binding.pvb_expr in + let unerasableIgnoreExp exp = + { exp with pexp_attributes = unerasableIgnore emptyLoc :: exp.pexp_attributes } + in + (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) + let rec spelunkForFunExpression expression = + match expression with + (* let make = (~prop) => ... with no final unit *) + | { + pexp_desc = + Pexp_fun + ( ((Labelled _ | Optional _) as label), + default, + pattern, + ({ pexp_desc = Pexp_fun _ } as internalExpression) ); + } -> + let wrap, hasUnit, exp = spelunkForFunExpression internalExpression in + ( wrap, + hasUnit, + unerasableIgnoreExp { expression with pexp_desc = Pexp_fun (label, default, pattern, exp) } ) + (* let make = (()) => ... *) + (* let make = (_) => ... *) + | { + pexp_desc = + Pexp_fun + ( Nolabel, + _default, + { ppat_desc = Ppat_construct ({ txt = Lident "()" }, _) | Ppat_any }, + _internalExpression ); + } -> + ((fun a -> a), true, expression) + (* let make = (~prop) => ... *) + | { pexp_desc = Pexp_fun ((Labelled _ | Optional _), _default, _pattern, _internalExpression) } -> + ((fun a -> a), false, unerasableIgnoreExp expression) + (* let make = (prop) => ... *) + | { pexp_desc = Pexp_fun (_nolabel, _default, pattern, _internalExpression) } -> + if hasApplication.contents then ((fun a -> a), false, unerasableIgnoreExp expression) + else + Location.raise_errorf ~loc:pattern.ppat_loc + "ReasonReact: props need to be labelled arguments.\n\ + \ If you are working with refs be sure to wrap with React.forwardRef.\n\ + \ If your component doesn't have any props use () or _ instead of a name." + (* let make = {let foo = bar in (~prop) => ...} *) + | { pexp_desc = Pexp_let (recursive, vbs, internalExpression) } -> + (* here's where we spelunk! *) + let wrap, hasUnit, exp = spelunkForFunExpression internalExpression in + (wrap, hasUnit, { expression with pexp_desc = Pexp_let (recursive, vbs, exp) }) + (* let make = React.forwardRef((~prop) => ...) *) + | { pexp_desc = Pexp_apply (wrapperExpression, [ (Nolabel, internalExpression) ]) } -> + let () = hasApplication := true in + let _, hasUnit, exp = spelunkForFunExpression internalExpression in + ((fun exp -> Exp.apply wrapperExpression [ (nolabel, exp) ]), hasUnit, exp) + | { pexp_desc = Pexp_sequence (wrapperExpression, internalExpression) } -> + let wrap, hasUnit, exp = spelunkForFunExpression internalExpression in + (wrap, hasUnit, { expression with pexp_desc = Pexp_sequence (wrapperExpression, exp) }) + | e -> ((fun a -> a), false, e) + in + let wrapExpression, hasUnit, expression = spelunkForFunExpression expression in + (wrapExpressionWithBinding wrapExpression, hasUnit, expression) + in + let bindingWrapper, hasUnit, expression = modifiedBinding binding in + let reactComponentAttribute = + try Some (List.find hasAttr binding.pvb_attributes) with Not_found -> None + in + let _attr_loc, payload = + match reactComponentAttribute with + | Some (loc, payload) -> (loc.loc, Some payload) + | None -> (emptyLoc, None) + in + let props = getPropsAttr payload in + (* do stuff here! *) + let namedArgList, forwardRef = + recursivelyTransformNamedArgsForMake mapper (modifiedBindingOld binding) [] + in + let namedArgListWithKeyAndRef = + (optional "key", None, Pat.var { txt = "key"; loc = emptyLoc }, "key", emptyLoc, Some (keyType emptyLoc)) + :: namedArgList + in + let namedArgListWithKeyAndRef = + match forwardRef with + | Some _ -> + (optional "ref", None, Pat.var { txt = "key"; loc = emptyLoc }, "ref", emptyLoc, None) + :: namedArgListWithKeyAndRef + | None -> namedArgListWithKeyAndRef + in + let namedArgListWithKeyAndRefForNew = + match forwardRef with + | Some txt -> namedArgList @ [ (nolabel, None, Pat.var { txt; loc = emptyLoc }, txt, emptyLoc, None) ] + | None -> namedArgList + in + let pluckArg (label, _, _, alias, loc, _) = + let labelString = + match label with label when isOptional label || isLabelled label -> getLabel label | _ -> "" + in + ( label, + match labelString with + | "" -> Exp.ident ~loc { txt = Lident alias; loc } + | labelString -> + Exp.apply ~loc + (Exp.ident ~loc { txt = Lident "##"; loc }) + [ + (nolabel, Exp.ident ~loc { txt = Lident props.propsName; loc }); + (nolabel, Exp.ident ~loc { txt = Lident labelString; loc }); + ] ) + in + let namedTypeList = List.fold_left argToType [] namedArgList in + let loc = emptyLoc in + let externalDecl = makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList in + let innerExpressionArgs = + List.map pluckArg namedArgListWithKeyAndRefForNew + @ if hasUnit then [ (Nolabel, Exp.construct { loc; txt = Lident "()" } None) ] else [] + in + let innerExpression = + Exp.apply + (Exp.ident + { loc; txt = Lident (match recFlag with Recursive -> internalFnName | Nonrecursive -> fnName) }) + innerExpressionArgs + in + let innerExpressionWithRef = + match forwardRef with + | Some txt -> + { + innerExpression with + pexp_desc = + Pexp_fun + ( nolabel, + None, + { ppat_desc = Ppat_var { txt; loc = emptyLoc }; ppat_loc = emptyLoc; ppat_attributes = [] }, + innerExpression ); + } + | None -> innerExpression + in + let fullExpression = + Exp.fun_ nolabel None + { + ppat_desc = + Ppat_constraint + (makePropsName ~loc:emptyLoc props.propsName, makePropsType ~loc:emptyLoc namedTypeList); + ppat_loc = emptyLoc; + ppat_attributes = []; + } + innerExpressionWithRef + in + let fullExpression = + match fullModuleName with + | "" -> fullExpression + | txt -> + Exp.let_ Nonrecursive + [ Vb.mk ~loc:emptyLoc (Pat.var ~loc:emptyLoc { loc = emptyLoc; txt }) fullExpression ] + (Exp.ident ~loc:emptyLoc { loc = emptyLoc; txt = Lident txt }) + in + let bindings, newBinding = + match recFlag with + | Recursive -> + ( [ + bindingWrapper + (Exp.let_ ~loc:emptyLoc Recursive + [ + makeNewBinding binding expression internalFnName; + Vb.mk (Pat.var { loc = emptyLoc; txt = fnName }) fullExpression; + ] + (Exp.ident { loc = emptyLoc; txt = Lident fnName })); + ], + None ) + | Nonrecursive -> + ([ { binding with pvb_expr = expression; pvb_attributes = [] } ], Some (bindingWrapper fullExpression)) + in + (Some externalDecl, bindings, newBinding) + else (None, [ binding ], None) + [@@raises Invalid_argument] in - let pluckArg (label, _, _, alias, loc, _) = - let labelString = (match label with | label when isOptional label || isLabelled label -> getLabel label | _ -> "") in - (label, - (match labelString with - | "" -> (Exp.ident ~loc { - txt = (Lident alias); - loc - }) - | labelString -> (Exp.apply ~loc - (Exp.ident ~loc {txt = (Lident "##"); loc }) - [ - (nolabel, Exp.ident ~loc {txt = (Lident props.propsName); loc }); - (nolabel, Exp.ident ~loc { - txt = (Lident labelString); - loc - }) - ] - ) - ) - ) in - let namedTypeList = List.fold_left argToType [] namedArgList in - let loc = emptyLoc in - let externalDecl = makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList in - let innerExpressionArgs = (List.map pluckArg namedArgListWithKeyAndRefForNew) @ - if hasUnit then [(Nolabel, Exp.construct {loc; txt = Lident "()"} None)] else [] in - let innerExpression = Exp.apply (Exp.ident {loc; txt = Lident( - match recFlag with - | Recursive -> internalFnName - | Nonrecursive -> fnName - )}) innerExpressionArgs in - let innerExpressionWithRef = match (forwardRef) with - | Some txt -> - {innerExpression with pexp_desc = Pexp_fun (nolabel, None, { - ppat_desc = Ppat_var { txt; loc = emptyLoc }; - ppat_loc = emptyLoc; - ppat_attributes = []; - }, innerExpression)} - | None -> innerExpression + let structuresAndBinding = List.map mapBinding valueBindings in + let otherStructures (extern, binding, newBinding) (externs, bindings, newBindings) = + let externs = match extern with Some extern -> extern :: externs | None -> externs in + let newBindings = + match newBinding with Some newBinding -> newBinding :: newBindings | None -> newBindings + in + (externs, binding @ bindings, newBindings) in - let fullExpression = Exp.fun_ - nolabel - None - { - ppat_desc = Ppat_constraint ( - makePropsName ~loc:emptyLoc props.propsName, - makePropsType ~loc:emptyLoc namedTypeList - ); - ppat_loc = emptyLoc; - ppat_attributes = []; - } - innerExpressionWithRef in - let fullExpression = match (fullModuleName) with - | ("") -> fullExpression - | (txt) -> Exp.let_ - Nonrecursive - [Vb.mk - ~loc:emptyLoc - (Pat.var ~loc:emptyLoc {loc = emptyLoc; txt}) - fullExpression - ] - (Exp.ident ~loc:emptyLoc {loc = emptyLoc; txt = Lident txt}) in - let (bindings, newBinding) = - match recFlag with - | Recursive -> ([bindingWrapper (Exp.let_ - ~loc:(emptyLoc) - Recursive - [ - makeNewBinding binding expression internalFnName; - Vb.mk (Pat.var {loc = emptyLoc; txt = fnName}) fullExpression - ] - (Exp.ident {loc = emptyLoc; txt = Lident fnName}))], None) - | Nonrecursive -> ([{ binding with pvb_expr = expression; pvb_attributes = [] }], Some(bindingWrapper fullExpression)) - in - (Some externalDecl, bindings, newBinding) - else - (None, [binding], None) - in - let structuresAndBinding = List.map mapBinding valueBindings in - let otherStructures (extern, binding, newBinding) (externs, bindings, newBindings) = - let externs = match extern with - | Some extern -> extern :: externs - | None -> externs in - let newBindings = match newBinding with - | Some newBinding -> newBinding :: newBindings - | None -> newBindings in - (externs, binding @ bindings, newBindings) - in - let (externs, bindings, newBindings) = List.fold_right otherStructures structuresAndBinding ([], [], []) in - externs @ [{ - pstr_loc; - pstr_desc = Pstr_value ( - recFlag, - bindings - ) - }] @ (match newBindings with - | [] -> [] - | newBindings -> [{ - pstr_loc = emptyLoc; - pstr_desc = Pstr_value ( - recFlag, - newBindings - ) - }]) @ returnStructures - | structure -> structure :: returnStructures in + let externs, bindings, newBindings = List.fold_right otherStructures structuresAndBinding ([], [], []) in + externs + @ [ { pstr_loc; pstr_desc = Pstr_value (recFlag, bindings) } ] + @ ( match newBindings with + | [] -> [] + | newBindings -> [ { pstr_loc = emptyLoc; pstr_desc = Pstr_value (recFlag, newBindings) } ] ) + @ returnStructures + | structure -> structure :: returnStructures + [@@raises Invalid_argument] + in let reactComponentTransform mapper structures = - List.fold_right (transformComponentDefinition mapper) structures [] in - - let transformComponentSignature _mapper signature returnSignatures = match signature with - | ({ - psig_loc; - psig_desc = Psig_value ({ - pval_name = { txt = fnName }; - pval_attributes; - pval_type; - } as psig_desc) - } as psig) -> - (match List.filter hasAttr pval_attributes with - | [] -> signature :: returnSignatures - | [_] -> - let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = - (match ptyp_desc with - | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) when isOptional name || isLabelled name -> - getPropTypes ((name, ptyp_loc, type_)::types) rest - | Ptyp_arrow (Nolabel, _type, rest) -> - getPropTypes types rest - | Ptyp_arrow (name, type_, returnValue) when isOptional name || isLabelled name -> - (returnValue, (name, returnValue.ptyp_loc, type_)::types) - | _ -> (fullType, types)) - in - let (innerType, propTypes) = getPropTypes [] pval_type in - let namedTypeList = List.fold_left argToConcreteType [] propTypes in - let pluckLabelAndLoc (label, loc, type_) = (label, None, loc, Some type_) in - let retPropsType = makePropsType ~loc:psig_loc namedTypeList in - let externalPropsDecl = makePropsExternalSig fnName psig_loc (( - optional "key", - None, - psig_loc, - Some(keyType psig_loc) - ) :: List.map pluckLabelAndLoc propTypes) retPropsType in - (* can't be an arrow because it will defensively uncurry *) - let newExternalType = Ptyp_constr ( - {loc = psig_loc; txt = Ldot ((Lident "React"), "componentLike")}, - [retPropsType; innerType] - ) in - let newStructure = { - psig with psig_desc = Psig_value { - psig_desc with pval_type = { - pval_type with ptyp_desc = newExternalType; - }; - pval_attributes = List.filter otherAttrsPure pval_attributes; - } - } in - externalPropsDecl :: newStructure :: returnSignatures - | _ -> raise (Invalid_argument "Only one react.component call can exist on a component at one time")) - | signature -> signature :: returnSignatures in + List.fold_right (transformComponentDefinition mapper) structures [] + [@@raises Invalid_argument] + in - let reactComponentSignatureTransform mapper signatures = - List.fold_right (transformComponentSignature mapper) signatures [] in + let transformComponentSignature _mapper signature returnSignatures = + match signature with + | { psig_loc; psig_desc = Psig_value ({ pval_name = { txt = fnName }; pval_attributes; pval_type } as psig_desc) } + as psig -> ( + match List.filter hasAttr pval_attributes with + | [] -> signature :: returnSignatures + | [ _ ] -> + let rec getPropTypes types ({ ptyp_loc; ptyp_desc } as fullType) = + match ptyp_desc with + | Ptyp_arrow (name, type_, ({ ptyp_desc = Ptyp_arrow _ } as rest)) when isOptional name || isLabelled name + -> + getPropTypes ((name, ptyp_loc, type_) :: types) rest + | Ptyp_arrow (Nolabel, _type, rest) -> getPropTypes types rest + | Ptyp_arrow (name, type_, returnValue) when isOptional name || isLabelled name -> + (returnValue, (name, returnValue.ptyp_loc, type_) :: types) + | _ -> (fullType, types) + in + let innerType, propTypes = getPropTypes [] pval_type in + let namedTypeList = List.fold_left argToConcreteType [] propTypes in + let pluckLabelAndLoc (label, loc, type_) = (label, None, loc, Some type_) in + let retPropsType = makePropsType ~loc:psig_loc namedTypeList in + let externalPropsDecl = + makePropsExternalSig fnName psig_loc + ((optional "key", None, psig_loc, Some (keyType psig_loc)) :: List.map pluckLabelAndLoc propTypes) + retPropsType + in + (* can't be an arrow because it will defensively uncurry *) + let newExternalType = + Ptyp_constr ({ loc = psig_loc; txt = Ldot (Lident "React", "componentLike") }, [ retPropsType; innerType ]) + in + let newStructure = + { + psig with + psig_desc = + Psig_value + { + psig_desc with + pval_type = { pval_type with ptyp_desc = newExternalType }; + pval_attributes = List.filter otherAttrsPure pval_attributes; + }; + } + in + externalPropsDecl :: newStructure :: returnSignatures + | _ -> raise (Invalid_argument "Only one react.component call can exist on a component at one time") ) + | signature -> signature :: returnSignatures + [@@raises Invalid_argument] + in + let reactComponentSignatureTransform mapper signatures = + List.fold_right (transformComponentSignature mapper) signatures [] + [@@raises Invalid_argument] + in let transformJsxCall mapper callExpression callArguments attrs = - (match callExpression.pexp_desc with - | Pexp_ident caller -> - (match caller with - | {txt = Lident "createElement"} -> - raise (Invalid_argument "JSX: `createElement` should be preceeded by a module name.") - + match callExpression.pexp_desc with + | Pexp_ident caller -> ( + match caller with + | { txt = Lident "createElement" } -> + raise (Invalid_argument "JSX: `createElement` should be preceeded by a module name.") (* Foo.createElement(~prop1=foo, ~prop2=bar, ~children=[], ()) *) - | {loc; txt = Ldot (modulePath, ("createElement" | "make"))} -> - (match !jsxVersion with - | None - | Some 3 -> transformUppercaseCall3 modulePath mapper loc attrs callExpression callArguments - | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 3")) - + | { loc; txt = Ldot (modulePath, ("createElement" | "make")) } -> ( + match !jsxVersion with + | None | Some 3 -> transformUppercaseCall3 modulePath mapper loc attrs callExpression callArguments + | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 3") ) (* div(~prop1=foo, ~prop2=bar, ~children=[bla], ()) *) (* turn that into - ReactDOMRe.createElement(~props=ReactDOMRe.props(~props1=foo, ~props2=bar, ()), [|bla|]) *) - | {loc; txt = Lident id} -> - (match !jsxVersion with - | None - | Some 3 -> transformLowercaseCall3 mapper loc attrs callArguments id - | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 3")) - - | {txt = Ldot (_, anythingNotCreateElementOrMake)} -> - raise ( - Invalid_argument - ("JSX: the JSX attribute should be attached to a `YourModuleName.createElement` or `YourModuleName.make` call. We saw `" - ^ anythingNotCreateElementOrMake - ^ "` instead" - ) - ) - - | {txt = Lapply _} -> - (* don't think there's ever a case where this is reached *) - raise ( - Invalid_argument "JSX: encountered a weird case while processing the code. Please report this!" - ) - ) - | _ -> - raise ( - Invalid_argument "JSX: `createElement` should be preceeded by a simple, direct module name." - ) - ) in + ReactDOMRe.createElement(~props=ReactDOMRe.props(~props1=foo, ~props2=bar, ()), [|bla|]) *) + | { loc; txt = Lident id } -> ( + match !jsxVersion with + | None | Some 3 -> transformLowercaseCall3 mapper loc attrs callArguments id + | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 3") ) + | { txt = Ldot (_, anythingNotCreateElementOrMake) } -> + raise + (Invalid_argument + ( "JSX: the JSX attribute should be attached to a `YourModuleName.createElement` or \ + `YourModuleName.make` call. We saw `" ^ anythingNotCreateElementOrMake ^ "` instead" )) + | { txt = Lapply _ } -> + (* don't think there's ever a case where this is reached *) + raise (Invalid_argument "JSX: encountered a weird case while processing the code. Please report this!") ) + | _ -> raise (Invalid_argument "JSX: `createElement` should be preceeded by a simple, direct module name.") + [@@raises Invalid_argument] + in - let signature = - (fun mapper signature -> default_mapper.signature mapper @@ reactComponentSignatureTransform mapper signature) in + let signature mapper signature = + default_mapper.signature mapper @@ reactComponentSignatureTransform mapper signature + [@@raises Invalid_argument] + in - let structure = - (fun mapper structure -> match structure with - | structures -> begin - default_mapper.structure mapper @@ reactComponentTransform mapper structures - end - ) in + let structure mapper structure = + match structure with structures -> default_mapper.structure mapper @@ reactComponentTransform mapper structures + [@@raises Invalid_argument] + in - let expr = - (fun mapper expression -> match expression with - (* Does the function application have the @JSX attribute? *) - | { - pexp_desc = Pexp_apply (callExpression, callArguments); - pexp_attributes - } -> - let (jsxAttribute, nonJSXAttributes) = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - (match (jsxAttribute, nonJSXAttributes) with - (* no JSX attribute *) - | ([], _) -> default_mapper.expr mapper expression - | (_, nonJSXAttributes) -> transformJsxCall mapper callExpression callArguments nonJSXAttributes) - - (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) - | { - pexp_desc = - Pexp_construct ({txt = Lident "::"; loc}, Some {pexp_desc = Pexp_tuple _}) - | Pexp_construct ({txt = Lident "[]"; loc}, None); - pexp_attributes - } as listItems -> - let (jsxAttribute, nonJSXAttributes) = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - (match (jsxAttribute, nonJSXAttributes) with - (* no JSX attribute *) - | ([], _) -> default_mapper.expr mapper expression - | (_, nonJSXAttributes) -> - let fragment = Exp.ident ~loc {loc; txt = Ldot (Lident "ReasonReact", "fragment")} in + let expr mapper expression = + match expression with + (* Does the function application have the @JSX attribute? *) + | { pexp_desc = Pexp_apply (callExpression, callArguments); pexp_attributes } -> ( + let jsxAttribute, nonJSXAttributes = + List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes + in + match (jsxAttribute, nonJSXAttributes) with + (* no JSX attribute *) + | [], _ -> default_mapper.expr mapper expression + | _, nonJSXAttributes -> transformJsxCall mapper callExpression callArguments nonJSXAttributes ) + (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) + | { + pexp_desc = + ( Pexp_construct ({ txt = Lident "::"; loc }, Some { pexp_desc = Pexp_tuple _ }) + | Pexp_construct ({ txt = Lident "[]"; loc }, None) ); + pexp_attributes; + } as listItems -> ( + let jsxAttribute, nonJSXAttributes = + List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes + in + match (jsxAttribute, nonJSXAttributes) with + (* no JSX attribute *) + | [], _ -> default_mapper.expr mapper expression + | _, nonJSXAttributes -> + let fragment = Exp.ident ~loc { loc; txt = Ldot (Lident "ReasonReact", "fragment") } in let childrenExpr = transformChildrenIfList ~loc ~mapper listItems in - let args = [ - (* "div" *) - (nolabel, fragment); - (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] in - Exp.apply - ~loc - (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs:nonJSXAttributes + let args = + [ (* "div" *) (nolabel, fragment); (* [|moreCreateElementCallsHere|] *) (nolabel, childrenExpr) ] + in + Exp.apply ~loc (* throw away the [@JSX] attribute and keep the others, if any *) ~attrs:nonJSXAttributes (* ReactDOMRe.createElement *) - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "createElement")}) - args - ) - (* Delegate to the default mapper, a deep identity traversal *) - | e -> default_mapper.expr mapper e) in - - let module_binding = - (fun mapper module_binding -> - let _ = nestedModules := module_binding.pmb_name.txt :: !nestedModules in - let mapped = default_mapper.module_binding mapper module_binding in - let _ = nestedModules := List.tl !nestedModules in - mapped - ) in + (Exp.ident ~loc { loc; txt = Ldot (Lident "ReactDOMRe", "createElement") }) + args ) + (* Delegate to the default mapper, a deep identity traversal *) + | e -> default_mapper.expr mapper e + [@@raises Invalid_argument] + in - { default_mapper with structure; expr; signature; module_binding; } + let module_binding mapper module_binding = + let _ = nestedModules := module_binding.pmb_name.txt :: !nestedModules in + let mapped = default_mapper.module_binding mapper module_binding in + let _ = nestedModules := List.tl !nestedModules in + mapped + [@@raises Failure] + in + { default_mapper with structure; expr; signature; module_binding } + [@@raises Invalid_argument, Failure] -let rewrite_implementation (code: Parsetree.structure) : Parsetree.structure = +let rewrite_implementation (code : Parsetree.structure) : Parsetree.structure = let mapper = jsxMapper () in mapper.structure mapper code + [@@raises Invalid_argument, Failure] + let rewrite_signature (code : Parsetree.signature) : Parsetree.signature = let mapper = jsxMapper () in mapper.signature mapper code - + [@@raises Invalid_argument, Failure] end module Ppx_entry @@ -417499,6 +417448,12 @@ let rec isBlockExpr expr = | Pexp_setfield (expr, _, _) when isBlockExpr expr -> true | _ -> false +let isIfThenElseExpr expr = + let open Parsetree in + match expr.pexp_desc with + | Pexp_ifthenelse _ -> true + | _ -> false + let rec walkStructure s t comments = match s with | _ when comments = [] -> () @@ -418285,7 +418240,7 @@ let rec walkStructure s t comments = begin match elseExpr with | None -> () | Some expr -> - if isBlockExpr expr then + if isBlockExpr expr || isIfThenElseExpr expr then walkExpr expr t comments else ( let (leading, inside, trailing) = partitionByLoc comments expr.pexp_loc in @@ -419614,7 +419569,7 @@ type t = let toString = function | OpenDescription -> "an open description" - | ModuleLongIdent -> "a module identifier" + | ModuleLongIdent -> "a module path" | Ternary -> "a ternary expression" | Es6ArrowExpr -> "an es6 arrow function" | Jsx -> "a jsx expression" @@ -419999,7 +419954,7 @@ let explain t = let token = Token.toString t in "`" ^ token ^ "` is a reserved keyword." | _ -> - "At this point, I'm looking for an uppercased identifier like `Belt` or `Array`" + "At this point, I'm looking for an uppercased name like `Belt` or `Array`" end | Lident currentToken -> begin match currentToken with @@ -420012,7 +419967,7 @@ let explain t = | Underscore -> "`_` isn't a valid name." | _ -> - "I'm expecting an lowercased identifier like `name` or `age`" + "I'm expecting a lowercase name like `user or `age`" end | Message txt -> txt | UnclosedString -> @@ -420060,7 +420015,7 @@ let explain t = "Did you forget to write an expression here?" | (Grammar.LetBinding, _)::_, _ -> "This let-binding misses an expression" - | _::_, (Rbracket | Rbrace) -> + | _::_, (Rbracket | Rbrace | Eof) -> "Missing expression" | _ -> "I'm not sure what to parse here when looking at \"" ^ name ^ "\"." @@ -421288,6 +421243,9 @@ val bracedExpr: Parsetree.expression -> bool val callExpr: Parsetree.expression -> kind val includeModExpr : Parsetree.module_expr -> bool + +val arrowReturnTypExpr: Parsetree.core_type -> bool + end = struct #1 "res_parens.ml" module ParsetreeViewer = Res_parsetree_viewer @@ -421695,6 +421653,10 @@ type kind = Parenthesized | Braced of Location.t | Nothing | Parsetree.Pmod_constraint _ -> true | _ -> false +let arrowReturnTypExpr typExpr = match typExpr.Parsetree.ptyp_desc with + | Parsetree.Ptyp_arrow _ -> true + | _ -> false + end module Res_printer : sig #1 "res_printer.mli" @@ -424005,7 +423967,12 @@ and printPattern (p : Parsetree.pattern) cmtTbl = | _ -> patternDoc ] ) orChain in - Doc.group (Doc.concat docs) + let isSpreadOverMultipleLines = match (orChain, List.rev orChain) with + | first::_, last::_ -> + first.ppat_loc.loc_start.pos_lnum < last.ppat_loc.loc_end.pos_lnum + | _ -> false + in + Doc.breakableGroup ~forceBreak:isSpreadOverMultipleLines (Doc.concat docs) | Ppat_extension ext -> printExtension ~atModuleLvl:false ext cmtTbl | Ppat_lazy p -> @@ -424683,7 +424650,6 @@ and printExpression (e : Parsetree.expression) cmtTbl = | Pexp_let _ -> printExpressionBlock ~braces:true e cmtTbl | Pexp_fun (Nolabel, None, {ppat_desc = Ppat_var {txt="__x"}}, ({pexp_desc = Pexp_apply _})) -> - (* (__x) => f(a, __x, c) -----> f(a, _, c) *) printExpressionWithComments (ParsetreeViewer.rewriteUnderscoreApply e) cmtTbl | Pexp_fun _ | Pexp_newtype _ -> @@ -424754,7 +424720,15 @@ and printExpression (e : Parsetree.expression) cmtTbl = ) in let typConstraintDoc = match typConstraint with - | Some(typ) -> Doc.concat [Doc.text ": "; printTypExpr typ cmtTbl] + | Some(typ) -> + let typDoc = + let doc = printTypExpr typ cmtTbl in + if Parens.arrowReturnTypExpr typ then + addParens doc + else + doc + in + Doc.concat [Doc.text ": "; typDoc] | _ -> Doc.nil in let attrs = printAttributes attrs cmtTbl in @@ -426758,8 +426732,6 @@ let mkLoc startLoc endLoc = Location.{ } module Recover = struct - (* type action = unit option None is abort, Some () is retry *) - let defaultExpr () = let id = Location.mknoloc "rescript.exprhole" in Ast_helper.Exp.mk (Pexp_extension (id, PStr [])) @@ -426776,6 +426748,10 @@ module Recover = struct let defaultModuleExpr () = Ast_helper.Mod.structure [] let defaultModuleType () = Ast_helper.Mty.signature [] + let defaultSignatureItem = + let id = Location.mknoloc "rescript.sigitemhole" in + Ast_helper.Sig.extension (id, PStr []) + let recoverEqualGreater p = Parser.expect EqualGreater p; match p.Parser.token with @@ -426836,6 +426812,13 @@ Solution: directly use `concat`." let typeParam = "A type param consists of a singlequote followed by a name like `'a` or `'A`" let typeVar = "A type variable consists of a singlequote followed by a name like `'a` or `'A`" + + let attributeWithoutNode (attr : Parsetree.attribute) = + let ({Asttypes.txt = attrName}, _) = attr in + "Did you forget to attach `" ^ attrName ^ "` to an item?\n Standalone attributes start with `@@` like: `@@" ^ attrName ^"`" + + let typeDeclarationNameLongident longident = + "A type declaration's name cannot contain a module access. Did you mean `" ^ (Longident.last longident) ^"`?" end @@ -428711,7 +428694,7 @@ and parsePrimaryExpr ~operand ?(noCall=false) p = ~startPos:expr.pexp_loc.loc_start ~endPos:expr.pexp_loc.loc_end p - (Diagnostics.message "Tagged template literals are currently restricted to identifiers like: json`null`."); + (Diagnostics.message "Tagged template literals are currently restricted to names like: json`null`."); parseTemplateExpr p end | _ -> expr @@ -429168,7 +429151,7 @@ and parseJsxName p = let longident = parseModuleLongIdent ~lowercase:true p in Location.mkloc (Longident.Ldot (longident.txt, "createElement")) longident.loc | _ -> - let msg = "A jsx name should start with a lowercase or uppercase identifier, like: div in
or Navbar in " + let msg = "A jsx name must be a lowercase or uppercase name, like: div in
or Navbar in " in Parser.err p (Diagnostics.message msg); Location.mknoloc (Longident.Lident "_") @@ -429320,7 +429303,7 @@ and parseJsxProp p = | _ -> let attrExpr = Ast_helper.Exp.ident ~loc ~attrs:[propLocAttr] - (Location.mknoloc (Longident.Lident name)) in + (Location.mkloc (Longident.Lident name) loc) in let label = if optional then Asttypes.Optional name else Asttypes.Labelled name in @@ -431687,6 +431670,13 @@ and parseTypeDefinitionOrExtension ~attrs p = | PlusEqual -> TypeExt(parseTypeExtension ~params ~attrs ~name p) | _ -> + (* shape of type name should be Lident, i.e. `t` is accepted. `User.t` not *) + let () = match name.Location.txt with + | Lident _ -> () + | longident -> + Parser.err ~startPos:name.loc.loc_start ~endPos:name.loc.loc_end p + (longident |> ErrorMessages.typeDeclarationNameLongident |> Diagnostics.message) + in let typeDefs = parseTypeDefinitions ~attrs ~name ~params ~startPos p in TypeDef {recFlag; types = typeDefs} @@ -431837,9 +431827,11 @@ and parseStructureItemRegion p = let loc = mkLoc startPos p.prevEndPos in Some {structureItem with pstr_loc = loc} | Module -> + Parser.beginRegion p; let structureItem = parseModuleOrModuleTypeImplOrPackExpr ~attrs p in parseNewlineOrSemicolonStructure p; let loc = mkLoc startPos p.prevEndPos in + Parser.endRegion p; Some {structureItem with pstr_loc = loc} | AtAt -> let attr = parseStandaloneAttribute p in @@ -431857,7 +431849,19 @@ and parseStructureItemRegion p = parseNewlineOrSemicolonStructure p; let loc = mkLoc startPos p.prevEndPos in Parser.checkProgress ~prevEndPos ~result:(Ast_helper.Str.eval ~loc ~attrs exp) p - | _ -> None + | _ -> + begin match attrs with + | (({Asttypes.loc = attrLoc}, _) as attr)::_ -> + Parser.err + ~startPos:attrLoc.loc_start + ~endPos:attrLoc.loc_end + p + (Diagnostics.message (ErrorMessages.attributeWithoutNode attr)); + let expr = parseExpr p in + Some (Ast_helper.Str.eval ~loc:(mkLoc p.startPos p.prevEndPos) ~attrs expr) + | _ -> + None + end and parseJsImport ~startPos ~attrs p = Parser.expect Token.Import p; @@ -432558,24 +432562,30 @@ and parseSignatureItemRegion p = let loc = mkLoc startPos p.prevEndPos in Some (Ast_helper.Sig.include_ ~loc includeDescription) | Module -> + Parser.beginRegion p; Parser.next p; begin match p.Parser.token with | Uident _ -> let modDecl = parseModuleDeclarationOrAlias ~attrs p in parseNewlineOrSemicolonSignature p; let loc = mkLoc startPos p.prevEndPos in + Parser.endRegion p; Some (Ast_helper.Sig.module_ ~loc modDecl) | Rec -> let recModule = parseRecModuleSpec ~attrs ~startPos p in parseNewlineOrSemicolonSignature p; let loc = mkLoc startPos p.prevEndPos in + Parser.endRegion p; Some (Ast_helper.Sig.rec_module ~loc recModule) | Typ -> - Some (parseModuleTypeDeclaration ~attrs ~startPos p) + let modTypeDecl = parseModuleTypeDeclaration ~attrs ~startPos p in + Parser.endRegion p; + Some modTypeDecl | _t -> let modDecl = parseModuleDeclarationOrAlias ~attrs p in parseNewlineOrSemicolonSignature p; let loc = mkLoc startPos p.prevEndPos in + Parser.endRegion p; Some (Ast_helper.Sig.module_ ~loc modDecl) end | AtAt -> @@ -432592,7 +432602,17 @@ and parseSignatureItemRegion p = Parser.next p; parseSignatureItemRegion p | _ -> - None + begin match attrs with + | (({Asttypes.loc = attrLoc}, _) as attr)::_ -> + Parser.err + ~startPos:attrLoc.loc_start + ~endPos:attrLoc.loc_end + p + (Diagnostics.message (ErrorMessages.attributeWithoutNode attr)); + Some Recover.defaultSignatureItem + | _ -> + None + end (* module rec module-name : module-type { and module-name: module-type } *) and parseRecModuleSpec ~attrs ~startPos p = @@ -432695,8 +432715,7 @@ and parseSignLetDesc ~attrs p = (* attr-id ::= lowercase-ident ∣ capitalized-ident ∣ attr-id . attr-id *) -and parseAttributeId p = - let startPos = p.Parser.startPos in +and parseAttributeId ~startPos p = let rec loop p acc = match p.Parser.token with | Lident ident | Uident ident -> @@ -432779,8 +432798,9 @@ and parsePayload p = and parseAttribute p = match p.Parser.token with | At -> + let startPos = p.startPos in Parser.next p; - let attrId = parseAttributeId p in + let attrId = parseAttributeId ~startPos p in let payload = parsePayload p in Some(attrId, payload) | _ -> None @@ -432796,8 +432816,9 @@ and parseAttributes p = * | @@ attribute-id ( structure-item ) *) and parseStandaloneAttribute p = + let startPos = p.startPos in Parser.expect AtAt p; - let attrId = parseAttributeId p in + let attrId = parseAttributeId ~startPos p in let payload = parsePayload p in (attrId, payload) @@ -432835,11 +432856,12 @@ and parseStandaloneAttribute p = * ~moduleLanguage represents whether we're on the module level or not *) and parseExtension ?(moduleLanguage=false) p = + let startPos = p.Parser.startPos in if moduleLanguage then Parser.expect PercentPercent p else Parser.expect Percent p; - let attrId = parseAttributeId p in + let attrId = parseAttributeId ~startPos p in let payload = parsePayload p in (attrId, payload) @@ -433533,7 +433555,7 @@ let normalize = structure_item = begin fun mapper structureItem -> match structureItem.pstr_desc with (* heuristic: if we have multiple type declarations, mark them recursive *) - | Pstr_type (recFlag, typeDeclarations) -> + | Pstr_type (Recursive as recFlag, typeDeclarations) -> let flag = match typeDeclarations with | [td] -> if looksLikeRecursiveTypeDeclaration td then Asttypes.Recursive @@ -433551,7 +433573,7 @@ let normalize = signature_item = begin fun mapper signatureItem -> match signatureItem.psig_desc with (* heuristic: if we have multiple type declarations, mark them recursive *) - | Psig_type (recFlag, typeDeclarations) -> + | Psig_type (Recursive as recFlag, typeDeclarations) -> let flag = match typeDeclarations with | [td] -> if looksLikeRecursiveTypeDeclaration td then Asttypes.Recursive diff --git a/lib/4.06.1/whole_compiler.ml.d b/lib/4.06.1/whole_compiler.ml.d index 850e6421a8..3650d5a99d 100644 --- a/lib/4.06.1/whole_compiler.ml.d +++ b/lib/4.06.1/whole_compiler.ml.d @@ -1 +1 @@ -../lib/4.06.1/whole_compiler.ml: ../ocaml/bytecomp/lambda.ml ../ocaml/bytecomp/lambda.mli ../ocaml/bytecomp/matching.ml ../ocaml/bytecomp/matching.mli ../ocaml/bytecomp/printlambda.ml ../ocaml/bytecomp/printlambda.mli ../ocaml/bytecomp/switch.ml ../ocaml/bytecomp/switch.mli ../ocaml/bytecomp/translattribute.ml ../ocaml/bytecomp/translattribute.mli ../ocaml/bytecomp/translclass.ml ../ocaml/bytecomp/translclass.mli ../ocaml/bytecomp/translcore.ml ../ocaml/bytecomp/translcore.mli ../ocaml/bytecomp/translmod.ml ../ocaml/bytecomp/translmod.mli ../ocaml/bytecomp/translobj.ml ../ocaml/bytecomp/translobj.mli ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/ast_iterator.ml ../ocaml/parsing/ast_iterator.mli ../ocaml/parsing/ast_mapper.ml ../ocaml/parsing/ast_mapper.mli ../ocaml/parsing/asttypes.mli ../ocaml/parsing/attr_helper.ml ../ocaml/parsing/attr_helper.mli ../ocaml/parsing/builtin_attributes.ml ../ocaml/parsing/builtin_attributes.mli ../ocaml/parsing/depend.ml ../ocaml/parsing/depend.mli ../ocaml/parsing/docstrings.ml ../ocaml/parsing/docstrings.mli ../ocaml/parsing/lexer.ml ../ocaml/parsing/lexer.mli ../ocaml/parsing/location.ml ../ocaml/parsing/location.mli ../ocaml/parsing/longident.ml ../ocaml/parsing/longident.mli ../ocaml/parsing/parse.ml ../ocaml/parsing/parse.mli ../ocaml/parsing/parser.ml ../ocaml/parsing/parser.mli ../ocaml/parsing/parsetree.mli ../ocaml/parsing/pprintast.ml ../ocaml/parsing/pprintast.mli ../ocaml/parsing/printast.ml ../ocaml/parsing/printast.mli ../ocaml/parsing/syntaxerr.ml ../ocaml/parsing/syntaxerr.mli ../ocaml/typing/annot.mli ../ocaml/typing/btype.ml ../ocaml/typing/btype.mli ../ocaml/typing/cmi_format.ml ../ocaml/typing/cmi_format.mli ../ocaml/typing/cmt_format.ml ../ocaml/typing/cmt_format.mli ../ocaml/typing/ctype.ml ../ocaml/typing/ctype.mli ../ocaml/typing/datarepr.ml ../ocaml/typing/datarepr.mli ../ocaml/typing/env.ml ../ocaml/typing/env.mli ../ocaml/typing/ident.ml ../ocaml/typing/ident.mli ../ocaml/typing/includeclass.ml ../ocaml/typing/includeclass.mli ../ocaml/typing/includecore.ml ../ocaml/typing/includecore.mli ../ocaml/typing/includemod.ml ../ocaml/typing/includemod.mli ../ocaml/typing/mtype.ml ../ocaml/typing/mtype.mli ../ocaml/typing/oprint.ml ../ocaml/typing/oprint.mli ../ocaml/typing/outcometree.mli ../ocaml/typing/parmatch.ml ../ocaml/typing/parmatch.mli ../ocaml/typing/path.ml ../ocaml/typing/path.mli ../ocaml/typing/predef.ml ../ocaml/typing/predef.mli ../ocaml/typing/primitive.ml ../ocaml/typing/primitive.mli ../ocaml/typing/printtyp.ml ../ocaml/typing/printtyp.mli ../ocaml/typing/printtyped.ml ../ocaml/typing/printtyped.mli ../ocaml/typing/stypes.ml ../ocaml/typing/stypes.mli ../ocaml/typing/subst.ml ../ocaml/typing/subst.mli ../ocaml/typing/tast_mapper.ml ../ocaml/typing/tast_mapper.mli ../ocaml/typing/typeclass.ml ../ocaml/typing/typeclass.mli ../ocaml/typing/typecore.ml ../ocaml/typing/typecore.mli ../ocaml/typing/typedecl.ml ../ocaml/typing/typedecl.mli ../ocaml/typing/typedtree.ml ../ocaml/typing/typedtree.mli ../ocaml/typing/typedtreeIter.ml ../ocaml/typing/typedtreeIter.mli ../ocaml/typing/typemod.ml ../ocaml/typing/typemod.mli ../ocaml/typing/typeopt.ml ../ocaml/typing/typeopt.mli ../ocaml/typing/types.ml ../ocaml/typing/types.mli ../ocaml/typing/typetexp.ml ../ocaml/typing/typetexp.mli ../ocaml/typing/untypeast.ml ../ocaml/typing/untypeast.mli ../ocaml/utils/arg_helper.ml ../ocaml/utils/arg_helper.mli ../ocaml/utils/ccomp.ml ../ocaml/utils/ccomp.mli ../ocaml/utils/clflags.ml ../ocaml/utils/clflags.mli ../ocaml/utils/consistbl.ml ../ocaml/utils/consistbl.mli ../ocaml/utils/identifiable.ml ../ocaml/utils/identifiable.mli ../ocaml/utils/misc.ml ../ocaml/utils/misc.mli ../ocaml/utils/numbers.ml ../ocaml/utils/numbers.mli ../ocaml/utils/profile.ml ../ocaml/utils/profile.mli ../ocaml/utils/tbl.ml ../ocaml/utils/tbl.mli ../ocaml/utils/warnings.ml ../ocaml/utils/warnings.mli ./common/bs_loc.ml ./common/bs_loc.mli ./common/bs_version.ml ./common/bs_version.mli ./common/bs_warnings.ml ./common/bs_warnings.mli ./common/ext_log.ml ./common/ext_log.mli ./common/js_config.ml ./common/js_config.mli ./common/lam_methname.ml ./common/lam_methname.mli ./common/ml_binary.ml ./common/ml_binary.mli ./core/bs_cmi_load.ml ./core/bs_conditional_initial.ml ./core/bs_conditional_initial.mli ./core/cmd_ast_exception.ml ./core/cmd_ppx_apply.ml ./core/compile_rec_module.ml ./core/config_util.ml ./core/config_util.mli ./core/config_whole_compiler.ml ./core/config_whole_compiler.mli ./core/j.ml ./core/js_analyzer.ml ./core/js_analyzer.mli ./core/js_arr.ml ./core/js_arr.mli ./core/js_ast_util.ml ./core/js_ast_util.mli ./core/js_block_runtime.ml ./core/js_block_runtime.mli ./core/js_call_info.ml ./core/js_call_info.mli ./core/js_closure.ml ./core/js_closure.mli ./core/js_cmj_format.ml ./core/js_cmj_format.mli ./core/js_cmj_load.ml ./core/js_cmj_load.mli ./core/js_cmj_load_builtin_unit.ml ./core/js_dump.ml ./core/js_dump.mli ./core/js_dump_import_export.ml ./core/js_dump_import_export.mli ./core/js_dump_lit.ml ./core/js_dump_program.ml ./core/js_dump_program.mli ./core/js_dump_property.ml ./core/js_dump_property.mli ./core/js_dump_string.ml ./core/js_dump_string.mli ./core/js_exp_make.ml ./core/js_exp_make.mli ./core/js_fold.ml ./core/js_fold_basic.ml ./core/js_fold_basic.mli ./core/js_fun_env.ml ./core/js_fun_env.mli ./core/js_implementation.ml ./core/js_implementation.mli ./core/js_long.ml ./core/js_long.mli ./core/js_map.ml ./core/js_name_of_module_id.ml ./core/js_name_of_module_id.mli ./core/js_number.ml ./core/js_number.mli ./core/js_of_lam_array.ml ./core/js_of_lam_array.mli ./core/js_of_lam_block.ml ./core/js_of_lam_block.mli ./core/js_of_lam_exception.ml ./core/js_of_lam_exception.mli ./core/js_of_lam_option.ml ./core/js_of_lam_option.mli ./core/js_of_lam_string.ml ./core/js_of_lam_string.mli ./core/js_of_lam_variant.ml ./core/js_of_lam_variant.mli ./core/js_op.ml ./core/js_op_util.ml ./core/js_op_util.mli ./core/js_output.ml ./core/js_output.mli ./core/js_packages_info.ml ./core/js_packages_info.mli ./core/js_packages_state.ml ./core/js_packages_state.mli ./core/js_pass_debug.ml ./core/js_pass_debug.mli ./core/js_pass_flatten.ml ./core/js_pass_flatten.mli ./core/js_pass_flatten_and_mark_dead.ml ./core/js_pass_flatten_and_mark_dead.mli ./core/js_pass_get_used.ml ./core/js_pass_get_used.mli ./core/js_pass_scope.ml ./core/js_pass_scope.mli ./core/js_pass_tailcall_inline.ml ./core/js_pass_tailcall_inline.mli ./core/js_raw_info.ml ./core/js_shake.ml ./core/js_shake.mli ./core/js_stmt_make.ml ./core/js_stmt_make.mli ./core/lam.ml ./core/lam.mli ./core/lam_analysis.ml ./core/lam_analysis.mli ./core/lam_arity.ml ./core/lam_arity.mli ./core/lam_arity_analysis.ml ./core/lam_arity_analysis.mli ./core/lam_beta_reduce.ml ./core/lam_beta_reduce.mli ./core/lam_beta_reduce_util.ml ./core/lam_beta_reduce_util.mli ./core/lam_bounded_vars.ml ./core/lam_bounded_vars.mli ./core/lam_closure.ml ./core/lam_closure.mli ./core/lam_coercion.ml ./core/lam_coercion.mli ./core/lam_compat.ml ./core/lam_compat.mli ./core/lam_compile.ml ./core/lam_compile.mli ./core/lam_compile_const.ml ./core/lam_compile_const.mli ./core/lam_compile_context.ml ./core/lam_compile_context.mli ./core/lam_compile_env.ml ./core/lam_compile_env.mli ./core/lam_compile_external_call.ml ./core/lam_compile_external_call.mli ./core/lam_compile_external_obj.ml ./core/lam_compile_external_obj.mli ./core/lam_compile_main.ml ./core/lam_compile_main.mli ./core/lam_compile_primitive.ml ./core/lam_compile_primitive.mli ./core/lam_compile_util.ml ./core/lam_compile_util.mli ./core/lam_constant.ml ./core/lam_constant.mli ./core/lam_constant_convert.ml ./core/lam_constant_convert.mli ./core/lam_convert.ml ./core/lam_convert.mli ./core/lam_dce.ml ./core/lam_dce.mli ./core/lam_dispatch_primitive.ml ./core/lam_dispatch_primitive.mli ./core/lam_eta_conversion.ml ./core/lam_eta_conversion.mli ./core/lam_exit_code.ml ./core/lam_exit_code.mli ./core/lam_exit_count.ml ./core/lam_exit_count.mli ./core/lam_free_variables.ml ./core/lam_free_variables.mli ./core/lam_group.ml ./core/lam_group.mli ./core/lam_hit.ml ./core/lam_hit.mli ./core/lam_id_kind.ml ./core/lam_id_kind.mli ./core/lam_iter.ml ./core/lam_iter.mli ./core/lam_module_ident.ml ./core/lam_module_ident.mli ./core/lam_pass_alpha_conversion.ml ./core/lam_pass_alpha_conversion.mli ./core/lam_pass_collect.ml ./core/lam_pass_collect.mli ./core/lam_pass_count.ml ./core/lam_pass_count.mli ./core/lam_pass_deep_flatten.ml ./core/lam_pass_deep_flatten.mli ./core/lam_pass_eliminate_ref.ml ./core/lam_pass_eliminate_ref.mli ./core/lam_pass_exits.ml ./core/lam_pass_exits.mli ./core/lam_pass_lets_dce.ml ./core/lam_pass_lets_dce.mli ./core/lam_pass_remove_alias.ml ./core/lam_pass_remove_alias.mli ./core/lam_pointer_info.ml ./core/lam_pointer_info.mli ./core/lam_primitive.ml ./core/lam_primitive.mli ./core/lam_print.ml ./core/lam_print.mli ./core/lam_scc.ml ./core/lam_scc.mli ./core/lam_stats.ml ./core/lam_stats.mli ./core/lam_stats_export.ml ./core/lam_stats_export.mli ./core/lam_subst.ml ./core/lam_subst.mli ./core/lam_tag_info.ml ./core/lam_util.ml ./core/lam_util.mli ./core/lam_var_stats.ml ./core/lam_var_stats.mli ./core/matching_polyfill.ml ./core/matching_polyfill.mli ./core/polyvar_pattern_match.ml ./core/pparse_driver.ml ./core/pparse_driver.mli ./core/record_attributes_check.ml ./core/res_compmisc.ml ./core/res_compmisc.mli ./core/transl_single_field_record.ml ./depends/ast_extract.ml ./depends/ast_extract.mli ./depends/binary_ast.ml ./depends/binary_ast.mli ./depends/bs_exception.ml ./depends/bs_exception.mli ./ext/bsc_args.ml ./ext/bsc_args.mli ./ext/bsc_warnings.ml ./ext/ext_array.ml ./ext/ext_array.mli ./ext/ext_buffer.ml ./ext/ext_buffer.mli ./ext/ext_bytes.ml ./ext/ext_bytes.mli ./ext/ext_char.ml ./ext/ext_char.mli ./ext/ext_digest.ml ./ext/ext_digest.mli ./ext/ext_file_extensions.ml ./ext/ext_filename.ml ./ext/ext_filename.mli ./ext/ext_fmt.ml ./ext/ext_ident.ml ./ext/ext_ident.mli ./ext/ext_int.ml ./ext/ext_int.mli ./ext/ext_io.ml ./ext/ext_io.mli ./ext/ext_js_file_kind.ml ./ext/ext_js_suffix.ml ./ext/ext_list.ml ./ext/ext_list.mli ./ext/ext_marshal.ml ./ext/ext_marshal.mli ./ext/ext_modulename.ml ./ext/ext_modulename.mli ./ext/ext_namespace.ml ./ext/ext_namespace.mli ./ext/ext_namespace_encode.ml ./ext/ext_namespace_encode.mli ./ext/ext_option.ml ./ext/ext_option.mli ./ext/ext_path.ml ./ext/ext_path.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli ./ext/ext_pp.ml ./ext/ext_pp.mli ./ext/ext_pp_scope.ml ./ext/ext_pp_scope.mli ./ext/ext_ref.ml ./ext/ext_ref.mli ./ext/ext_scc.ml ./ext/ext_scc.mli ./ext/ext_spec.ml ./ext/ext_spec.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_string_array.ml ./ext/ext_string_array.mli ./ext/ext_sys.ml ./ext/ext_sys.mli ./ext/ext_utf8.ml ./ext/ext_utf8.mli ./ext/ext_util.ml ./ext/ext_util.mli ./ext/hash.ml ./ext/hash.mli ./ext/hash_gen.ml ./ext/hash_ident.ml ./ext/hash_ident.mli ./ext/hash_int.ml ./ext/hash_int.mli ./ext/hash_set.ml ./ext/hash_set.mli ./ext/hash_set_gen.ml ./ext/hash_set_ident.ml ./ext/hash_set_ident.mli ./ext/hash_set_ident_mask.ml ./ext/hash_set_ident_mask.mli ./ext/hash_set_poly.ml ./ext/hash_set_poly.mli ./ext/hash_set_string.ml ./ext/hash_set_string.mli ./ext/hash_string.ml ./ext/hash_string.mli ./ext/int_vec_util.ml ./ext/int_vec_util.mli ./ext/int_vec_vec.ml ./ext/int_vec_vec.mli ./ext/js_reserved_map.ml ./ext/js_reserved_map.mli ./ext/js_runtime_modules.ml ./ext/literals.ml ./ext/map_gen.ml ./ext/map_gen.mli ./ext/map_ident.ml ./ext/map_ident.mli ./ext/map_int.ml ./ext/map_int.mli ./ext/map_string.ml ./ext/map_string.mli ./ext/ordered_hash_map_gen.ml ./ext/ordered_hash_map_local_ident.ml ./ext/ordered_hash_map_local_ident.mli ./ext/set_gen.ml ./ext/set_gen.mli ./ext/set_ident.ml ./ext/set_ident.mli ./ext/set_string.ml ./ext/set_string.mli ./ext/vec.ml ./ext/vec.mli ./ext/vec_gen.ml ./ext/vec_int.ml ./ext/vec_int.mli ./js_parser/declaration_parser.ml ./js_parser/enum_common.ml ./js_parser/enum_parser.ml ./js_parser/expression_parser.ml ./js_parser/file_key.ml ./js_parser/flow_ast.ml ./js_parser/flow_ast_utils.ml ./js_parser/flow_ast_utils.mli ./js_parser/flow_lexer.ml ./js_parser/flow_lexer.mli ./js_parser/jsx_parser.ml ./js_parser/lex_env.ml ./js_parser/lex_result.ml ./js_parser/loc.ml ./js_parser/loc.mli ./js_parser/object_parser.ml ./js_parser/parse_error.ml ./js_parser/parser_common.ml ./js_parser/parser_env.ml ./js_parser/parser_env.mli ./js_parser/parser_flow.ml ./js_parser/pattern_cover.ml ./js_parser/pattern_parser.ml ./js_parser/sedlexing.ml ./js_parser/sedlexing.mli ./js_parser/statement_parser.ml ./js_parser/token.ml ./js_parser/type_parser.ml ./js_parser/wtf8.ml ./js_parser/wtf8.mli ./main/builtin_cmi_datasets.ml ./main/builtin_cmi_datasets.mli ./main/builtin_cmj_datasets.ml ./main/builtin_cmj_datasets.mli ./main/js_main.ml ./main/js_main.mli ./napkin/res_ast_conversion.ml ./napkin/res_ast_conversion.mli ./napkin/res_character_codes.ml ./napkin/res_comment.ml ./napkin/res_comment.mli ./napkin/res_comments_table.ml ./napkin/res_core.ml ./napkin/res_core.mli ./napkin/res_diagnostics.ml ./napkin/res_diagnostics.mli ./napkin/res_diagnostics_printing_utils.ml ./napkin/res_doc.ml ./napkin/res_doc.mli ./napkin/res_driver.ml ./napkin/res_driver.mli ./napkin/res_driver_ml_parser.ml ./napkin/res_driver_ml_parser.mli ./napkin/res_driver_reason_binary.ml ./napkin/res_driver_reason_binary.mli ./napkin/res_grammar.ml ./napkin/res_io.ml ./napkin/res_io.mli ./napkin/res_js_ffi.ml ./napkin/res_minibuffer.ml ./napkin/res_minibuffer.mli ./napkin/res_multi_printer.ml ./napkin/res_multi_printer.mli ./napkin/res_outcome_printer.ml ./napkin/res_outcome_printer.mli ./napkin/res_parens.ml ./napkin/res_parens.mli ./napkin/res_parser.ml ./napkin/res_parser.mli ./napkin/res_parsetree_viewer.ml ./napkin/res_parsetree_viewer.mli ./napkin/res_printer.ml ./napkin/res_printer.mli ./napkin/res_reporting.ml ./napkin/res_scanner.ml ./napkin/res_scanner.mli ./napkin/res_token.ml ./outcome_printer/outcome_printer_ns.ml ./outcome_printer/outcome_printer_ns.mli ./outcome_printer/reason_outcome_printer_main.ml ./outcome_printer/reason_syntax_util.ml ./outcome_printer/reason_syntax_util.mli ./outcome_printer/tweaked_reason_oprint.ml ./stubs/bs_hash_stubs.ml ./super_errors/super_env.ml ./super_errors/super_location.ml ./super_errors/super_location.mli ./super_errors/super_main.ml ./super_errors/super_misc.ml ./super_errors/super_misc.mli ./super_errors/super_pparse.ml ./super_errors/super_typecore.ml ./super_errors/super_typemod.ml ./super_errors/super_typetexp.ml ./syntax/ast_attributes.ml ./syntax/ast_attributes.mli ./syntax/ast_bs_open.ml ./syntax/ast_bs_open.mli ./syntax/ast_comb.ml ./syntax/ast_comb.mli ./syntax/ast_compatible.ml ./syntax/ast_compatible.mli ./syntax/ast_config.ml ./syntax/ast_config.mli ./syntax/ast_core_type.ml ./syntax/ast_core_type.mli ./syntax/ast_core_type_class_type.ml ./syntax/ast_core_type_class_type.mli ./syntax/ast_derive.ml ./syntax/ast_derive.mli ./syntax/ast_derive_abstract.ml ./syntax/ast_derive_abstract.mli ./syntax/ast_derive_js_mapper.ml ./syntax/ast_derive_js_mapper.mli ./syntax/ast_derive_projector.ml ./syntax/ast_derive_projector.mli ./syntax/ast_derive_util.ml ./syntax/ast_derive_util.mli ./syntax/ast_exp.ml ./syntax/ast_exp.mli ./syntax/ast_exp_apply.ml ./syntax/ast_exp_apply.mli ./syntax/ast_exp_extension.ml ./syntax/ast_exp_extension.mli ./syntax/ast_exp_handle_external.ml ./syntax/ast_exp_handle_external.mli ./syntax/ast_external.ml ./syntax/ast_external.mli ./syntax/ast_external_mk.ml ./syntax/ast_external_mk.mli ./syntax/ast_external_process.ml ./syntax/ast_external_process.mli ./syntax/ast_literal.ml ./syntax/ast_literal.mli ./syntax/ast_open_cxt.ml ./syntax/ast_open_cxt.mli ./syntax/ast_pat.ml ./syntax/ast_pat.mli ./syntax/ast_payload.ml ./syntax/ast_payload.mli ./syntax/ast_polyvar.ml ./syntax/ast_polyvar.mli ./syntax/ast_reason_pp.ml ./syntax/ast_reason_pp.mli ./syntax/ast_signature.ml ./syntax/ast_signature.mli ./syntax/ast_structure.ml ./syntax/ast_structure.mli ./syntax/ast_tdcls.ml ./syntax/ast_tdcls.mli ./syntax/ast_tuple_pattern_flatten.ml ./syntax/ast_tuple_pattern_flatten.mli ./syntax/ast_typ_uncurry.ml ./syntax/ast_typ_uncurry.mli ./syntax/ast_uncurry_apply.ml ./syntax/ast_uncurry_apply.mli ./syntax/ast_uncurry_gen.ml ./syntax/ast_uncurry_gen.mli ./syntax/ast_utf8_string.ml ./syntax/ast_utf8_string.mli ./syntax/ast_utf8_string_interp.ml ./syntax/ast_utf8_string_interp.mli ./syntax/ast_util.ml ./syntax/ast_util.mli ./syntax/bs_ast_invariant.ml ./syntax/bs_ast_invariant.mli ./syntax/bs_ast_mapper.ml ./syntax/bs_ast_mapper.mli ./syntax/bs_builtin_ppx.ml ./syntax/bs_builtin_ppx.mli ./syntax/bs_flow_ast_utils.ml ./syntax/bs_flow_ast_utils.mli ./syntax/bs_syntaxerr.ml ./syntax/bs_syntaxerr.mli ./syntax/classify_function.ml ./syntax/classify_function.mli ./syntax/external_arg_spec.ml ./syntax/external_arg_spec.mli ./syntax/external_ffi_types.ml ./syntax/external_ffi_types.mli ./syntax/ppx_apply.ml ./syntax/ppx_entry.ml ./syntax/reactjs_jsx_ppx_v3.ml ./syntax/typemod_hide.ml \ No newline at end of file +../lib/4.06.1/whole_compiler.ml: ../ocaml/bytecomp/lambda.ml ../ocaml/bytecomp/lambda.mli ../ocaml/bytecomp/matching.ml ../ocaml/bytecomp/matching.mli ../ocaml/bytecomp/printlambda.ml ../ocaml/bytecomp/printlambda.mli ../ocaml/bytecomp/switch.ml ../ocaml/bytecomp/switch.mli ../ocaml/bytecomp/translattribute.ml ../ocaml/bytecomp/translattribute.mli ../ocaml/bytecomp/translclass.ml ../ocaml/bytecomp/translclass.mli ../ocaml/bytecomp/translcore.ml ../ocaml/bytecomp/translcore.mli ../ocaml/bytecomp/translmod.ml ../ocaml/bytecomp/translmod.mli ../ocaml/bytecomp/translobj.ml ../ocaml/bytecomp/translobj.mli ../ocaml/parsing/ast_helper.ml ../ocaml/parsing/ast_helper.mli ../ocaml/parsing/ast_iterator.ml ../ocaml/parsing/ast_iterator.mli ../ocaml/parsing/ast_mapper.ml ../ocaml/parsing/ast_mapper.mli ../ocaml/parsing/asttypes.mli ../ocaml/parsing/attr_helper.ml ../ocaml/parsing/attr_helper.mli ../ocaml/parsing/builtin_attributes.ml ../ocaml/parsing/builtin_attributes.mli ../ocaml/parsing/depend.ml ../ocaml/parsing/depend.mli ../ocaml/parsing/docstrings.ml ../ocaml/parsing/docstrings.mli ../ocaml/parsing/lexer.ml ../ocaml/parsing/lexer.mli ../ocaml/parsing/location.ml ../ocaml/parsing/location.mli ../ocaml/parsing/longident.ml ../ocaml/parsing/longident.mli ../ocaml/parsing/parse.ml ../ocaml/parsing/parse.mli ../ocaml/parsing/parser.ml ../ocaml/parsing/parser.mli ../ocaml/parsing/parsetree.mli ../ocaml/parsing/pprintast.ml ../ocaml/parsing/pprintast.mli ../ocaml/parsing/printast.ml ../ocaml/parsing/printast.mli ../ocaml/parsing/syntaxerr.ml ../ocaml/parsing/syntaxerr.mli ../ocaml/typing/annot.mli ../ocaml/typing/btype.ml ../ocaml/typing/btype.mli ../ocaml/typing/cmi_format.ml ../ocaml/typing/cmi_format.mli ../ocaml/typing/cmt_format.ml ../ocaml/typing/cmt_format.mli ../ocaml/typing/ctype.ml ../ocaml/typing/ctype.mli ../ocaml/typing/datarepr.ml ../ocaml/typing/datarepr.mli ../ocaml/typing/env.ml ../ocaml/typing/env.mli ../ocaml/typing/ident.ml ../ocaml/typing/ident.mli ../ocaml/typing/includeclass.ml ../ocaml/typing/includeclass.mli ../ocaml/typing/includecore.ml ../ocaml/typing/includecore.mli ../ocaml/typing/includemod.ml ../ocaml/typing/includemod.mli ../ocaml/typing/mtype.ml ../ocaml/typing/mtype.mli ../ocaml/typing/oprint.ml ../ocaml/typing/oprint.mli ../ocaml/typing/outcometree.mli ../ocaml/typing/parmatch.ml ../ocaml/typing/parmatch.mli ../ocaml/typing/path.ml ../ocaml/typing/path.mli ../ocaml/typing/predef.ml ../ocaml/typing/predef.mli ../ocaml/typing/primitive.ml ../ocaml/typing/primitive.mli ../ocaml/typing/printtyp.ml ../ocaml/typing/printtyp.mli ../ocaml/typing/printtyped.ml ../ocaml/typing/printtyped.mli ../ocaml/typing/stypes.ml ../ocaml/typing/stypes.mli ../ocaml/typing/subst.ml ../ocaml/typing/subst.mli ../ocaml/typing/tast_mapper.ml ../ocaml/typing/tast_mapper.mli ../ocaml/typing/typeclass.ml ../ocaml/typing/typeclass.mli ../ocaml/typing/typecore.ml ../ocaml/typing/typecore.mli ../ocaml/typing/typedecl.ml ../ocaml/typing/typedecl.mli ../ocaml/typing/typedtree.ml ../ocaml/typing/typedtree.mli ../ocaml/typing/typedtreeIter.ml ../ocaml/typing/typedtreeIter.mli ../ocaml/typing/typemod.ml ../ocaml/typing/typemod.mli ../ocaml/typing/typeopt.ml ../ocaml/typing/typeopt.mli ../ocaml/typing/types.ml ../ocaml/typing/types.mli ../ocaml/typing/typetexp.ml ../ocaml/typing/typetexp.mli ../ocaml/typing/untypeast.ml ../ocaml/typing/untypeast.mli ../ocaml/utils/arg_helper.ml ../ocaml/utils/arg_helper.mli ../ocaml/utils/ccomp.ml ../ocaml/utils/ccomp.mli ../ocaml/utils/clflags.ml ../ocaml/utils/clflags.mli ../ocaml/utils/consistbl.ml ../ocaml/utils/consistbl.mli ../ocaml/utils/identifiable.ml ../ocaml/utils/identifiable.mli ../ocaml/utils/misc.ml ../ocaml/utils/misc.mli ../ocaml/utils/numbers.ml ../ocaml/utils/numbers.mli ../ocaml/utils/profile.ml ../ocaml/utils/profile.mli ../ocaml/utils/tbl.ml ../ocaml/utils/tbl.mli ../ocaml/utils/warnings.ml ../ocaml/utils/warnings.mli ./common/bs_loc.ml ./common/bs_loc.mli ./common/bs_version.ml ./common/bs_version.mli ./common/bs_warnings.ml ./common/bs_warnings.mli ./common/ext_log.ml ./common/ext_log.mli ./common/js_config.ml ./common/js_config.mli ./common/lam_methname.ml ./common/lam_methname.mli ./common/ml_binary.ml ./common/ml_binary.mli ./core/bs_cmi_load.ml ./core/bs_conditional_initial.ml ./core/bs_conditional_initial.mli ./core/cmd_ast_exception.ml ./core/cmd_ppx_apply.ml ./core/compile_rec_module.ml ./core/config_util.ml ./core/config_util.mli ./core/config_whole_compiler.ml ./core/config_whole_compiler.mli ./core/j.ml ./core/js_analyzer.ml ./core/js_analyzer.mli ./core/js_arr.ml ./core/js_arr.mli ./core/js_ast_util.ml ./core/js_ast_util.mli ./core/js_block_runtime.ml ./core/js_block_runtime.mli ./core/js_call_info.ml ./core/js_call_info.mli ./core/js_closure.ml ./core/js_closure.mli ./core/js_cmj_format.ml ./core/js_cmj_format.mli ./core/js_cmj_load.ml ./core/js_cmj_load.mli ./core/js_cmj_load_builtin_unit.ml ./core/js_dump.ml ./core/js_dump.mli ./core/js_dump_import_export.ml ./core/js_dump_import_export.mli ./core/js_dump_lit.ml ./core/js_dump_program.ml ./core/js_dump_program.mli ./core/js_dump_property.ml ./core/js_dump_property.mli ./core/js_dump_string.ml ./core/js_dump_string.mli ./core/js_exp_make.ml ./core/js_exp_make.mli ./core/js_fold.ml ./core/js_fold_basic.ml ./core/js_fold_basic.mli ./core/js_fun_env.ml ./core/js_fun_env.mli ./core/js_implementation.ml ./core/js_implementation.mli ./core/js_long.ml ./core/js_long.mli ./core/js_map.ml ./core/js_name_of_module_id.ml ./core/js_name_of_module_id.mli ./core/js_number.ml ./core/js_number.mli ./core/js_of_lam_array.ml ./core/js_of_lam_array.mli ./core/js_of_lam_block.ml ./core/js_of_lam_block.mli ./core/js_of_lam_exception.ml ./core/js_of_lam_exception.mli ./core/js_of_lam_option.ml ./core/js_of_lam_option.mli ./core/js_of_lam_string.ml ./core/js_of_lam_string.mli ./core/js_of_lam_variant.ml ./core/js_of_lam_variant.mli ./core/js_op.ml ./core/js_op_util.ml ./core/js_op_util.mli ./core/js_output.ml ./core/js_output.mli ./core/js_packages_info.ml ./core/js_packages_info.mli ./core/js_packages_state.ml ./core/js_packages_state.mli ./core/js_pass_debug.ml ./core/js_pass_debug.mli ./core/js_pass_flatten.ml ./core/js_pass_flatten.mli ./core/js_pass_flatten_and_mark_dead.ml ./core/js_pass_flatten_and_mark_dead.mli ./core/js_pass_get_used.ml ./core/js_pass_get_used.mli ./core/js_pass_scope.ml ./core/js_pass_scope.mli ./core/js_pass_tailcall_inline.ml ./core/js_pass_tailcall_inline.mli ./core/js_raw_info.ml ./core/js_shake.ml ./core/js_shake.mli ./core/js_stmt_make.ml ./core/js_stmt_make.mli ./core/lam.ml ./core/lam.mli ./core/lam_analysis.ml ./core/lam_analysis.mli ./core/lam_arity.ml ./core/lam_arity.mli ./core/lam_arity_analysis.ml ./core/lam_arity_analysis.mli ./core/lam_beta_reduce.ml ./core/lam_beta_reduce.mli ./core/lam_beta_reduce_util.ml ./core/lam_beta_reduce_util.mli ./core/lam_bounded_vars.ml ./core/lam_bounded_vars.mli ./core/lam_closure.ml ./core/lam_closure.mli ./core/lam_coercion.ml ./core/lam_coercion.mli ./core/lam_compat.ml ./core/lam_compat.mli ./core/lam_compile.ml ./core/lam_compile.mli ./core/lam_compile_const.ml ./core/lam_compile_const.mli ./core/lam_compile_context.ml ./core/lam_compile_context.mli ./core/lam_compile_env.ml ./core/lam_compile_env.mli ./core/lam_compile_external_call.ml ./core/lam_compile_external_call.mli ./core/lam_compile_external_obj.ml ./core/lam_compile_external_obj.mli ./core/lam_compile_main.ml ./core/lam_compile_main.mli ./core/lam_compile_primitive.ml ./core/lam_compile_primitive.mli ./core/lam_compile_util.ml ./core/lam_compile_util.mli ./core/lam_constant.ml ./core/lam_constant.mli ./core/lam_constant_convert.ml ./core/lam_constant_convert.mli ./core/lam_convert.ml ./core/lam_convert.mli ./core/lam_dce.ml ./core/lam_dce.mli ./core/lam_dispatch_primitive.ml ./core/lam_dispatch_primitive.mli ./core/lam_eta_conversion.ml ./core/lam_eta_conversion.mli ./core/lam_exit_code.ml ./core/lam_exit_code.mli ./core/lam_exit_count.ml ./core/lam_exit_count.mli ./core/lam_free_variables.ml ./core/lam_free_variables.mli ./core/lam_group.ml ./core/lam_group.mli ./core/lam_hit.ml ./core/lam_hit.mli ./core/lam_id_kind.ml ./core/lam_id_kind.mli ./core/lam_iter.ml ./core/lam_iter.mli ./core/lam_module_ident.ml ./core/lam_module_ident.mli ./core/lam_pass_alpha_conversion.ml ./core/lam_pass_alpha_conversion.mli ./core/lam_pass_collect.ml ./core/lam_pass_collect.mli ./core/lam_pass_count.ml ./core/lam_pass_count.mli ./core/lam_pass_deep_flatten.ml ./core/lam_pass_deep_flatten.mli ./core/lam_pass_eliminate_ref.ml ./core/lam_pass_eliminate_ref.mli ./core/lam_pass_exits.ml ./core/lam_pass_exits.mli ./core/lam_pass_lets_dce.ml ./core/lam_pass_lets_dce.mli ./core/lam_pass_remove_alias.ml ./core/lam_pass_remove_alias.mli ./core/lam_pointer_info.ml ./core/lam_pointer_info.mli ./core/lam_primitive.ml ./core/lam_primitive.mli ./core/lam_print.ml ./core/lam_print.mli ./core/lam_scc.ml ./core/lam_scc.mli ./core/lam_stats.ml ./core/lam_stats.mli ./core/lam_stats_export.ml ./core/lam_stats_export.mli ./core/lam_subst.ml ./core/lam_subst.mli ./core/lam_tag_info.ml ./core/lam_util.ml ./core/lam_util.mli ./core/lam_var_stats.ml ./core/lam_var_stats.mli ./core/matching_polyfill.ml ./core/matching_polyfill.mli ./core/polyvar_pattern_match.ml ./core/pparse_driver.ml ./core/pparse_driver.mli ./core/record_attributes_check.ml ./core/res_compmisc.ml ./core/res_compmisc.mli ./core/transl_single_field_record.ml ./depends/ast_extract.ml ./depends/ast_extract.mli ./depends/binary_ast.ml ./depends/binary_ast.mli ./depends/bs_exception.ml ./depends/bs_exception.mli ./ext/bsc_args.ml ./ext/bsc_args.mli ./ext/bsc_warnings.ml ./ext/ext_array.ml ./ext/ext_array.mli ./ext/ext_buffer.ml ./ext/ext_buffer.mli ./ext/ext_bytes.ml ./ext/ext_bytes.mli ./ext/ext_char.ml ./ext/ext_char.mli ./ext/ext_digest.ml ./ext/ext_digest.mli ./ext/ext_file_extensions.ml ./ext/ext_filename.ml ./ext/ext_filename.mli ./ext/ext_fmt.ml ./ext/ext_ident.ml ./ext/ext_ident.mli ./ext/ext_int.ml ./ext/ext_int.mli ./ext/ext_io.ml ./ext/ext_io.mli ./ext/ext_js_file_kind.ml ./ext/ext_js_suffix.ml ./ext/ext_list.ml ./ext/ext_list.mli ./ext/ext_marshal.ml ./ext/ext_marshal.mli ./ext/ext_modulename.ml ./ext/ext_modulename.mli ./ext/ext_namespace.ml ./ext/ext_namespace.mli ./ext/ext_namespace_encode.ml ./ext/ext_namespace_encode.mli ./ext/ext_option.ml ./ext/ext_option.mli ./ext/ext_path.ml ./ext/ext_path.mli ./ext/ext_pervasives.ml ./ext/ext_pervasives.mli ./ext/ext_pp.ml ./ext/ext_pp.mli ./ext/ext_pp_scope.ml ./ext/ext_pp_scope.mli ./ext/ext_ref.ml ./ext/ext_ref.mli ./ext/ext_scc.ml ./ext/ext_scc.mli ./ext/ext_spec.ml ./ext/ext_spec.mli ./ext/ext_string.ml ./ext/ext_string.mli ./ext/ext_string_array.ml ./ext/ext_string_array.mli ./ext/ext_sys.ml ./ext/ext_sys.mli ./ext/ext_utf8.ml ./ext/ext_utf8.mli ./ext/ext_util.ml ./ext/ext_util.mli ./ext/hash.ml ./ext/hash.mli ./ext/hash_gen.ml ./ext/hash_ident.ml ./ext/hash_ident.mli ./ext/hash_int.ml ./ext/hash_int.mli ./ext/hash_set.ml ./ext/hash_set.mli ./ext/hash_set_gen.ml ./ext/hash_set_ident.ml ./ext/hash_set_ident.mli ./ext/hash_set_ident_mask.ml ./ext/hash_set_ident_mask.mli ./ext/hash_set_poly.ml ./ext/hash_set_poly.mli ./ext/hash_set_string.ml ./ext/hash_set_string.mli ./ext/hash_string.ml ./ext/hash_string.mli ./ext/int_vec_util.ml ./ext/int_vec_util.mli ./ext/int_vec_vec.ml ./ext/int_vec_vec.mli ./ext/js_reserved_map.ml ./ext/js_reserved_map.mli ./ext/js_runtime_modules.ml ./ext/literals.ml ./ext/map_gen.ml ./ext/map_gen.mli ./ext/map_ident.ml ./ext/map_ident.mli ./ext/map_int.ml ./ext/map_int.mli ./ext/map_string.ml ./ext/map_string.mli ./ext/ordered_hash_map_gen.ml ./ext/ordered_hash_map_local_ident.ml ./ext/ordered_hash_map_local_ident.mli ./ext/set_gen.ml ./ext/set_gen.mli ./ext/set_ident.ml ./ext/set_ident.mli ./ext/set_string.ml ./ext/set_string.mli ./ext/vec.ml ./ext/vec.mli ./ext/vec_gen.ml ./ext/vec_int.ml ./ext/vec_int.mli ./js_parser/declaration_parser.ml ./js_parser/enum_common.ml ./js_parser/enum_parser.ml ./js_parser/expression_parser.ml ./js_parser/file_key.ml ./js_parser/flow_ast.ml ./js_parser/flow_ast_utils.ml ./js_parser/flow_ast_utils.mli ./js_parser/flow_lexer.ml ./js_parser/flow_lexer.mli ./js_parser/jsx_parser.ml ./js_parser/lex_env.ml ./js_parser/lex_result.ml ./js_parser/loc.ml ./js_parser/loc.mli ./js_parser/object_parser.ml ./js_parser/parse_error.ml ./js_parser/parser_common.ml ./js_parser/parser_env.ml ./js_parser/parser_env.mli ./js_parser/parser_flow.ml ./js_parser/pattern_cover.ml ./js_parser/pattern_parser.ml ./js_parser/sedlexing.ml ./js_parser/sedlexing.mli ./js_parser/statement_parser.ml ./js_parser/token.ml ./js_parser/type_parser.ml ./js_parser/wtf8.ml ./js_parser/wtf8.mli ./main/builtin_cmi_datasets.ml ./main/builtin_cmi_datasets.mli ./main/builtin_cmj_datasets.ml ./main/builtin_cmj_datasets.mli ./main/js_main.ml ./main/js_main.mli ./napkin/reactjs_jsx_ppx_v3.ml ./napkin/reactjs_jsx_ppx_v3.mli ./napkin/res_ast_conversion.ml ./napkin/res_ast_conversion.mli ./napkin/res_character_codes.ml ./napkin/res_comment.ml ./napkin/res_comment.mli ./napkin/res_comments_table.ml ./napkin/res_core.ml ./napkin/res_core.mli ./napkin/res_diagnostics.ml ./napkin/res_diagnostics.mli ./napkin/res_diagnostics_printing_utils.ml ./napkin/res_doc.ml ./napkin/res_doc.mli ./napkin/res_driver.ml ./napkin/res_driver.mli ./napkin/res_driver_ml_parser.ml ./napkin/res_driver_ml_parser.mli ./napkin/res_driver_reason_binary.ml ./napkin/res_driver_reason_binary.mli ./napkin/res_grammar.ml ./napkin/res_io.ml ./napkin/res_io.mli ./napkin/res_js_ffi.ml ./napkin/res_minibuffer.ml ./napkin/res_minibuffer.mli ./napkin/res_multi_printer.ml ./napkin/res_multi_printer.mli ./napkin/res_outcome_printer.ml ./napkin/res_outcome_printer.mli ./napkin/res_parens.ml ./napkin/res_parens.mli ./napkin/res_parser.ml ./napkin/res_parser.mli ./napkin/res_parsetree_viewer.ml ./napkin/res_parsetree_viewer.mli ./napkin/res_printer.ml ./napkin/res_printer.mli ./napkin/res_reporting.ml ./napkin/res_scanner.ml ./napkin/res_scanner.mli ./napkin/res_token.ml ./outcome_printer/outcome_printer_ns.ml ./outcome_printer/outcome_printer_ns.mli ./outcome_printer/reason_outcome_printer_main.ml ./outcome_printer/reason_syntax_util.ml ./outcome_printer/reason_syntax_util.mli ./outcome_printer/tweaked_reason_oprint.ml ./stubs/bs_hash_stubs.ml ./super_errors/super_env.ml ./super_errors/super_location.ml ./super_errors/super_location.mli ./super_errors/super_main.ml ./super_errors/super_misc.ml ./super_errors/super_misc.mli ./super_errors/super_pparse.ml ./super_errors/super_typecore.ml ./super_errors/super_typemod.ml ./super_errors/super_typetexp.ml ./syntax/ast_attributes.ml ./syntax/ast_attributes.mli ./syntax/ast_bs_open.ml ./syntax/ast_bs_open.mli ./syntax/ast_comb.ml ./syntax/ast_comb.mli ./syntax/ast_compatible.ml ./syntax/ast_compatible.mli ./syntax/ast_config.ml ./syntax/ast_config.mli ./syntax/ast_core_type.ml ./syntax/ast_core_type.mli ./syntax/ast_core_type_class_type.ml ./syntax/ast_core_type_class_type.mli ./syntax/ast_derive.ml ./syntax/ast_derive.mli ./syntax/ast_derive_abstract.ml ./syntax/ast_derive_abstract.mli ./syntax/ast_derive_js_mapper.ml ./syntax/ast_derive_js_mapper.mli ./syntax/ast_derive_projector.ml ./syntax/ast_derive_projector.mli ./syntax/ast_derive_util.ml ./syntax/ast_derive_util.mli ./syntax/ast_exp.ml ./syntax/ast_exp.mli ./syntax/ast_exp_apply.ml ./syntax/ast_exp_apply.mli ./syntax/ast_exp_extension.ml ./syntax/ast_exp_extension.mli ./syntax/ast_exp_handle_external.ml ./syntax/ast_exp_handle_external.mli ./syntax/ast_external.ml ./syntax/ast_external.mli ./syntax/ast_external_mk.ml ./syntax/ast_external_mk.mli ./syntax/ast_external_process.ml ./syntax/ast_external_process.mli ./syntax/ast_literal.ml ./syntax/ast_literal.mli ./syntax/ast_open_cxt.ml ./syntax/ast_open_cxt.mli ./syntax/ast_pat.ml ./syntax/ast_pat.mli ./syntax/ast_payload.ml ./syntax/ast_payload.mli ./syntax/ast_polyvar.ml ./syntax/ast_polyvar.mli ./syntax/ast_reason_pp.ml ./syntax/ast_reason_pp.mli ./syntax/ast_signature.ml ./syntax/ast_signature.mli ./syntax/ast_structure.ml ./syntax/ast_structure.mli ./syntax/ast_tdcls.ml ./syntax/ast_tdcls.mli ./syntax/ast_tuple_pattern_flatten.ml ./syntax/ast_tuple_pattern_flatten.mli ./syntax/ast_typ_uncurry.ml ./syntax/ast_typ_uncurry.mli ./syntax/ast_uncurry_apply.ml ./syntax/ast_uncurry_apply.mli ./syntax/ast_uncurry_gen.ml ./syntax/ast_uncurry_gen.mli ./syntax/ast_utf8_string.ml ./syntax/ast_utf8_string.mli ./syntax/ast_utf8_string_interp.ml ./syntax/ast_utf8_string_interp.mli ./syntax/ast_util.ml ./syntax/ast_util.mli ./syntax/bs_ast_invariant.ml ./syntax/bs_ast_invariant.mli ./syntax/bs_ast_mapper.ml ./syntax/bs_ast_mapper.mli ./syntax/bs_builtin_ppx.ml ./syntax/bs_builtin_ppx.mli ./syntax/bs_flow_ast_utils.ml ./syntax/bs_flow_ast_utils.mli ./syntax/bs_syntaxerr.ml ./syntax/bs_syntaxerr.mli ./syntax/classify_function.ml ./syntax/classify_function.mli ./syntax/external_arg_spec.ml ./syntax/external_arg_spec.mli ./syntax/external_ffi_types.ml ./syntax/external_ffi_types.mli ./syntax/ppx_apply.ml ./syntax/ppx_entry.ml ./syntax/typemod_hide.ml \ No newline at end of file diff --git a/scripts/ninja.js b/scripts/ninja.js index 91d361d4d7..dac9adf2c7 100755 --- a/scripts/ninja.js +++ b/scripts/ninja.js @@ -1559,9 +1559,6 @@ ${cppoList("outcome_printer", [ ["reason_syntax_util.ml", "reason_syntax_util.cppo.ml", ""], ["reason_syntax_util.mli", "reason_syntax_util.cppo.mli", ""], ])} -${cppoList("syntax", [ - ["reactjs_jsx_ppx_v3.ml", "reactjs_jsx_ppx.cppo.ml", ""], -])} o ../${ process.platform }/refmt.exe: link ${refmtMainPath}/refmt_main3.mli ${refmtMainPath}/refmt_main3.ml @@ -1646,7 +1643,7 @@ o common/bs_version.ml : mk_bsversion build_version.js ../package.json o ../${ process.platform - }/bsc: link js_parser/js_parser.cmxa stubs/stubs.cmxa ext/ext.cmxa common/common.cmxa syntax/syntax.cmxa depends/depends.cmxa super_errors/super_errors.cmxa outcome_printer/outcome_printer.cmxa core/core.cmxa napkin/napkin.cmxa main/js_main.cmx + }/bsc: link napkin/napkin.cmxa js_parser/js_parser.cmxa stubs/stubs.cmxa ext/ext.cmxa common/common.cmxa syntax/syntax.cmxa depends/depends.cmxa super_errors/super_errors.cmxa outcome_printer/outcome_printer.cmxa core/core.cmxa main/js_main.cmx libs = ocamlcommon.cmxa o ../${ process.platform diff --git a/syntax b/syntax index b82cabc71e..de8eb1dcf9 160000 --- a/syntax +++ b/syntax @@ -1 +1 @@ -Subproject commit b82cabc71e76bb6885dad3a254cdc581eea80784 +Subproject commit de8eb1dcf9376bd934fb3b23f8211bb0b06f370f