diff --git a/flow/.gitignore b/flow/.gitignore new file mode 100644 index 0000000000..8c960ffae8 --- /dev/null +++ b/flow/.gitignore @@ -0,0 +1,2 @@ +flow +ocaml-wtf8 \ No newline at end of file diff --git a/flow/dune b/flow/dune new file mode 100644 index 0000000000..b337c7f494 --- /dev/null +++ b/flow/dune @@ -0,0 +1,6 @@ +(env + (dev + (flags + (:standard -w -6-69)))) + +(data_only_dirs flow ocaml-wtf8) diff --git a/flow/import.sh b/flow/import.sh new file mode 100644 index 0000000000..c10df2fa11 --- /dev/null +++ b/flow/import.sh @@ -0,0 +1,39 @@ +#!/bin/bash + +[ -d flow ] || git clone git@github.com:facebook/flow.git +[ -d ocaml-wtf8 ] || git clone git@github.com:flowtype/ocaml-wtf8.git +rm -rf parser +mkdir parser + +cp flow/src/hack_forked/utils/collections/flow_set.ml parser/ +cp flow/src/hack_forked/utils/collections/flow_map.ml parser/ +cp flow/src/third-party/sedlex/flow_sedlexing.ml parser/ +cp flow/src/third-party/sedlex/flow_sedlexing.mli parser/ +cp flow/src/parser/*.ml parser/ +cp flow/src/parser/*.mli parser/ +rm parser/flow_parser_dot_js.ml +rm parser/flow_parser_js.ml +rm parser/relativeLoc.ml +rm parser/relativeLoc.mli +rm parser/comment_utils.ml +rm parser/estree_translator.ml +rm parser/libflowparser.ml +rm parser/offset_utils.ml +rm parser/offset_utils.mli +rm parser/token_translator.ml +rm parser/translator_intf.ml + +cat << EOF > parser/dune +(library + (name flow_parser) + (libraries sedlex) + (preprocess (pps sedlex.ppx))) +EOF + +cat << EOF > parser/.ocamlformat +disable=true +EOF + +cp ocaml-wtf8/src/wtf8.ml parser/ +cp ocaml-wtf8/src/wtf8.mli parser/ + diff --git a/flow/parser/.ocamlformat b/flow/parser/.ocamlformat new file mode 100644 index 0000000000..e3346c163b --- /dev/null +++ b/flow/parser/.ocamlformat @@ -0,0 +1 @@ +disable=true diff --git a/flow/parser/comment_attachment.ml b/flow/parser/comment_attachment.ml new file mode 100644 index 0000000000..4866a47851 --- /dev/null +++ b/flow/parser/comment_attachment.ml @@ -0,0 +1,779 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +module Ast = Flow_ast +open Flow_ast +open Parser_env + +let id = Flow_ast_mapper.id + +let map_loc = Flow_ast_mapper.map_loc + +let map_opt = Flow_ast_mapper.map_opt + +let id_list_last (map : 'a -> 'a) (lst : 'a list) : 'a list = + match List.rev lst with + | [] -> lst + | hd :: tl -> + let hd' = map hd in + if hd == hd' then + lst + else + List.rev (hd' :: tl) + +(* Mapper that removes all trailing comments that appear after a given position in an AST node *) +class ['loc] trailing_comments_remover ~after_pos = + object (this) + inherit ['loc] Flow_ast_mapper.mapper + + method! syntax comments = + let open Syntax in + let { trailing; _ } = comments in + let trailing' = + List.filter (fun (loc, _) -> Loc.(pos_cmp loc.start after_pos < 0)) trailing + in + if List.length trailing = List.length trailing' then + comments + else + { comments with trailing = trailing' } + + method! array _loc expr = + let open Ast.Expression.Array in + let { comments; _ } = expr in + id this#syntax_opt comments expr (fun comments' -> { expr with comments = comments' }) + + method! array_type t = + let open Ast.Type.Array in + let { comments; _ } = t in + id this#syntax_opt comments t (fun comments' -> { t with comments = comments' }) + + method! assignment _loc expr = + let open Ast.Expression.Assignment in + let { right; comments; _ } = expr in + let right' = this#expression right in + let comments' = this#syntax_opt comments in + if right == right' && comments == comments' then + expr + else + { expr with right = right'; comments = comments' } + + method! binary _loc expr = + let open Ast.Expression.Binary in + let { right; comments; _ } = expr in + let right' = this#expression right in + let comments' = this#syntax_opt comments in + if right == right' && comments == comments' then + expr + else + { expr with right = right'; comments = comments' } + + method! block _loc stmt = + let open Ast.Statement.Block in + let { comments; _ } = stmt in + id this#syntax_opt comments stmt (fun comments' -> { stmt with comments = comments' }) + + method! call _annot expr = + let open Ast.Expression.Call in + let { arguments; comments; _ } = expr in + let arguments' = this#call_arguments arguments in + let comments' = this#syntax_opt comments in + if arguments == arguments' && comments == comments' then + expr + else + { expr with arguments = arguments'; comments = comments' } + + method! call_arguments arg_list = + let open Ast.Expression.ArgList in + let (loc, { arguments; comments }) = arg_list in + id this#syntax_opt comments arg_list (fun comments' -> + (loc, { arguments; comments = comments' }) + ) + + method! call_type_args targs = + let open Ast.Expression.CallTypeArgs in + let (loc, { arguments; comments }) = targs in + id this#syntax_opt comments targs (fun comments' -> (loc, { arguments; comments = comments' })) + + method! class_ _loc cls = + let open Ast.Class in + let { body; comments; _ } = cls in + let body' = this#class_body body in + let comments' = this#syntax_opt comments in + if body == body' && comments == comments' then + cls + else + { cls with body = body'; comments = comments' } + + method! class_body body = + let open Ast.Class.Body in + let (loc, { body = _body; comments }) = body in + id this#syntax_opt comments body (fun comments' -> + (loc, { body = _body; comments = comments' }) + ) + + method! class_extends _loc extends = + let open Ast.Class.Extends in + let { expr; targs; _ } = extends in + if targs = None then + id this#expression expr extends (fun expr' -> { extends with expr = expr' }) + else + id (map_opt this#type_args) targs extends (fun targs' -> { extends with targs = targs' }) + + method! class_implements implements = + let open Ast.Class.Implements in + let (loc, { interfaces; comments }) = implements in + id (id_list_last this#class_implements_interface) interfaces implements (fun interfaces' -> + (loc, { interfaces = interfaces'; comments }) + ) + + method! class_implements_interface interface = + let open Ast.Class.Implements.Interface in + let (loc, { id = id_; targs }) = interface in + if targs = None then + id this#identifier id_ interface (fun id' -> (loc, { id = id'; targs })) + else + id (map_opt this#type_args) targs interface (fun targs' -> + (loc, { id = id_; targs = targs' }) + ) + + method! computed_key key = + let open Ast.ComputedKey in + let (loc, { expression; comments }) = key in + id this#syntax_opt comments key (fun comments' -> (loc, { expression; comments = comments' })) + + method! conditional _loc expr = + let open Ast.Expression.Conditional in + let { alternate; comments; _ } = expr in + let alternate' = this#expression alternate in + let comments' = this#syntax_opt comments in + if alternate == alternate' && comments == comments' then + expr + else + { expr with alternate = alternate'; comments = comments' } + + method! function_ _loc func = + let open Ast.Function in + let { body; comments; _ } = func in + let body' = this#function_body_any body in + let comments' = this#syntax_opt comments in + if body == body' && comments == comments' then + func + else + { func with body = body'; comments = comments' } + + method! function_params (loc, params) = + let open Ast.Function.Params in + let { comments; _ } = params in + id this#syntax_opt comments (loc, params) (fun comments' -> + (loc, { params with comments = comments' }) + ) + + method! function_type _loc func = + let open Ast.Type.Function in + let { return; comments; _ } = func in + let return' = this#type_ return in + let comments' = this#syntax_opt comments in + if return == return' && comments == comments' then + func + else + { func with return = return'; comments = comments' } + + method! generic_identifier_type git = + let open Ast.Type.Generic.Identifier in + match git with + | Unqualified i -> id this#identifier i git (fun i -> Unqualified i) + | Qualified (loc, ({ id; _ } as qualified)) -> + let id' = this#identifier id in + if id == id' then + git + else + Qualified (loc, { qualified with id = id' }) + + method! import _loc expr = + let open Ast.Expression.Import in + let { comments; _ } = expr in + id this#syntax_opt comments expr (fun comments' -> { expr with comments = comments' }) + + method! interface_type _loc t = + let open Ast.Type.Interface in + let { body; comments; _ } = t in + let body' = map_loc this#object_type body in + let comments' = this#syntax_opt comments in + if body == body' && comments == comments' then + t + else + { t with body = body'; comments = comments' } + + method! intersection_type _loc t = + let { Ast.Type.Intersection.types = (t0, t1, ts); comments } = t in + let (t1', ts') = + match ts with + | [] -> (this#type_ t1, []) + | _ -> (t1, id_list_last this#type_ ts) + in + let comments' = this#syntax_opt comments in + if t1 == t1' && ts == ts' && comments == comments' then + t + else + { Ast.Type.Intersection.types = (t0, t1', ts'); comments = comments' } + + method! jsx_element _loc elem = + let open Ast.JSX in + let { comments; _ } = elem in + id this#syntax_opt comments elem (fun comments' -> { elem with comments = comments' }) + + method! jsx_fragment _loc frag = + let open Ast.JSX in + let { frag_comments = comments; _ } = frag in + id this#syntax_opt comments frag (fun comments' -> { frag with frag_comments = comments' }) + + method! logical _loc expr = + let open Ast.Expression.Logical in + let { right; comments; _ } = expr in + let right' = this#expression right in + let comments' = this#syntax_opt comments in + if right == right' && comments == comments' then + expr + else + { expr with right = right'; comments = comments' } + + method! new_ _loc expr = + let open Ast.Expression.New in + let { callee; targs; arguments; comments } = expr in + let comments' = this#syntax_opt comments in + match (targs, arguments) with + (* new Callee() *) + | (_, Some _) -> + let arguments' = map_opt this#call_arguments arguments in + if arguments == arguments' && comments == comments' then + expr + else + { expr with arguments = arguments'; comments = comments' } + (* new Callee *) + | (Some _, _) -> + let targs' = map_opt this#call_type_args targs in + if targs == targs' && comments == comments' then + expr + else + { expr with targs = targs'; comments = comments' } + (* new Callee *) + | (None, None) -> + let callee' = this#expression callee in + if callee == callee' && comments == comments' then + expr + else + { expr with callee = callee'; comments = comments' } + + method! member _loc expr = + let open Ast.Expression.Member in + let { property; comments; _ } = expr in + let property' = this#member_property property in + let comments' = this#syntax_opt comments in + if property == property' && comments == comments' then + expr + else + { expr with property = property'; comments = comments' } + + method! object_ _loc expr = + let open Ast.Expression.Object in + let { comments; _ } = expr in + id this#syntax_opt comments expr (fun comments' -> { expr with comments = comments' }) + + method! object_type _loc obj = + let open Ast.Type.Object in + let { comments; _ } = obj in + id this#syntax_opt comments obj (fun comments' -> { obj with comments = comments' }) + + method! predicate pred = + let open Ast.Type.Predicate in + let (loc, { kind; comments }) = pred in + id this#syntax_opt comments pred (fun comments' -> (loc, { kind; comments = comments' })) + + method! sequence _loc expr = + let open Ast.Expression.Sequence in + let { expressions; comments } = expr in + let expressions' = id_list_last this#expression expressions in + let comments' = this#syntax_opt comments in + if expressions == expressions' && comments == comments' then + expr + else + { expressions = expressions'; comments = comments' } + + method! template_literal _loc expr = + let open Ast.Expression.TemplateLiteral in + let { comments; _ } = expr in + id this#syntax_opt comments expr (fun comments' -> { expr with comments = comments' }) + + method! tuple_type t = + let open Ast.Type.Tuple in + let { comments; _ } = t in + id this#syntax_opt comments t (fun comments' -> { t with comments = comments' }) + + method! type_cast _loc expr = + let open Ast.Expression.TypeCast in + let { comments; _ } = expr in + id this#syntax_opt comments expr (fun comments' -> { expr with comments = comments' }) + + method! type_params tparams = + let open Ast.Type.TypeParams in + let (loc, { params; comments }) = tparams in + id this#syntax_opt comments tparams (fun comments' -> (loc, { params; comments = comments' })) + + method! union_type _loc t = + let { Ast.Type.Union.types = (t0, t1, ts); comments } = t in + let (t1', ts') = + match ts with + | [] -> (this#type_ t1, []) + | _ -> (t1, id_list_last this#type_ ts) + in + let comments' = this#syntax_opt comments in + if t1 == t1' && ts == ts' && comments == comments' then + t + else + { Ast.Type.Union.types = (t0, t1', ts'); comments = comments' } + + method! variable_declarator ~kind decl = + let open Ast.Statement.VariableDeclaration.Declarator in + let (loc, { id = ident; init }) = decl in + match init with + | None -> + id (this#variable_declarator_pattern ~kind) ident decl (fun ident' -> + (loc, { id = ident'; init }) + ) + | Some init -> + id this#expression init decl (fun init' -> (loc, { id = ident; init = Some init' })) + end + +type trailing_and_remover_result = { + trailing: Loc.t Comment.t list; + remove_trailing: 'a. 'a -> (Loc.t trailing_comments_remover -> 'a -> 'a) -> 'a; +} + +(* Returns a remover function which removes comments beginning after the previous token. + No trailing comments are returned, since all comments since the last loc should be removed. *) +let trailing_and_remover_after_last_loc : Parser_env.env -> trailing_and_remover_result = + fun env -> + let open Loc in + let remover = + match Parser_env.last_loc env with + | None -> None + | Some _ when not (Peek.has_eaten_comments env) -> None + | Some last_loc -> + Parser_env.consume_comments_until env last_loc._end; + let remover = new trailing_comments_remover ~after_pos:last_loc._end in + Some remover + in + { + trailing = []; + remove_trailing = + (fun node f -> + match remover with + | None -> node + | Some remover -> f remover node); + } + +(* Consumes and returns comments on the same line as the previous token. Also returns a remover + function which can be used to remove comments beginning after the previous token's line. *) +let trailing_and_remover_after_last_line : Parser_env.env -> trailing_and_remover_result = + fun env -> + let open Loc in + let (trailing, remover) = + match Parser_env.last_loc env with + | None -> ([], None) + | Some _ when not (Peek.has_eaten_comments env) -> (Eat.comments_until_next_line env, None) + | Some last_loc -> + Parser_env.consume_comments_until env last_loc._end; + let trailing = Eat.comments_until_next_line env in + let next_line_start = { line = last_loc._end.line + 1; column = 0 } in + let remover = new trailing_comments_remover ~after_pos:next_line_start in + (trailing, Some remover) + in + { + trailing; + remove_trailing = + (fun node f -> + match remover with + | None -> node + | Some remover -> f remover node); + } + +let trailing_and_remover : Parser_env.env -> trailing_and_remover_result = + fun env -> + if Peek.is_line_terminator env then + trailing_and_remover_after_last_line env + else + trailing_and_remover_after_last_loc env + +let id_remove_trailing env id = + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing id (fun remover id -> remover#identifier id) + +let expression_remove_trailing env expr = + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing expr (fun remover expr -> remover#expression expr) + +let block_remove_trailing env block = + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing block (fun remover (loc, str) -> (loc, remover#block loc str)) + +let type_params_remove_trailing env tparams = + match tparams with + | None -> None + | Some tparams -> + let { remove_trailing; _ } = trailing_and_remover env in + Some (remove_trailing tparams (fun remover tparams -> remover#type_params tparams)) + +let type_remove_trailing env ty = + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing ty (fun remover ty -> remover#type_ ty) + +let type_annotation_hint_remove_trailing env annot = + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing annot (fun remover annot -> remover#type_annotation_hint annot) + +let function_params_remove_trailing env params = + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing params (fun remover params -> remover#function_params params) + +let predicate_remove_trailing env pred = + match pred with + | None -> None + | Some pred -> + let { remove_trailing; _ } = trailing_and_remover env in + Some (remove_trailing pred (fun remover pred -> remover#predicate pred)) + +let object_key_remove_trailing env key = + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing key (fun remover key -> remover#object_key key) + +let generic_type_remove_trailing env ty = + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing ty (fun remover ty -> map_loc remover#generic_type ty) + +let generic_type_list_remove_trailing env extends = + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing extends (fun remover extends -> + id_list_last (map_loc remover#generic_type) extends + ) + +let class_implements_remove_trailing env implements = + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing implements (fun remover impl -> remover#class_implements impl) + +let string_literal_remove_trailing env str = + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing str (fun remover (loc, str) -> (loc, remover#string_literal_type loc str)) + +let statement_add_comments + ((loc, stmt) : (Loc.t, Loc.t) Statement.t) (comments : (Loc.t, unit) Syntax.t option) : + (Loc.t, Loc.t) Statement.t = + let open Statement in + let merge_comments inner = Flow_ast_utils.merge_comments ~inner ~outer:comments in + let merge_comments_with_internal inner = + Flow_ast_utils.merge_comments_with_internal ~inner ~outer:comments + in + ( loc, + match stmt with + | Block ({ Block.comments; _ } as s) -> + Block { s with Block.comments = merge_comments_with_internal comments } + | Break ({ Break.comments; _ } as s) -> + Break { s with Break.comments = merge_comments comments } + | ClassDeclaration ({ Class.comments; _ } as s) -> + ClassDeclaration { s with Class.comments = merge_comments comments } + | Continue ({ Continue.comments; _ } as s) -> + Continue { s with Continue.comments = merge_comments comments } + | Debugger { Debugger.comments } -> Debugger { Debugger.comments = merge_comments comments } + | DeclareClass ({ DeclareClass.comments; _ } as s) -> + DeclareClass { s with DeclareClass.comments = merge_comments comments } + | DeclareExportDeclaration ({ DeclareExportDeclaration.comments; _ } as s) -> + DeclareExportDeclaration + { s with DeclareExportDeclaration.comments = merge_comments comments } + | DeclareFunction ({ DeclareFunction.comments; _ } as s) -> + DeclareFunction { s with DeclareFunction.comments = merge_comments comments } + | DeclareInterface ({ Interface.comments; _ } as s) -> + DeclareInterface { s with Interface.comments = merge_comments comments } + | DeclareModule ({ DeclareModule.comments; _ } as s) -> + DeclareModule { s with DeclareModule.comments = merge_comments comments } + | DeclareModuleExports ({ DeclareModuleExports.comments; _ } as s) -> + DeclareModuleExports { s with DeclareModuleExports.comments = merge_comments comments } + | DeclareTypeAlias ({ TypeAlias.comments; _ } as s) -> + DeclareTypeAlias { s with TypeAlias.comments = merge_comments comments } + | DeclareOpaqueType ({ OpaqueType.comments; _ } as s) -> + DeclareOpaqueType { s with OpaqueType.comments = merge_comments comments } + | DeclareVariable ({ DeclareVariable.comments; _ } as s) -> + DeclareVariable { s with DeclareVariable.comments = merge_comments comments } + | DoWhile ({ DoWhile.comments; _ } as s) -> + DoWhile { s with DoWhile.comments = merge_comments comments } + | Empty { Empty.comments } -> Empty { Empty.comments = merge_comments comments } + | EnumDeclaration ({ EnumDeclaration.comments; _ } as s) -> + EnumDeclaration { s with EnumDeclaration.comments = merge_comments comments } + | ExportDefaultDeclaration ({ ExportDefaultDeclaration.comments; _ } as s) -> + ExportDefaultDeclaration + { s with ExportDefaultDeclaration.comments = merge_comments comments } + | ExportNamedDeclaration ({ ExportNamedDeclaration.comments; _ } as s) -> + ExportNamedDeclaration { s with ExportNamedDeclaration.comments = merge_comments comments } + | Expression ({ Expression.comments; _ } as s) -> + Expression { s with Expression.comments = merge_comments comments } + | For ({ For.comments; _ } as s) -> For { s with For.comments = merge_comments comments } + | ForIn ({ ForIn.comments; _ } as s) -> + ForIn { s with ForIn.comments = merge_comments comments } + | ForOf ({ ForOf.comments; _ } as s) -> + ForOf { s with ForOf.comments = merge_comments comments } + | FunctionDeclaration ({ Function.comments; _ } as s) -> + FunctionDeclaration { s with Function.comments = merge_comments comments } + | If ({ If.comments; _ } as s) -> If { s with If.comments = merge_comments comments } + | ImportDeclaration ({ ImportDeclaration.comments; _ } as s) -> + ImportDeclaration { s with ImportDeclaration.comments = merge_comments comments } + | InterfaceDeclaration ({ Interface.comments; _ } as s) -> + InterfaceDeclaration { s with Interface.comments = merge_comments comments } + | Labeled ({ Labeled.comments; _ } as s) -> + Labeled { s with Labeled.comments = merge_comments comments } + | Return ({ Return.comments; _ } as s) -> + Return { s with Return.comments = merge_comments comments } + | Switch ({ Switch.comments; _ } as s) -> + Switch { s with Switch.comments = merge_comments comments } + | Throw ({ Throw.comments; _ } as s) -> + Throw { s with Throw.comments = merge_comments comments } + | Try ({ Try.comments; _ } as s) -> Try { s with Try.comments = merge_comments comments } + | TypeAlias ({ TypeAlias.comments; _ } as s) -> + TypeAlias { s with TypeAlias.comments = merge_comments comments } + | OpaqueType ({ OpaqueType.comments; _ } as s) -> + OpaqueType { s with OpaqueType.comments = merge_comments comments } + | VariableDeclaration ({ VariableDeclaration.comments; _ } as s) -> + VariableDeclaration { s with VariableDeclaration.comments = merge_comments comments } + | While ({ While.comments; _ } as s) -> + While { s with While.comments = merge_comments comments } + | With ({ With.comments; _ } as s) -> With { s with With.comments = merge_comments comments } + ) + +(* Collects the first leading and last trailing comment on an AST node or its children. + The first leading comment is the first attached comment that begins before the given node's loc, + and the last trailing comment is the last attached comment that begins after the given node's loc. *) +class ['loc] comment_bounds_collector ~loc = + object (this) + inherit ['loc] Flow_ast_mapper.mapper + + val mutable first_leading = None + + val mutable last_trailing = None + + method comment_bounds = (first_leading, last_trailing) + + method collect_comments : 'internal. ('loc, 'internal) Syntax.t -> unit = + function + | { Syntax.leading; trailing; _ } -> + List.iter this#visit_leading_comment leading; + List.iter this#visit_trailing_comment trailing + + method collect_comments_opt = + function + | None -> () + | Some comments -> this#collect_comments comments + + method visit_leading_comment ((comment_loc, _) as comment) = + let open Loc in + match first_leading with + | None -> if pos_cmp comment_loc.start loc.start < 0 then first_leading <- Some comment + | Some (current_first_loc, _) -> + if pos_cmp comment_loc.start current_first_loc.start < 0 then first_leading <- Some comment + + method visit_trailing_comment ((comment_loc, _) as comment) = + let open Loc in + match last_trailing with + | None -> if pos_cmp comment_loc.start loc._end >= 0 then last_trailing <- Some comment + | Some (current_last_loc, _) -> + if pos_cmp current_last_loc.start comment_loc.start < 0 then last_trailing <- Some comment + + method! syntax comments = + this#collect_comments comments; + comments + + method! block _loc block = + let { Statement.Block.comments; _ } = block in + this#collect_comments_opt comments; + block + end + +(* Given an AST node and a function to collect all its comments, return the first leading + and last trailing comment on the node. *) +let comment_bounds loc node f = + let collector = new comment_bounds_collector ~loc in + ignore (f collector node); + collector#comment_bounds + +(* Expand node's loc to include its attached comments *) +let expand_loc_with_comment_bounds loc (first_leading, last_trailing) = + let open Loc in + let start = + match first_leading with + | None -> loc + | Some (first_leading_loc, _) -> first_leading_loc + in + let _end = + match last_trailing with + | None -> loc + | Some (last_trailing_loc, _) -> last_trailing_loc + in + btwn start _end + +(* Remove the trailing comment bound if it is a line comment *) +let comment_bounds_without_trailing_line_comment (leading, trailing) = + match trailing with + | Some (_, { Ast.Comment.kind = Ast.Comment.Line; _ }) -> (leading, None) + | _ -> (leading, trailing) + +let collect_without_trailing_line_comment collector = + comment_bounds_without_trailing_line_comment collector#comment_bounds + +(* Return the first leading and last trailing comment of a statement *) +let statement_comment_bounds ((loc, _) as stmt : (Loc.t, Loc.t) Statement.t) : + Loc.t Comment.t option * Loc.t Comment.t option = + let collector = new comment_bounds_collector ~loc in + ignore (collector#statement stmt); + collector#comment_bounds + +let expression_comment_bounds ((loc, _) as expr) = + let collector = new comment_bounds_collector ~loc in + ignore (collector#expression expr); + collector#comment_bounds + +let type_comment_bounds ((loc, _) as ty) = + let collector = new comment_bounds_collector ~loc in + ignore (collector#type_ ty); + collector#comment_bounds + +let block_comment_bounds (loc, block) = + let collector = new comment_bounds_collector ~loc in + ignore (collector#block loc block); + collector#comment_bounds + +let object_property_comment_bounds property = + let open Ast.Expression.Object in + let collector = + match property with + | Property ((loc, _) as p) -> + let collector = new comment_bounds_collector ~loc in + ignore (collector#object_property p); + collector + | SpreadProperty ((loc, _) as p) -> + let collector = new comment_bounds_collector ~loc in + ignore (collector#spread_property p); + collector + in + collect_without_trailing_line_comment collector + +let object_type_property_comment_bounds property = + let open Ast.Type.Object in + let collector = + match property with + | Property ((loc, _) as p) -> + let collector = new comment_bounds_collector ~loc in + ignore (collector#object_property_type p); + collector + | SpreadProperty ((loc, _) as p) -> + let collector = new comment_bounds_collector ~loc in + ignore (collector#object_spread_property_type p); + collector + | Indexer ((loc, _) as p) -> + let collector = new comment_bounds_collector ~loc in + ignore (collector#object_indexer_property_type p); + collector + | InternalSlot ((loc, _) as p) -> + let collector = new comment_bounds_collector ~loc in + ignore (collector#object_internal_slot_property_type p); + collector + | CallProperty ((loc, _) as p) -> + let collector = new comment_bounds_collector ~loc in + ignore (collector#object_call_property_type p); + collector + in + collect_without_trailing_line_comment collector + +let object_pattern_property_comment_bounds loc property = + let collector = new comment_bounds_collector ~loc in + ignore (collector#pattern_object_p property); + collect_without_trailing_line_comment collector + +let switch_case_comment_bounds (loc, case) = + let collector = new comment_bounds_collector ~loc in + ignore (collector#switch_case (loc, case)); + collector#comment_bounds + +let function_param_comment_bounds (loc, param) = + let collector = new comment_bounds_collector ~loc in + ignore (collector#function_param (loc, param)); + collect_without_trailing_line_comment collector + +let function_rest_param_comment_bounds (loc, param) = + let collector = new comment_bounds_collector ~loc in + ignore (collector#function_rest_param (loc, param)); + collect_without_trailing_line_comment collector + +let function_this_param_comment_bounds (loc, param) = + let collector = new comment_bounds_collector ~loc in + ignore (collector#function_this_param (loc, param)); + collect_without_trailing_line_comment collector + +let function_type_param_comment_bounds (loc, param) = + let collector = new comment_bounds_collector ~loc in + ignore (collector#function_param_type (loc, param)); + collect_without_trailing_line_comment collector + +let function_type_rest_param_comment_bounds (loc, param) = + let collector = new comment_bounds_collector ~loc in + ignore (collector#function_rest_param_type (loc, param)); + collect_without_trailing_line_comment collector + +let function_type_this_param_comment_bounds (loc, param) = + let collector = new comment_bounds_collector ~loc in + ignore (collector#function_this_param_type (loc, param)); + collect_without_trailing_line_comment collector + +let array_element_comment_bounds loc element = + let collector = new comment_bounds_collector ~loc in + ignore (collector#array_element element); + collect_without_trailing_line_comment collector + +let array_pattern_element_comment_bounds loc element = + let collector = new comment_bounds_collector ~loc in + ignore (collector#pattern_array_e element); + collect_without_trailing_line_comment collector + +let expression_or_spread_comment_bounds loc expr_or_spread = + let collector = new comment_bounds_collector ~loc in + ignore (collector#expression_or_spread expr_or_spread); + collect_without_trailing_line_comment collector + +let call_type_arg_comment_bounds loc arg = + let collector = new comment_bounds_collector ~loc in + ignore (collector#call_type_arg arg); + collect_without_trailing_line_comment collector + +let type_param_comment_bounds (loc, param) = + let collector = new comment_bounds_collector ~loc in + ignore (collector#type_param (loc, param)); + collect_without_trailing_line_comment collector + +let function_body_comment_bounds body = + let loc = + match body with + | Ast.Function.BodyBlock (loc, _) -> loc + | Ast.Function.BodyExpression (loc, _) -> loc + in + let collector = new comment_bounds_collector ~loc in + ignore (collector#function_body_any body); + collector#comment_bounds + +let if_alternate_statement_comment_bounds loc alternate = + let collector = new comment_bounds_collector ~loc in + ignore (collector#if_alternate_statement loc alternate); + collector#comment_bounds + +let member_property_comment_bounds loc property = + let collector = new comment_bounds_collector ~loc in + ignore (collector#member_property property); + collector#comment_bounds diff --git a/flow/parser/declaration_parser.ml b/flow/parser/declaration_parser.ml new file mode 100644 index 0000000000..6227bac87b --- /dev/null +++ b/flow/parser/declaration_parser.ml @@ -0,0 +1,434 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +module Ast = Flow_ast +open Token +open Parser_common +open Parser_env +open Flow_ast +open Comment_attachment +module SSet = Flow_set.Make (String) + +module type DECLARATION = sig + val async : env -> bool * Loc.t Comment.t list + + val generator : env -> bool * Loc.t Comment.t list + + val variance : env -> bool -> bool -> Loc.t Variance.t option + + val function_params : await:bool -> yield:bool -> env -> (Loc.t, Loc.t) Ast.Function.Params.t + + val function_body : + env -> async:bool -> generator:bool -> expression:bool -> (Loc.t, Loc.t) Function.body * bool + + val is_simple_function_params : (Loc.t, Loc.t) Ast.Function.Params.t -> bool + + val strict_post_check : + env -> + strict:bool -> + simple:bool -> + (Loc.t, Loc.t) Identifier.t option -> + (Loc.t, Loc.t) Ast.Function.Params.t -> + unit + + val let_ : + env -> + (Loc.t, Loc.t) Statement.VariableDeclaration.Declarator.t list + * Loc.t Ast.Comment.t list + * (Loc.t * Parse_error.t) list + + val const : + env -> + (Loc.t, Loc.t) Statement.VariableDeclaration.Declarator.t list + * Loc.t Ast.Comment.t list + * (Loc.t * Parse_error.t) list + + val var : + env -> + (Loc.t, Loc.t) Statement.VariableDeclaration.Declarator.t list + * Loc.t Ast.Comment.t list + * (Loc.t * Parse_error.t) list + + val _function : env -> (Loc.t, Loc.t) Statement.t + + val enum_declaration : env -> (Loc.t, Loc.t) Statement.t +end + +module Declaration (Parse : Parser_common.PARSER) (Type : Type_parser.TYPE) : DECLARATION = struct + module Enum = Enum_parser.Enum (Parse) + + let check_param = + let rec pattern ((env, _) as check_env) (loc, p) = + Pattern.( + match p with + | Object o -> _object check_env o + | Array arr -> _array check_env arr + | Identifier id -> identifier_pattern check_env id + | Expression _ -> + error_at env (loc, Parse_error.ExpectedPatternFoundExpression); + check_env + ) + and _object check_env o = List.fold_left object_property check_env o.Pattern.Object.properties + and object_property check_env = + let open Pattern.Object in + function + | Property (_, property) -> + Property.( + let check_env = + match property.key with + | Identifier id -> identifier_no_dupe_check check_env id + | _ -> check_env + in + pattern check_env property.pattern + ) + | RestElement (_, { Pattern.RestElement.argument; comments = _ }) -> + pattern check_env argument + and _array check_env arr = List.fold_left array_element check_env arr.Pattern.Array.elements + and array_element check_env = + let open Pattern.Array in + function + | Hole _ -> check_env + | Element (_, { Element.argument; default = _ }) -> pattern check_env argument + | RestElement (_, { Pattern.RestElement.argument; comments = _ }) -> + pattern check_env argument + and identifier_pattern check_env { Pattern.Identifier.name = id; _ } = identifier check_env id + and identifier (env, param_names) ((loc, { Identifier.name; comments = _ }) as id) = + if SSet.mem name param_names then error_at env (loc, Parse_error.StrictParamDupe); + let (env, param_names) = identifier_no_dupe_check (env, param_names) id in + (env, SSet.add name param_names) + and identifier_no_dupe_check (env, param_names) (loc, { Identifier.name; comments = _ }) = + if is_restricted name then strict_error_at env (loc, Parse_error.StrictParamName); + if is_future_reserved name || is_strict_reserved name then + strict_error_at env (loc, Parse_error.StrictReservedWord); + (env, param_names) + in + pattern + + (* Strict is true if we were already in strict mode or if we are newly in + * strict mode due to a directive in the function. + * Simple is the IsSimpleParameterList thing from the ES6 spec *) + let strict_post_check + env ~strict ~simple id (_, { Ast.Function.Params.params; rest; this_ = _; comments = _ }) = + if strict || not simple then ( + (* If we are doing this check due to strict mode than there are two + * cases to consider. The first is when we were already in strict mode + * and therefore already threw strict errors. In this case we want to + * do these checks outside of strict mode. The other is if we + * originally parsed in non-strict mode but now are strict. Then we + * want to do these checks in strict mode *) + let env = + if strict then + env |> with_strict (not (Parser_env.in_strict_mode env)) + else + env + in + (match id with + | Some (loc, { Identifier.name; comments = _ }) -> + if is_restricted name then strict_error_at env (loc, Parse_error.StrictFunctionName); + if is_future_reserved name || is_strict_reserved name then + strict_error_at env (loc, Parse_error.StrictReservedWord) + | None -> ()); + let acc = + List.fold_left + (fun acc (_, { Function.Param.argument; default = _ }) -> check_param acc argument) + (env, SSet.empty) + params + in + match rest with + | Some (_, { Function.RestParam.argument; comments = _ }) -> ignore (check_param acc argument) + | None -> () + ) + + let function_params = + let rec param = + with_loc (fun env -> + if Peek.token env = T_THIS then error env Parse_error.ThisParamMustBeFirst; + let argument = Parse.pattern env Parse_error.StrictParamName in + let default = + if Peek.token env = T_ASSIGN then ( + Expect.token env T_ASSIGN; + Some (Parse.assignment env) + ) else + None + in + { Function.Param.argument; default } + ) + and param_list env acc = + match Peek.token env with + | (T_EOF | T_RPAREN | T_ELLIPSIS) as t -> + let rest = + if t = T_ELLIPSIS then + let leading = Peek.comments env in + let (loc, id) = + with_loc + (fun env -> + Expect.token env T_ELLIPSIS; + Parse.pattern env Parse_error.StrictParamName) + env + in + Some + ( loc, + { + Function.RestParam.argument = id; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + else + None + in + if Peek.token env <> T_RPAREN then error env Parse_error.ParameterAfterRestParameter; + (List.rev acc, rest) + | _ -> + let the_param = param env in + if Peek.token env <> T_RPAREN then Expect.token env T_COMMA; + param_list env (the_param :: acc) + in + let this_param_annotation env = + if should_parse_types env && Peek.token env = T_THIS then ( + let leading = Peek.comments env in + let (this_loc, this_param) = + with_loc + (fun env -> + Expect.token env T_THIS; + if Peek.token env <> T_COLON then begin + error env Parse_error.ThisParamAnnotationRequired; + None + end else + Some (Type.annotation env)) + env + in + match this_param with + | None -> None + | Some annot -> + if Peek.token env = T_COMMA then Eat.token env; + Some + ( this_loc, + { + Ast.Function.ThisParam.annot; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + ) else + None + in + fun ~await ~yield -> + with_loc (fun env -> + let env = + env + |> with_allow_await await + |> with_allow_yield yield + |> with_in_formal_parameters true + in + let leading = Peek.comments env in + Expect.token env T_LPAREN; + let this_ = this_param_annotation env in + let (params, rest) = param_list env [] in + let internal = Peek.comments env in + Expect.token env T_RPAREN; + let trailing = Eat.trailing_comments env in + { + Ast.Function.Params.params; + rest; + comments = Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal (); + this_; + } + ) + + let function_body env ~async ~generator ~expression = + let env = enter_function env ~async ~generator in + let (loc, block, strict) = Parse.function_block_body env ~expression in + (Function.BodyBlock (loc, block), strict) + + let variance env is_async is_generator = + let loc = Peek.loc env in + let variance = + match Peek.token env with + | T_PLUS -> + let leading = Peek.comments env in + Eat.token env; + Some + ( loc, + { Variance.kind = Variance.Plus; comments = Flow_ast_utils.mk_comments_opt ~leading () } + ) + | T_MINUS -> + let leading = Peek.comments env in + Eat.token env; + Some + ( loc, + { + Variance.kind = Variance.Minus; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + | _ -> None + in + match variance with + | Some (loc, _) when is_async || is_generator -> + error_at env (loc, Parse_error.UnexpectedVariance); + None + | _ -> variance + + let generator env = + if Peek.token env = T_MULT then ( + let leading = Peek.comments env in + Eat.token env; + (true, leading) + ) else + (false, []) + + (* Returns true and consumes a token if the token is `async` and the token after it is on + the same line (see https://tc39.github.io/ecma262/#sec-async-function-definitions) *) + let async env = + if Peek.token env = T_ASYNC && not (Peek.ith_is_line_terminator ~i:1 env) then + let leading = Peek.comments env in + let () = Eat.token env in + (true, leading) + else + (false, []) + + let is_simple_function_params = + let is_simple_param = function + | (_, { Ast.Function.Param.argument = (_, Pattern.Identifier _); default = None }) -> true + | _ -> false + in + fun (_, { Ast.Function.Params.params; rest; comments = _; this_ = _ }) -> + rest = None && List.for_all is_simple_param params + + let _function = + with_loc (fun env -> + let (async, leading_async) = async env in + let (sig_loc, (generator, tparams, id, params, return, predicate, leading)) = + with_loc + (fun env -> + let leading_function = Peek.comments env in + Expect.token env T_FUNCTION; + let (generator, leading_generator) = generator env in + let leading = List.concat [leading_async; leading_function; leading_generator] in + let (tparams, id) = + match (in_export env, Peek.token env) with + | (true, T_LPAREN) -> (None, None) + | (true, T_LESS_THAN) -> + let tparams = type_params_remove_trailing env (Type.type_params env) in + let id = + if Peek.token env = T_LPAREN then + None + else + let id = + id_remove_trailing + env + (Parse.identifier ~restricted_error:Parse_error.StrictFunctionName env) + in + Some id + in + (tparams, id) + | _ -> + let id = + id_remove_trailing + env + (Parse.identifier ~restricted_error:Parse_error.StrictFunctionName env) + in + let tparams = type_params_remove_trailing env (Type.type_params env) in + (tparams, Some id) + in + let params = + let params = function_params ~await:async ~yield:generator env in + if Peek.token env = T_COLON then + params + else + function_params_remove_trailing env params + in + let (return, predicate) = Type.annotation_and_predicate_opt env in + let (return, predicate) = + match predicate with + | None -> (type_annotation_hint_remove_trailing env return, predicate) + | Some _ -> (return, predicate_remove_trailing env predicate) + in + (generator, tparams, id, params, return, predicate, leading)) + env + in + let (body, strict) = function_body env ~async ~generator ~expression:false in + let simple = is_simple_function_params params in + strict_post_check env ~strict ~simple id params; + Statement.FunctionDeclaration + { + Function.id; + params; + body; + generator; + async; + predicate; + return; + tparams; + sig_loc; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + + let variable_declaration_list = + let variable_declaration env = + let (loc, (decl, err)) = + with_loc + (fun env -> + let id = Parse.pattern env Parse_error.StrictVarName in + let (init, err) = + if Eat.maybe env T_ASSIGN then + (Some (Parse.assignment env), None) + else + match id with + | (_, Ast.Pattern.Identifier _) -> (None, None) + | (loc, _) -> (None, Some (loc, Parse_error.NoUninitializedDestructuring)) + in + (Ast.Statement.VariableDeclaration.Declarator.{ id; init }, err)) + env + in + ((loc, decl), err) + in + let rec helper env decls errs = + let (decl, err) = variable_declaration env in + let decls = decl :: decls in + let errs = + match err with + | Some x -> x :: errs + | None -> errs + in + if Eat.maybe env T_COMMA then + helper env decls errs + else + (List.rev decls, List.rev errs) + in + (fun env -> helper env [] []) + + let declarations token env = + let leading = Peek.comments env in + Expect.token env token; + let (declarations, errs) = variable_declaration_list env in + (declarations, leading, errs) + + let var = declarations T_VAR + + let const env = + let env = env |> with_no_let true in + let (declarations, leading_comments, errs) = declarations T_CONST env in + (* Make sure all consts defined are initialized *) + let errs = + List.fold_left + (fun errs decl -> + match decl with + | (loc, { Statement.VariableDeclaration.Declarator.init = None; _ }) -> + (loc, Parse_error.NoUninitializedConst) :: errs + | _ -> errs) + errs + declarations + in + (declarations, leading_comments, List.rev errs) + + let let_ env = + let env = env |> with_no_let true in + declarations T_LET env + + let enum_declaration = Enum.declaration +end diff --git a/flow/parser/dune b/flow/parser/dune new file mode 100644 index 0000000000..441aabe446 --- /dev/null +++ b/flow/parser/dune @@ -0,0 +1,4 @@ +(library + (name flow_parser) + (libraries sedlex) + (preprocess (pps sedlex.ppx))) diff --git a/flow/parser/enum_common.ml b/flow/parser/enum_common.ml new file mode 100644 index 0000000000..f32bd2028e --- /dev/null +++ b/flow/parser/enum_common.ml @@ -0,0 +1,19 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +type explicit_type = + | Boolean + | Number + | String + | Symbol +[@@deriving ord] + +let string_of_explicit_type = function + | Boolean -> "boolean" + | Number -> "number" + | String -> "string" + | Symbol -> "symbol" diff --git a/flow/parser/enum_parser.ml b/flow/parser/enum_parser.ml new file mode 100644 index 0000000000..0683a7787f --- /dev/null +++ b/flow/parser/enum_parser.ml @@ -0,0 +1,436 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open Flow_ast +open Parser_common +open Parser_env +open Token +module SSet = Flow_set.Make (String) + +module Enum (Parse : Parser_common.PARSER) : sig + val declaration : env -> (Loc.t, Loc.t) Statement.t +end = struct + open Flow_ast.Statement.EnumDeclaration + + type members = { + boolean_members: (Loc.t BooleanLiteral.t, Loc.t) InitializedMember.t list; + number_members: (Loc.t NumberLiteral.t, Loc.t) InitializedMember.t list; + string_members: (Loc.t StringLiteral.t, Loc.t) InitializedMember.t list; + defaulted_members: Loc.t DefaultedMember.t list; + } + + type acc = { + members: members; + seen_names: SSet.t; + has_unknown_members: bool; + internal_comments: Loc.t Comment.t list; + } + + type init = + | NoInit + | InvalidInit of Loc.t + | BooleanInit of Loc.t * Loc.t BooleanLiteral.t + | NumberInit of Loc.t * Loc.t NumberLiteral.t + | StringInit of Loc.t * Loc.t StringLiteral.t + + let empty_members = + { boolean_members = []; number_members = []; string_members = []; defaulted_members = [] } + + let empty_acc = + { + members = empty_members; + seen_names = SSet.empty; + has_unknown_members = false; + internal_comments = []; + } + + let end_of_member_init env = + match Peek.token env with + | T_SEMICOLON + | T_COMMA + | T_RCURLY -> + true + | _ -> false + + let member_init env = + let loc = Peek.loc env in + let leading = Peek.comments env in + match Peek.token env with + | T_NUMBER { kind; raw } -> + let value = Parse.number env kind raw in + let trailing = Eat.trailing_comments env in + if end_of_member_init env then + NumberInit + ( loc, + { + NumberLiteral.value; + raw; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + else + InvalidInit loc + | T_STRING (loc, value, raw, octal) -> + if octal then strict_error env Parse_error.StrictOctalLiteral; + Eat.token env; + let trailing = Eat.trailing_comments env in + if end_of_member_init env then + StringInit + ( loc, + { + StringLiteral.value; + raw; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + else + InvalidInit loc + | (T_TRUE | T_FALSE) as token -> + Eat.token env; + let trailing = Eat.trailing_comments env in + if end_of_member_init env then + BooleanInit + ( loc, + { + BooleanLiteral.value = token = T_TRUE; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + else + InvalidInit loc + | _ -> + Eat.token env; + InvalidInit loc + + let member_raw = + with_loc (fun env -> + let id = identifier_name env in + let init = + match Peek.token env with + | T_ASSIGN -> + Expect.token env T_ASSIGN; + member_init env + | T_COLON -> + let (_, { Identifier.name = member_name; _ }) = id in + error env (Parse_error.EnumInvalidInitializerSeparator { member_name }); + Expect.token env T_COLON; + member_init env + | _ -> NoInit + in + (id, init) + ) + + let check_explicit_type_mismatch env ~enum_name ~explicit_type ~member_name literal_type loc = + match explicit_type with + | Some enum_type when enum_type <> literal_type -> + error_at + env + (loc, Parse_error.EnumInvalidMemberInitializer { enum_name; explicit_type; member_name }) + | _ -> () + + let is_a_to_z c = c >= 'a' && c <= 'z' + + let enum_member ~enum_name ~explicit_type acc env = + let { members; seen_names; _ } = acc in + let (member_loc, (id, init)) = member_raw env in + let (id_loc, { Identifier.name = member_name; _ }) = id in + (* if we parsed an empty name, something has gone wrong and we should abort analysis *) + if member_name = "" then + acc + else ( + if is_a_to_z @@ member_name.[0] then + error_at env (id_loc, Parse_error.EnumInvalidMemberName { enum_name; member_name }); + if SSet.mem member_name seen_names then + error_at env (id_loc, Parse_error.EnumDuplicateMemberName { enum_name; member_name }); + let acc = { acc with seen_names = SSet.add member_name seen_names } in + let check_explicit_type_mismatch = + check_explicit_type_mismatch env ~enum_name ~explicit_type ~member_name + in + match init with + | BooleanInit (loc, value) -> + check_explicit_type_mismatch Enum_common.Boolean loc; + let member = (member_loc, { InitializedMember.id; init = (loc, value) }) in + { acc with members = { members with boolean_members = member :: members.boolean_members } } + | NumberInit (loc, value) -> + check_explicit_type_mismatch Enum_common.Number loc; + let member = (member_loc, { InitializedMember.id; init = (loc, value) }) in + { acc with members = { members with number_members = member :: members.number_members } } + | StringInit (loc, value) -> + check_explicit_type_mismatch Enum_common.String loc; + let member = (member_loc, { InitializedMember.id; init = (loc, value) }) in + { acc with members = { members with string_members = member :: members.string_members } } + | InvalidInit loc -> + error_at + env + (loc, Parse_error.EnumInvalidMemberInitializer { enum_name; explicit_type; member_name }); + acc + | NoInit -> + begin + match explicit_type with + | Some Enum_common.Boolean -> + error_at + env + (member_loc, Parse_error.EnumBooleanMemberNotInitialized { enum_name; member_name }); + acc + | Some Enum_common.Number -> + error_at + env + (member_loc, Parse_error.EnumNumberMemberNotInitialized { enum_name; member_name }); + acc + | Some Enum_common.String + | Some Enum_common.Symbol + | None -> + let member = (member_loc, { DefaultedMember.id }) in + { + acc with + members = { members with defaulted_members = member :: members.defaulted_members }; + } + end + ) + + let rec enum_members ~enum_name ~explicit_type acc env = + match Peek.token env with + | T_RCURLY + | T_EOF -> + ( { + boolean_members = List.rev acc.members.boolean_members; + number_members = List.rev acc.members.number_members; + string_members = List.rev acc.members.string_members; + defaulted_members = List.rev acc.members.defaulted_members; + }, + acc.has_unknown_members, + acc.internal_comments + ) + | T_ELLIPSIS -> + let loc = Peek.loc env in + (* Internal comments may appear before the ellipsis *) + let internal_comments = Peek.comments env in + Eat.token env; + (match Peek.token env with + | T_RCURLY + | T_EOF -> + () + | T_COMMA -> + Expect.token env T_COMMA; + let trailing_comma = + match Peek.token env with + | T_RCURLY + | T_EOF -> + true + | _ -> false + in + error_at env (loc, Parse_error.EnumInvalidEllipsis { trailing_comma }) + | _ -> error_at env (loc, Parse_error.EnumInvalidEllipsis { trailing_comma = false })); + enum_members + ~enum_name + ~explicit_type + { acc with has_unknown_members = true; internal_comments } + env + | _ -> + let acc = enum_member ~enum_name ~explicit_type acc env in + (match Peek.token env with + | T_RCURLY + | T_EOF -> + () + | T_SEMICOLON -> + error env Parse_error.EnumInvalidMemberSeparator; + Expect.token env T_SEMICOLON + | _ -> Expect.token env T_COMMA); + enum_members ~enum_name ~explicit_type acc env + + let string_body + ~env ~enum_name ~is_explicit ~has_unknown_members string_members defaulted_members comments = + let initialized_len = List.length string_members in + let defaulted_len = List.length defaulted_members in + let defaulted_body () = + StringBody + { + StringBody.members = StringBody.Defaulted defaulted_members; + explicit_type = is_explicit; + has_unknown_members; + comments; + } + in + let initialized_body () = + StringBody + { + StringBody.members = StringBody.Initialized string_members; + explicit_type = is_explicit; + has_unknown_members; + comments; + } + in + match (initialized_len, defaulted_len) with + | (0, 0) + | (0, _) -> + defaulted_body () + | (_, 0) -> initialized_body () + | _ when defaulted_len > initialized_len -> + List.iter + (fun (loc, _) -> + error_at env (loc, Parse_error.EnumStringMemberInconsistentlyInitailized { enum_name })) + string_members; + defaulted_body () + | _ -> + List.iter + (fun (loc, _) -> + error_at env (loc, Parse_error.EnumStringMemberInconsistentlyInitailized { enum_name })) + defaulted_members; + initialized_body () + + let parse_explicit_type ~enum_name env = + if Eat.maybe env T_OF then ( + Eat.push_lex_mode env Lex_mode.TYPE; + let result = + match Peek.token env with + | T_BOOLEAN_TYPE BOOLEAN -> Some Enum_common.Boolean + | T_NUMBER_TYPE -> Some Enum_common.Number + | T_STRING_TYPE -> Some Enum_common.String + | T_SYMBOL_TYPE -> Some Enum_common.Symbol + | T_IDENTIFIER { value; _ } -> + let supplied_type = Some value in + error env (Parse_error.EnumInvalidExplicitType { enum_name; supplied_type }); + None + | _ -> + error env (Parse_error.EnumInvalidExplicitType { enum_name; supplied_type = None }); + None + in + Eat.token env; + Eat.pop_lex_mode env; + result + ) else + None + + let enum_body ~enum_name ~name_loc = + with_loc (fun env -> + let explicit_type = parse_explicit_type ~enum_name env in + let leading = + if explicit_type <> None then + Peek.comments env + else + [] + in + Expect.token env T_LCURLY; + let (members, has_unknown_members, internal) = + enum_members ~enum_name ~explicit_type empty_acc env + in + let internal = internal @ Peek.comments env in + Expect.token env T_RCURLY; + let trailing = + match Peek.token env with + | T_EOF + | T_RCURLY -> + Eat.trailing_comments env + | _ when Peek.is_line_terminator env -> Eat.comments_until_next_line env + | _ -> [] + in + let comments = + Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal () + in + let body = + match explicit_type with + | Some Enum_common.Boolean -> + BooleanBody + { + BooleanBody.members = members.boolean_members; + explicit_type = true; + has_unknown_members; + comments; + } + | Some Enum_common.Number -> + NumberBody + { + NumberBody.members = members.number_members; + explicit_type = true; + has_unknown_members; + comments; + } + | Some Enum_common.String -> + string_body + ~env + ~enum_name + ~is_explicit:true + ~has_unknown_members + members.string_members + members.defaulted_members + comments + | Some Enum_common.Symbol -> + SymbolBody + { SymbolBody.members = members.defaulted_members; has_unknown_members; comments } + | None -> + let bools_len = List.length members.boolean_members in + let nums_len = List.length members.number_members in + let strs_len = List.length members.string_members in + let defaulted_len = List.length members.defaulted_members in + let empty () = + StringBody + { + StringBody.members = StringBody.Defaulted []; + explicit_type = false; + has_unknown_members; + comments; + } + in + begin + match (bools_len, nums_len, strs_len, defaulted_len) with + | (0, 0, 0, 0) -> empty () + | (0, 0, _, _) -> + string_body + ~env + ~enum_name + ~is_explicit:false + ~has_unknown_members + members.string_members + members.defaulted_members + comments + | (_, 0, 0, _) when bools_len >= defaulted_len -> + List.iter + (fun (loc, { DefaultedMember.id = (_, { Identifier.name = member_name; _ }) }) -> + error_at + env + (loc, Parse_error.EnumBooleanMemberNotInitialized { enum_name; member_name })) + members.defaulted_members; + BooleanBody + { + BooleanBody.members = members.boolean_members; + explicit_type = false; + has_unknown_members; + comments; + } + | (0, _, 0, _) when nums_len >= defaulted_len -> + List.iter + (fun (loc, { DefaultedMember.id = (_, { Identifier.name = member_name; _ }) }) -> + error_at + env + (loc, Parse_error.EnumNumberMemberNotInitialized { enum_name; member_name })) + members.defaulted_members; + NumberBody + { + NumberBody.members = members.number_members; + explicit_type = false; + has_unknown_members; + comments; + } + | _ -> + error_at env (name_loc, Parse_error.EnumInconsistentMemberValues { enum_name }); + empty () + end + in + body + ) + + let declaration = + with_loc (fun env -> + let leading = Peek.comments env in + Expect.token env T_ENUM; + let id = Parse.identifier env in + let (name_loc, { Identifier.name = enum_name; _ }) = id in + let body = enum_body ~enum_name ~name_loc env in + let comments = Flow_ast_utils.mk_comments_opt ~leading () in + Statement.EnumDeclaration { id; body; comments } + ) +end diff --git a/flow/parser/expression_parser.ml b/flow/parser/expression_parser.ml new file mode 100644 index 0000000000..fb64c074ec --- /dev/null +++ b/flow/parser/expression_parser.ml @@ -0,0 +1,1726 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +module Ast = Flow_ast +open Token +open Parser_env +open Flow_ast +open Parser_common +open Comment_attachment + +module type EXPRESSION = sig + val assignment : env -> (Loc.t, Loc.t) Expression.t + + val assignment_cover : env -> pattern_cover + + val conditional : env -> (Loc.t, Loc.t) Expression.t + + val is_assignable_lhs : (Loc.t, Loc.t) Expression.t -> bool + + val left_hand_side : env -> (Loc.t, Loc.t) Expression.t + + val number : env -> number_type -> string -> float + + val sequence : + env -> start_loc:Loc.t -> (Loc.t, Loc.t) Expression.t list -> (Loc.t, Loc.t) Expression.t +end + +module Expression + (Parse : PARSER) + (Type : Type_parser.TYPE) + (Declaration : Declaration_parser.DECLARATION) + (Pattern_cover : Pattern_cover.COVER) : EXPRESSION = struct + type op_precedence = + | Left_assoc of int + | Right_assoc of int + + type group_cover = + | Group_expr of (Loc.t, Loc.t) Expression.t + | Group_typecast of (Loc.t, Loc.t) Expression.TypeCast.t + + let is_tighter a b = + let a_prec = + match a with + | Left_assoc x -> x + | Right_assoc x -> x - 1 + in + let b_prec = + match b with + | Left_assoc x -> x + | Right_assoc x -> x + in + a_prec >= b_prec + + let is_assignable_lhs = + let open Expression in + function + | ( _, + MetaProperty + { + MetaProperty.meta = (_, { Identifier.name = "new"; comments = _ }); + property = (_, { Identifier.name = "target"; comments = _ }); + comments = _; + } + ) -> + false + | ( _, + MetaProperty + { + MetaProperty.meta = (_, { Identifier.name = "import"; comments = _ }); + property = (_, { Identifier.name = "meta"; comments = _ }); + comments = _; + } + ) -> + false + (* #sec-static-semantics-static-semantics-isvalidsimpleassignmenttarget *) + | (_, Array _) + | (_, Identifier _) + | (_, Member _) + | (_, MetaProperty _) + | (_, Object _) -> + true + | (_, ArrowFunction _) + | (_, Assignment _) + | (_, Binary _) + | (_, Call _) + | (_, Class _) + | (_, Comprehension _) + | (_, Conditional _) + | (_, Function _) + | (_, Generator _) + | (_, Import _) + | (_, JSXElement _) + | (_, JSXFragment _) + | (_, Literal _) + | (_, Logical _) + | (_, New _) + | (_, OptionalCall _) + | (_, OptionalMember _) + | (_, Sequence _) + | (_, Super _) + | (_, TaggedTemplate _) + | (_, TemplateLiteral _) + | (_, This _) + | (_, TypeCast _) + | (_, Unary _) + | (_, Update _) + | (_, Yield _) -> + false + + let as_expression = Pattern_cover.as_expression + + let as_pattern = Pattern_cover.as_pattern + + (* AssignmentExpression : + * [+Yield] YieldExpression + * ConditionalExpression + * LeftHandSideExpression = AssignmentExpression + * LeftHandSideExpression AssignmentOperator AssignmentExpression + * ArrowFunctionFunction + * + * Originally we were parsing this without backtracking, but + * ArrowFunctionExpression got too tricky. Oh well. + *) + let rec assignment_cover = + let assignment_but_not_arrow_function_cover env = + let start_loc = Peek.loc env in + let expr_or_pattern = conditional_cover env in + match assignment_op env with + | Some operator -> + let expr = + with_loc + ~start_loc + (fun env -> + let left = as_pattern env expr_or_pattern in + let right = assignment env in + Expression.(Assignment { Assignment.operator; left; right; comments = None })) + env + in + Cover_expr expr + | _ -> expr_or_pattern + in + let error_callback _ = function + (* Don't rollback on these errors. *) + | Parse_error.StrictReservedWord -> () + (* Everything else causes a rollback *) + | _ -> raise Try.Rollback + (* So we may or may not be parsing the first part of an arrow function + * (the part before the =>). We might end up parsing that whole thing or + * we might end up parsing only part of it and thinking we're done. We + * need to look at the next token to figure out if we really parsed an + * assignment expression or if this is just the beginning of an arrow + * function *) + in + let try_assignment_but_not_arrow_function env = + let env = env |> with_error_callback error_callback in + let ret = assignment_but_not_arrow_function_cover env in + match Peek.token env with + | T_ARROW -> + (* x => 123 *) + raise Try.Rollback + | T_COLON + when match last_token env with + | Some T_RPAREN -> true + | _ -> false -> + (* (x): number => 123 *) + raise Try.Rollback + (* async x => 123 -- and we've already parsed async as an identifier + * expression *) + | _ when Peek.is_identifier env -> + begin + match ret with + | Cover_expr (_, Expression.Identifier (_, { Identifier.name = "async"; comments = _ })) + when not (Peek.is_line_terminator env) -> + raise Try.Rollback + | _ -> ret + end + | _ -> ret + in + fun env -> + match (Peek.token env, Peek.is_identifier env) with + | (T_YIELD, _) when allow_yield env -> Cover_expr (yield env) + | ((T_LPAREN as t), _) + | ((T_LESS_THAN as t), _) + | ((T_THIS as t), _) + | (t, true) -> + (* Ok, we don't know if this is going to be an arrow function or a + * regular assignment expression. Let's first try to parse it as an + * assignment expression. If that fails we'll try an arrow function. + * Unless it begins with `async <` in which case we first try parsing + * it as an arrow function, and then an assignment expression. + *) + let (initial, secondary) = + if t = T_ASYNC && should_parse_types env && Peek.ith_token ~i:1 env = T_LESS_THAN then + (try_arrow_function, try_assignment_but_not_arrow_function) + else + (try_assignment_but_not_arrow_function, try_arrow_function) + in + (match Try.to_parse env initial with + | Try.ParsedSuccessfully expr -> expr + | Try.FailedToParse -> + (match Try.to_parse env secondary with + | Try.ParsedSuccessfully expr -> expr + | Try.FailedToParse -> + (* Well shoot. It doesn't parse cleanly as a normal + * expression or as an arrow_function. Let's treat it as a + * normal assignment expression gone wrong *) + assignment_but_not_arrow_function_cover env)) + | _ -> assignment_but_not_arrow_function_cover env + + and assignment env = as_expression env (assignment_cover env) + + and yield env = + with_loc + (fun env -> + if in_formal_parameters env then error env Parse_error.YieldInFormalParameters; + let leading = Peek.comments env in + Expect.token env T_YIELD; + let (argument, delegate) = + if Peek.is_implicit_semicolon env then + (None, false) + else + let delegate = Eat.maybe env T_MULT in + let has_argument = + match Peek.token env with + | T_SEMICOLON + | T_RBRACKET + | T_RCURLY + | T_RPAREN + | T_COLON + | T_COMMA -> + false + | _ -> true + in + let argument = + if delegate || has_argument then + Some (assignment env) + else + None + in + (argument, delegate) + in + let trailing = + match argument with + | None -> Eat.trailing_comments env + | Some _ -> [] + in + let open Expression in + Yield + Yield. + { argument; delegate; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + env + + and is_lhs = + let open Expression in + function + | ( _, + MetaProperty + { + MetaProperty.meta = (_, { Identifier.name = "new"; comments = _ }); + property = (_, { Identifier.name = "target"; comments = _ }); + comments = _; + } + ) -> + false + | ( _, + MetaProperty + { + MetaProperty.meta = (_, { Identifier.name = "import"; comments = _ }); + property = (_, { Identifier.name = "meta"; comments = _ }); + comments = _; + } + ) -> + false + (* #sec-static-semantics-static-semantics-isvalidsimpleassignmenttarget *) + | (_, Identifier _) + | (_, Member _) + | (_, MetaProperty _) -> + true + | (_, Array _) + | (_, ArrowFunction _) + | (_, Assignment _) + | (_, Binary _) + | (_, Call _) + | (_, Class _) + | (_, Comprehension _) + | (_, Conditional _) + | (_, Function _) + | (_, Generator _) + | (_, Import _) + | (_, JSXElement _) + | (_, JSXFragment _) + | (_, Literal _) + | (_, Logical _) + | (_, New _) + | (_, Object _) + | (_, OptionalCall _) + | (_, OptionalMember _) + | (_, Sequence _) + | (_, Super _) + | (_, TaggedTemplate _) + | (_, TemplateLiteral _) + | (_, This _) + | (_, TypeCast _) + | (_, Unary _) + | (_, Update _) + | (_, Yield _) -> + false + + and assignment_op env = + let op = + let open Expression.Assignment in + match Peek.token env with + | T_RSHIFT3_ASSIGN -> Some (Some RShift3Assign) + | T_RSHIFT_ASSIGN -> Some (Some RShiftAssign) + | T_LSHIFT_ASSIGN -> Some (Some LShiftAssign) + | T_BIT_XOR_ASSIGN -> Some (Some BitXorAssign) + | T_BIT_OR_ASSIGN -> Some (Some BitOrAssign) + | T_BIT_AND_ASSIGN -> Some (Some BitAndAssign) + | T_MOD_ASSIGN -> Some (Some ModAssign) + | T_DIV_ASSIGN -> Some (Some DivAssign) + | T_MULT_ASSIGN -> Some (Some MultAssign) + | T_EXP_ASSIGN -> Some (Some ExpAssign) + | T_MINUS_ASSIGN -> Some (Some MinusAssign) + | T_PLUS_ASSIGN -> Some (Some PlusAssign) + | T_ASSIGN -> Some None + | _ -> None + in + if op <> None then Eat.token env; + op + + (* ConditionalExpression : + * LogicalExpression + * LogicalExpression ? AssignmentExpression : AssignmentExpression + *) + and conditional_cover env = + let start_loc = Peek.loc env in + let expr = logical_cover env in + if Peek.token env = T_PLING then ( + Eat.token env; + + (* no_in is ignored for the consequent *) + let env' = env |> with_no_in false in + let consequent = assignment env' in + Expect.token env T_COLON; + let (end_loc, alternate) = with_loc assignment env in + let loc = Loc.btwn start_loc end_loc in + Cover_expr + ( loc, + let open Expression in + Conditional + { Conditional.test = as_expression env expr; consequent; alternate; comments = None } + ) + ) else + expr + + and conditional env = as_expression env (conditional_cover env) + + (* + * LogicalANDExpression : + * BinaryExpression + * LogicalANDExpression && BitwiseORExpression + * + * LogicalORExpression : + * LogicalANDExpression + * LogicalORExpression || LogicalANDExpression + * LogicalORExpression ?? LogicalANDExpression + * + * LogicalExpression : + * LogicalORExpression + *) + and logical_cover = + let open Expression in + let make_logical env left right operator loc = + let left = as_expression env left in + let right = as_expression env right in + Cover_expr (loc, Logical { Logical.operator; left; right; comments = None }) + in + let rec logical_and env left lloc = + match Peek.token env with + | T_AND -> + Eat.token env; + let (rloc, right) = with_loc binary_cover env in + let loc = Loc.btwn lloc rloc in + let left = make_logical env left right Logical.And loc in + (* `a && b ?? c` is an error, but to recover, try to parse it like `(a && b) ?? c`. *) + let (loc, left) = coalesce ~allowed:false env left loc in + logical_and env left loc + | _ -> (lloc, left) + and logical_or env left lloc = + match Peek.token env with + | T_OR -> + Eat.token env; + let (rloc, right) = with_loc binary_cover env in + let (rloc, right) = logical_and env right rloc in + let loc = Loc.btwn lloc rloc in + let left = make_logical env left right Logical.Or loc in + (* `a || b ?? c` is an error, but to recover, try to parse it like `(a || b) ?? c`. *) + let (loc, left) = coalesce ~allowed:false env left loc in + logical_or env left loc + | _ -> (lloc, left) + and coalesce ~allowed env left lloc = + match Peek.token env with + | T_PLING_PLING -> + if not allowed then error env (Parse_error.NullishCoalescingUnexpectedLogical "??"); + + Expect.token env T_PLING_PLING; + let (rloc, right) = with_loc binary_cover env in + let (rloc, right) = + match Peek.token env with + | (T_AND | T_OR) as t -> + (* `a ?? b || c` is an error. To recover, treat it like `a ?? (b || c)`. *) + error env (Parse_error.NullishCoalescingUnexpectedLogical (Token.value_of_token t)); + let (rloc, right) = logical_and env right rloc in + logical_or env right rloc + | _ -> (rloc, right) + in + let loc = Loc.btwn lloc rloc in + coalesce ~allowed:true env (make_logical env left right Logical.NullishCoalesce loc) loc + | _ -> (lloc, left) + in + fun env -> + let (loc, left) = with_loc binary_cover env in + let (_, left) = + match Peek.token env with + | T_PLING_PLING -> coalesce ~allowed:true env left loc + | _ -> + let (loc, left) = logical_and env left loc in + logical_or env left loc + in + left + + and binary_cover = + let binary_op env = + let ret = + let open Expression.Binary in + match Peek.token env with + (* Most BinaryExpression operators are left associative *) + (* Lowest pri *) + | T_BIT_OR -> Some (BitOr, Left_assoc 2) + | T_BIT_XOR -> Some (Xor, Left_assoc 3) + | T_BIT_AND -> Some (BitAnd, Left_assoc 4) + | T_EQUAL -> Some (Equal, Left_assoc 5) + | T_STRICT_EQUAL -> Some (StrictEqual, Left_assoc 5) + | T_NOT_EQUAL -> Some (NotEqual, Left_assoc 5) + | T_STRICT_NOT_EQUAL -> Some (StrictNotEqual, Left_assoc 5) + | T_LESS_THAN -> Some (LessThan, Left_assoc 6) + | T_LESS_THAN_EQUAL -> Some (LessThanEqual, Left_assoc 6) + | T_GREATER_THAN -> Some (GreaterThan, Left_assoc 6) + | T_GREATER_THAN_EQUAL -> Some (GreaterThanEqual, Left_assoc 6) + | T_IN -> + if no_in env then + None + else + Some (In, Left_assoc 6) + | T_INSTANCEOF -> Some (Instanceof, Left_assoc 6) + | T_LSHIFT -> Some (LShift, Left_assoc 7) + | T_RSHIFT -> Some (RShift, Left_assoc 7) + | T_RSHIFT3 -> Some (RShift3, Left_assoc 7) + | T_PLUS -> Some (Plus, Left_assoc 8) + | T_MINUS -> Some (Minus, Left_assoc 8) + | T_MULT -> Some (Mult, Left_assoc 9) + | T_DIV -> Some (Div, Left_assoc 9) + | T_MOD -> Some (Mod, Left_assoc 9) + | T_EXP -> Some (Exp, Right_assoc 10) + (* Highest priority *) + | _ -> None + in + if ret <> None then Eat.token env; + ret + in + let make_binary left right operator loc = + (loc, Expression.(Binary Binary.{ operator; left; right; comments = None })) + in + let rec add_to_stack right (rop, rpri) rloc = function + | (left, (lop, lpri), lloc) :: rest when is_tighter lpri rpri -> + let loc = Loc.btwn lloc rloc in + let right = make_binary left right lop loc in + add_to_stack right (rop, rpri) loc rest + | stack -> (right, (rop, rpri), rloc) :: stack + in + let rec collapse_stack right rloc = function + | [] -> right + | (left, (lop, _), lloc) :: rest -> + let loc = Loc.btwn lloc rloc in + collapse_stack (make_binary left right lop loc) loc rest + in + let rec helper env stack = + let (right_loc, (is_unary, right)) = + with_loc + (fun env -> + let is_unary = peek_unary_op env <> None in + let right = unary_cover (env |> with_no_in false) in + (is_unary, right)) + env + in + ( if Peek.token env = T_LESS_THAN then + match right with + | Cover_expr (_, Expression.JSXElement _) -> error env Parse_error.AdjacentJSXElements + | _ -> () + ); + match (stack, binary_op env) with + | ([], None) -> right + | (_, None) -> + let right = as_expression env right in + Cover_expr (collapse_stack right right_loc stack) + | (_, Some (rop, rpri)) -> + if is_unary && rop = Expression.Binary.Exp then + error_at env (right_loc, Parse_error.InvalidLHSInExponentiation); + let right = as_expression env right in + helper env (add_to_stack right (rop, rpri) right_loc stack) + in + (fun env -> helper env []) + + and peek_unary_op env = + let open Expression.Unary in + match Peek.token env with + | T_NOT -> Some Not + | T_BIT_NOT -> Some BitNot + | T_PLUS -> Some Plus + | T_MINUS -> Some Minus + | T_TYPEOF -> Some Typeof + | T_VOID -> Some Void + | T_DELETE -> Some Delete + (* If we are in a unary expression context, and within an async function, + * assume that a use of "await" is intended as a keyword, not an ordinary + * identifier. This is a little bit inconsistent, since it can be used as + * an identifier in other contexts (such as a variable name), but it's how + * Babel does it. *) + | T_AWAIT when allow_await env -> Some Await + | _ -> None + + and unary_cover env = + let begin_loc = Peek.loc env in + let leading = Peek.comments env in + let op = peek_unary_op env in + match op with + | None -> + let op = + let open Expression.Update in + match Peek.token env with + | T_INCR -> Some Increment + | T_DECR -> Some Decrement + | _ -> None + in + (match op with + | None -> postfix_cover env + | Some operator -> + Eat.token env; + let (end_loc, argument) = with_loc unary env in + if not (is_lhs argument) then error_at env (fst argument, Parse_error.InvalidLHSInAssignment); + (match argument with + | (_, Expression.Identifier (_, { Identifier.name; comments = _ })) when is_restricted name + -> + strict_error env Parse_error.StrictLHSPrefix + | _ -> ()); + let loc = Loc.btwn begin_loc end_loc in + Cover_expr + ( loc, + Expression.( + Update + { + Update.operator; + prefix = true; + argument; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + )) + | Some operator -> + Eat.token env; + let (end_loc, argument) = with_loc unary env in + let loc = Loc.btwn begin_loc end_loc in + let open Expression in + (match (operator, argument) with + | (Unary.Delete, (_, Identifier _)) -> strict_error_at env (loc, Parse_error.StrictDelete) + | (Unary.Delete, (_, Member member)) -> + begin + match member.Ast.Expression.Member.property with + | Ast.Expression.Member.PropertyPrivateName _ -> + error_at env (loc, Parse_error.PrivateDelete) + | _ -> () + end + | _ -> ()); + Cover_expr + ( loc, + let open Expression in + Unary { Unary.operator; argument; comments = Flow_ast_utils.mk_comments_opt ~leading () } + ) + + and unary env = as_expression env (unary_cover env) + + and postfix_cover env = + let argument = left_hand_side_cover env in + (* No line terminator allowed before operator *) + if Peek.is_line_terminator env then + argument + else + let op = + let open Expression.Update in + match Peek.token env with + | T_INCR -> Some Increment + | T_DECR -> Some Decrement + | _ -> None + in + match op with + | None -> argument + | Some operator -> + let argument = as_expression env argument in + if not (is_lhs argument) then error_at env (fst argument, Parse_error.InvalidLHSInAssignment); + (match argument with + | (_, Expression.Identifier (_, { Identifier.name; comments = _ })) when is_restricted name + -> + strict_error env Parse_error.StrictLHSPostfix + | _ -> ()); + let end_loc = Peek.loc env in + Eat.token env; + let trailing = Eat.trailing_comments env in + let loc = Loc.btwn (fst argument) end_loc in + Cover_expr + ( loc, + Expression.( + Update + { + Update.operator; + prefix = false; + argument; + comments = Flow_ast_utils.mk_comments_opt ~trailing (); + } + ) + ) + + and left_hand_side_cover env = + let start_loc = Peek.loc env in + let allow_new = not (no_new env) in + let env = with_no_new false env in + let expr = + match Peek.token env with + | T_NEW when allow_new -> Cover_expr (new_expression env) + | T_IMPORT -> Cover_expr (import env) + | T_SUPER -> Cover_expr (super env) + | _ when Peek.is_function env -> Cover_expr (_function env) + | _ -> primary_cover env + in + call_cover env start_loc expr + + and left_hand_side env = as_expression env (left_hand_side_cover env) + + and super env = + let (allowed, call_allowed) = + match allow_super env with + | No_super -> (false, false) + | Super_prop -> (true, false) + | Super_prop_or_call -> (true, true) + in + let loc = Peek.loc env in + let leading = Peek.comments env in + Expect.token env T_SUPER; + let trailing = Eat.trailing_comments env in + let super = + ( loc, + Expression.Super + { Expression.Super.comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + in + match Peek.token env with + | T_PERIOD + | T_LBRACKET -> + let super = + if not allowed then ( + error_at env (loc, Parse_error.UnexpectedSuper); + (loc, Expression.Identifier (Flow_ast_utils.ident_of_source (loc, "super"))) + ) else + super + in + call ~allow_optional_chain:false env loc super + | T_LPAREN -> + let super = + if not call_allowed then ( + error_at env (loc, Parse_error.UnexpectedSuperCall); + (loc, Expression.Identifier (Flow_ast_utils.ident_of_source (loc, "super"))) + ) else + super + in + call ~allow_optional_chain:false env loc super + | _ -> + if not allowed then + error_at env (loc, Parse_error.UnexpectedSuper) + else + error_unexpected ~expected:"either a call or access of `super`" env; + super + + and import env = + with_loc + (fun env -> + let leading = Peek.comments env in + let start_loc = Peek.loc env in + Expect.token env T_IMPORT; + if Eat.maybe env T_PERIOD then ( + (* import.meta *) + let import_ident = Flow_ast_utils.ident_of_source (start_loc, "import") in + let meta_loc = Peek.loc env in + Expect.identifier env "meta"; + let meta_ident = Flow_ast_utils.ident_of_source (meta_loc, "meta") in + let trailing = Eat.trailing_comments env in + Expression.MetaProperty + { + Expression.MetaProperty.meta = import_ident; + property = meta_ident; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) else + let leading_arg = Peek.comments env in + Expect.token env T_LPAREN; + let argument = add_comments (assignment (with_no_in false env)) ~leading:leading_arg in + Expect.token env T_RPAREN; + let trailing = Eat.trailing_comments env in + Expression.Import + { + Expression.Import.argument; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + }) + env + + and call_cover ?(allow_optional_chain = true) ?(in_optional_chain = false) env start_loc left = + let left = member_cover ~allow_optional_chain ~in_optional_chain env start_loc left in + let optional = + match last_token env with + | Some T_PLING_PERIOD -> true + | _ -> false + in + let left_to_callee env = + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing (as_expression env left) (fun remover left -> remover#expression left) + in + let arguments ?targs env callee = + let (args_loc, arguments) = arguments env in + let loc = Loc.btwn start_loc args_loc in + let call = + { Expression.Call.callee; targs; arguments = (args_loc, arguments); comments = None } + in + let call = + if optional || in_optional_chain then + let open Expression in + OptionalCall { OptionalCall.call; optional } + else + Expression.Call call + in + let in_optional_chain = in_optional_chain || optional in + call_cover ~allow_optional_chain ~in_optional_chain env start_loc (Cover_expr (loc, call)) + in + if no_call env then + left + else + match Peek.token env with + | T_LPAREN -> arguments env (left_to_callee env) + | T_LESS_THAN when should_parse_types env -> + (* If we are parsing types, then f(e) is a function call with a + type application. If we aren't, it's a nested binary expression. *) + let error_callback _ _ = raise Try.Rollback in + let env = env |> with_error_callback error_callback in + (* Parameterized call syntax is ambiguous, so we fall back to + standard parsing if it fails. *) + Try.or_else env ~fallback:left (fun env -> + let callee = left_to_callee env in + let targs = call_type_args env in + arguments ?targs env callee + ) + | _ -> left + + and call ?(allow_optional_chain = true) env start_loc left = + as_expression env (call_cover ~allow_optional_chain env start_loc (Cover_expr left)) + + and new_expression env = + with_loc + (fun env -> + let start_loc = Peek.loc env in + let leading = Peek.comments env in + Expect.token env T_NEW; + + if in_function env && Peek.token env = T_PERIOD then ( + let trailing = Eat.trailing_comments env in + Eat.token env; + let meta = + Flow_ast_utils.ident_of_source + (start_loc, "new") + ?comments:(Flow_ast_utils.mk_comments_opt ~leading ~trailing ()) + in + match Peek.token env with + | T_IDENTIFIER { raw = "target"; _ } -> + let property = Parse.identifier env in + Expression.(MetaProperty MetaProperty.{ meta; property; comments = None }) + | _ -> + error_unexpected ~expected:"the identifier `target`" env; + Eat.token env; + + (* skip unknown identifier *) + Expression.Identifier meta + (* return `new` identifier *) + ) else + let callee_loc = Peek.loc env in + let expr = + match Peek.token env with + | T_NEW -> new_expression env + | T_SUPER -> super (env |> with_no_call true) + | _ when Peek.is_function env -> _function env + | _ -> primary env + in + let callee = + member ~allow_optional_chain:false (env |> with_no_call true) callee_loc expr + in + (* You can do something like + * new raw`42` + *) + let callee = + let callee = + match Peek.token env with + | T_TEMPLATE_PART part -> tagged_template env callee_loc callee part + | _ -> callee + in + (* Remove trailing comments if the callee is followed by args or type args *) + if Peek.token env = T_LPAREN || (should_parse_types env && Peek.token env = T_LESS_THAN) + then + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing callee (fun remover callee -> remover#expression callee) + else + callee + in + let targs = + (* If we are parsing types, then new C(e) is a constructor with a + type application. If we aren't, it's a nested binary expression. *) + if should_parse_types env then + (* Parameterized call syntax is ambiguous, so we fall back to + standard parsing if it fails. *) + let error_callback _ _ = raise Try.Rollback in + let env = env |> with_error_callback error_callback in + Try.or_else env ~fallback:None call_type_args + else + None + in + let arguments = + match Peek.token env with + | T_LPAREN -> Some (arguments env) + | _ -> None + in + let comments = Flow_ast_utils.mk_comments_opt ~leading () in + Expression.(New New.{ callee; targs; arguments; comments })) + env + + and call_type_args = + let args = + let rec args_helper env acc = + match Peek.token env with + | T_EOF + | T_GREATER_THAN -> + List.rev acc + | _ -> + let t = + match Peek.token env with + | T_IDENTIFIER { value = "_"; _ } -> + let loc = Peek.loc env in + let leading = Peek.comments env in + Expect.identifier env "_"; + let trailing = Eat.trailing_comments env in + Expression.CallTypeArg.Implicit + ( loc, + { + Expression.CallTypeArg.Implicit.comments = + Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + | _ -> Expression.CallTypeArg.Explicit (Type._type env) + in + let acc = t :: acc in + if Peek.token env <> T_GREATER_THAN then Expect.token env T_COMMA; + args_helper env acc + in + fun env -> + let leading = Peek.comments env in + Expect.token env T_LESS_THAN; + let arguments = args_helper env [] in + let internal = Peek.comments env in + Expect.token env T_GREATER_THAN; + let trailing = + if Peek.token env = T_LPAREN then + let { trailing; _ } = trailing_and_remover env in + trailing + else + Eat.trailing_comments env + in + { + Expression.CallTypeArgs.arguments; + comments = Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal (); + } + in + fun env -> + if Peek.token env = T_LESS_THAN then + Some (with_loc args env) + else + None + + and arguments = + let spread_element env = + let leading = Peek.comments env in + Expect.token env T_ELLIPSIS; + let argument = assignment env in + Expression.SpreadElement.{ argument; comments = Flow_ast_utils.mk_comments_opt ~leading () } + in + let argument env = + match Peek.token env with + | T_ELLIPSIS -> Expression.Spread (with_loc spread_element env) + | _ -> Expression.Expression (assignment env) + in + let rec arguments' env acc = + match Peek.token env with + | T_EOF + | T_RPAREN -> + List.rev acc + | _ -> + let acc = argument env :: acc in + if Peek.token env <> T_RPAREN then Expect.token env T_COMMA; + arguments' env acc + in + fun env -> + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_LPAREN; + let args = arguments' env [] in + let internal = Peek.comments env in + Expect.token env T_RPAREN; + let trailing = Eat.trailing_comments env in + { + Expression.ArgList.arguments = args; + comments = Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal (); + }) + env + + and member_cover = + let dynamic + ?(allow_optional_chain = true) + ?(in_optional_chain = false) + ?(optional = false) + env + start_loc + left = + let expr = Parse.expression (env |> with_no_call false) in + let last_loc = Peek.loc env in + Expect.token env T_RBRACKET; + let trailing = Eat.trailing_comments env in + let loc = Loc.btwn start_loc last_loc in + let member = + Expression.Member. + { + _object = as_expression env left; + property = PropertyExpression expr; + comments = Flow_ast_utils.mk_comments_opt ~trailing (); + } + + in + + let member = + if in_optional_chain then + let open Expression in + OptionalMember { OptionalMember.member; optional } + else + Expression.Member member + in + call_cover ~allow_optional_chain ~in_optional_chain env start_loc (Cover_expr (loc, member)) + in + let static + ?(allow_optional_chain = true) + ?(in_optional_chain = false) + ?(optional = false) + env + start_loc + left = + let open Expression.Member in + let (id_loc, property) = + match Peek.token env with + | T_POUND -> + let ((id_loc, { Ast.PrivateName.name; _ }) as id) = private_identifier env in + add_used_private env name id_loc; + (id_loc, PropertyPrivateName id) + | _ -> + let ((id_loc, _) as id) = identifier_name env in + (id_loc, PropertyIdentifier id) + in + let loc = Loc.btwn start_loc id_loc in + (* super.PrivateName is a syntax error *) + begin + match (left, property) with + | (Cover_expr (_, Ast.Expression.Super _), PropertyPrivateName _) -> + error_at env (loc, Parse_error.SuperPrivate) + | _ -> () + end; + let member = + Expression.Member.{ _object = as_expression env left; property; comments = None } + in + let member = + if in_optional_chain then + let open Expression in + OptionalMember { OptionalMember.member; optional } + else + Expression.Member member + in + call_cover ~allow_optional_chain ~in_optional_chain env start_loc (Cover_expr (loc, member)) + in + fun ?(allow_optional_chain = true) ?(in_optional_chain = false) env start_loc left -> + match Peek.token env with + | T_PLING_PERIOD -> + if not allow_optional_chain then error env Parse_error.OptionalChainNew; + + Expect.token env T_PLING_PERIOD; + begin + match Peek.token env with + | T_TEMPLATE_PART _ -> + error env Parse_error.OptionalChainTemplate; + left + | T_LPAREN -> left + | T_LESS_THAN when should_parse_types env -> left + | T_LBRACKET -> + Eat.token env; + dynamic ~allow_optional_chain ~in_optional_chain:true ~optional:true env start_loc left + | _ -> + static ~allow_optional_chain ~in_optional_chain:true ~optional:true env start_loc left + end + | T_LBRACKET -> + Eat.token env; + dynamic ~allow_optional_chain ~in_optional_chain env start_loc left + | T_PERIOD -> + Eat.token env; + static ~allow_optional_chain ~in_optional_chain env start_loc left + | T_TEMPLATE_PART part -> + if in_optional_chain then error env Parse_error.OptionalChainTemplate; + + let expr = tagged_template env start_loc (as_expression env left) part in + call_cover ~allow_optional_chain:false env start_loc (Cover_expr expr) + | _ -> left + + and member ?(allow_optional_chain = true) env start_loc left = + as_expression env (member_cover ~allow_optional_chain env start_loc (Cover_expr left)) + + and _function env = + with_loc + (fun env -> + let (async, leading_async) = Declaration.async env in + let (sig_loc, (id, params, generator, predicate, return, tparams, leading)) = + with_loc + (fun env -> + let leading_function = Peek.comments env in + Expect.token env T_FUNCTION; + let (generator, leading_generator) = Declaration.generator env in + let leading = List.concat [leading_async; leading_function; leading_generator] in + (* `await` is a keyword in async functions: + - proposal-async-iteration/#prod-AsyncGeneratorExpression + - #prod-AsyncFunctionExpression *) + let await = async in + (* `yield` is a keyword in generator functions: + - proposal-async-iteration/#prod-AsyncGeneratorExpression + - #prod-GeneratorExpression *) + let yield = generator in + let (id, tparams) = + if Peek.token env = T_LPAREN then + (None, None) + else + let id = + match Peek.token env with + | T_LESS_THAN -> None + | _ -> + let env = env |> with_allow_await await |> with_allow_yield yield in + let id = + id_remove_trailing + env + (Parse.identifier ~restricted_error:Parse_error.StrictFunctionName env) + in + Some id + in + let tparams = type_params_remove_trailing env (Type.type_params env) in + (id, tparams) + in + (* #sec-function-definitions-static-semantics-early-errors *) + let env = env |> with_allow_super No_super in + let params = + let params = Declaration.function_params ~await ~yield env in + if Peek.token env = T_COLON then + params + else + function_params_remove_trailing env params + in + let (return, predicate) = Type.annotation_and_predicate_opt env in + let (return, predicate) = + match predicate with + | None -> (type_annotation_hint_remove_trailing env return, predicate) + | Some _ -> (return, predicate_remove_trailing env predicate) + in + (id, params, generator, predicate, return, tparams, leading)) + env + in + let (body, strict) = Declaration.function_body env ~async ~generator ~expression:true in + let simple = Declaration.is_simple_function_params params in + Declaration.strict_post_check env ~strict ~simple id params; + Expression.Function + { + Function.id; + params; + body; + generator; + async; + predicate; + return; + tparams; + sig_loc; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + }) + env + + and number env kind raw = + let value = + match kind with + | LEGACY_OCTAL -> + strict_error env Parse_error.StrictOctalLiteral; + begin + try Int64.to_float (Int64.of_string ("0o" ^ raw)) with + | Failure _ -> failwith ("Invalid legacy octal " ^ raw) + end + | LEGACY_NON_OCTAL -> + strict_error env Parse_error.StrictNonOctalLiteral; + begin + try float_of_string raw with + | Failure _ -> failwith ("Invalid number " ^ raw) + end + | BINARY + | OCTAL -> + begin + try Int64.to_float (Int64.of_string raw) with + | Failure _ -> failwith ("Invalid binary/octal " ^ raw) + end + | NORMAL -> + begin + try float_of_string raw with + | Failure _ -> failwith ("Invalid number " ^ raw) + end + in + Expect.token env (T_NUMBER { kind; raw }); + value + + and bigint_strip_n raw = + let size = String.length raw in + let str = + if size != 0 && raw.[size - 1] == 'n' then + String.sub raw 0 (size - 1) + else + raw + in + str + + and bigint env kind raw = + let value = + match kind with + | BIG_BINARY + | BIG_OCTAL -> + let postraw = bigint_strip_n raw in + begin + try Int64.to_float (Int64.of_string postraw) with + | Failure _ -> failwith ("Invalid bigint binary/octal " ^ postraw) + end + | BIG_NORMAL -> + let postraw = bigint_strip_n raw in + begin + try float_of_string postraw with + | Failure _ -> failwith ("Invalid bigint " ^ postraw) + end + in + Expect.token env (T_BIGINT { kind; raw }); + value + + and primary_cover env = + let loc = Peek.loc env in + let leading = Peek.comments env in + match Peek.token env with + | T_THIS -> + Eat.token env; + let trailing = Eat.trailing_comments env in + Cover_expr + ( loc, + Expression.This + { Expression.This.comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + | T_NUMBER { kind; raw } -> + let value = Literal.Number (number env kind raw) in + let trailing = Eat.trailing_comments env in + Cover_expr + ( loc, + let open Expression in + Literal + { Literal.value; raw; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + | T_BIGINT { kind; raw } -> + let value = Literal.BigInt (bigint env kind raw) in + let trailing = Eat.trailing_comments env in + Cover_expr + ( loc, + let open Expression in + Literal + { Literal.value; raw; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + | T_STRING (loc, value, raw, octal) -> + if octal then strict_error env Parse_error.StrictOctalLiteral; + Eat.token env; + let value = Literal.String value in + let trailing = Eat.trailing_comments env in + Cover_expr + ( loc, + Expression.Literal + { Literal.value; raw; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + | (T_TRUE | T_FALSE) as token -> + Eat.token env; + let truthy = token = T_TRUE in + let raw = + if truthy then + "true" + else + "false" + in + let value = Literal.Boolean truthy in + let trailing = Eat.trailing_comments env in + Cover_expr + ( loc, + Expression.Literal + { Literal.value; raw; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + | T_NULL -> + Eat.token env; + let raw = "null" in + let value = Literal.Null in + let trailing = Eat.trailing_comments env in + Cover_expr + ( loc, + Expression.Literal + { Literal.value; raw; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + | T_LPAREN -> Cover_expr (group env) + | T_LCURLY -> + let (loc, obj, errs) = Parse.object_initializer env in + Cover_patt ((loc, Expression.Object obj), errs) + | T_LBRACKET -> + let (loc, (arr, errs)) = with_loc array_initializer env in + Cover_patt ((loc, Expression.Array arr), errs) + | T_DIV + | T_DIV_ASSIGN -> + Cover_expr (regexp env) + | T_LESS_THAN -> + let (loc, expression) = + match Parse.jsx_element_or_fragment env with + | (loc, `Element e) -> (loc, Expression.JSXElement e) + | (loc, `Fragment f) -> (loc, Expression.JSXFragment f) + in + Cover_expr (loc, expression) + | T_TEMPLATE_PART part -> + let (loc, template) = template_literal env part in + Cover_expr (loc, Expression.TemplateLiteral template) + | T_CLASS -> Cover_expr (Parse.class_expression env) + | _ when Peek.is_identifier env -> + let id = Parse.identifier env in + Cover_expr (fst id, Expression.Identifier id) + | t -> + error_unexpected env; + + (* Let's get rid of the bad token *) + begin + match t with + | T_ERROR _ -> Eat.token env + | _ -> () + end; + + (* Really no idea how to recover from this. I suppose a null + * expression is as good as anything *) + let value = Literal.Null in + let raw = "null" in + let trailing = [] in + Cover_expr + ( loc, + let open Expression in + Literal + { Literal.value; raw; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + + and primary env = as_expression env (primary_cover env) + + and template_literal = + let rec template_parts env quasis expressions = + let expr = Parse.expression env in + let expressions = expr :: expressions in + match Peek.token env with + | T_RCURLY -> + Eat.push_lex_mode env Lex_mode.TEMPLATE; + let (loc, part, is_tail) = + match Peek.token env with + | T_TEMPLATE_PART (loc, { cooked; raw; _ }, tail) -> + let open Ast.Expression.TemplateLiteral in + Eat.token env; + (loc, { Element.value = { Element.cooked; raw }; tail }, tail) + | _ -> assert false + in + Eat.pop_lex_mode env; + let quasis = (loc, part) :: quasis in + if is_tail then + (loc, List.rev quasis, List.rev expressions) + else + template_parts env quasis expressions + | _ -> + (* Malformed template *) + error_unexpected ~expected:"a template literal part" env; + let imaginary_quasi = + ( fst expr, + { + Expression.TemplateLiteral.Element.value = + { Expression.TemplateLiteral.Element.raw = ""; cooked = "" }; + tail = true; + } + ) + in + (fst expr, List.rev (imaginary_quasi :: quasis), List.rev expressions) + in + fun env ((start_loc, { cooked; raw; _ }, is_tail) as part) -> + let leading = Peek.comments env in + Expect.token env (T_TEMPLATE_PART part); + let (end_loc, quasis, expressions) = + let head = + Ast.Expression.TemplateLiteral. + (start_loc, { Element.value = { Element.cooked; raw }; tail = is_tail }) + + in + + if is_tail then + (start_loc, [head], []) + else + template_parts env [head] [] + in + let trailing = Eat.trailing_comments env in + let loc = Loc.btwn start_loc end_loc in + ( loc, + Expression.TemplateLiteral. + { quasis; expressions; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + + ) + + and tagged_template env start_loc tag part = + let tag = expression_remove_trailing env tag in + let quasi = template_literal env part in + ( Loc.btwn start_loc (fst quasi), + Expression.(TaggedTemplate TaggedTemplate.{ tag; quasi; comments = None }) + ) + + and group env = + let leading = Peek.comments env in + let (loc, cover) = + with_loc + (fun env -> + Expect.token env T_LPAREN; + let expr_start_loc = Peek.loc env in + let expression = assignment env in + let ret = + match Peek.token env with + | T_COLON -> + let annot = Type.annotation env in + Group_typecast Expression.TypeCast.{ expression; annot; comments = None } + | T_COMMA -> Group_expr (sequence env ~start_loc:expr_start_loc [expression]) + | _ -> Group_expr expression + in + Expect.token env T_RPAREN; + ret) + env + in + let trailing = Eat.trailing_comments env in + let ret = + match cover with + | Group_expr expr -> expr + | Group_typecast cast -> (loc, Expression.TypeCast cast) + in + add_comments ret ~leading ~trailing + + and add_comments ?(leading = []) ?(trailing = []) (loc, expression) = + let merge_comments inner = + Flow_ast_utils.merge_comments + ~inner + ~outer:(Flow_ast_utils.mk_comments_opt ~leading ~trailing ()) + in + let merge_comments_with_internal inner = + Flow_ast_utils.merge_comments_with_internal + ~inner + ~outer:(Flow_ast_utils.mk_comments_opt ~leading ~trailing ()) + in + let open Expression in + ( loc, + match expression with + | Array ({ Array.comments; _ } as e) -> + Array { e with Array.comments = merge_comments_with_internal comments } + | ArrowFunction ({ Function.comments; _ } as e) -> + ArrowFunction { e with Function.comments = merge_comments comments } + | Assignment ({ Assignment.comments; _ } as e) -> + Assignment { e with Assignment.comments = merge_comments comments } + | Binary ({ Binary.comments; _ } as e) -> + Binary { e with Binary.comments = merge_comments comments } + | Call ({ Call.comments; _ } as e) -> Call { e with Call.comments = merge_comments comments } + | Class ({ Class.comments; _ } as e) -> + Class { e with Class.comments = merge_comments comments } + | Conditional ({ Conditional.comments; _ } as e) -> + Conditional { e with Conditional.comments = merge_comments comments } + | Function ({ Function.comments; _ } as e) -> + Function { e with Function.comments = merge_comments comments } + | Identifier (loc, ({ Identifier.comments; _ } as e)) -> + Identifier (loc, { e with Identifier.comments = merge_comments comments }) + | Import ({ Import.comments; _ } as e) -> + Import { e with Import.comments = merge_comments comments } + | JSXElement ({ JSX.comments; _ } as e) -> + JSXElement { e with JSX.comments = merge_comments comments } + | JSXFragment ({ JSX.frag_comments; _ } as e) -> + JSXFragment { e with JSX.frag_comments = merge_comments frag_comments } + | Literal ({ Literal.comments; _ } as e) -> + Literal { e with Literal.comments = merge_comments comments } + | Logical ({ Logical.comments; _ } as e) -> + Logical { e with Logical.comments = merge_comments comments } + | Member ({ Member.comments; _ } as e) -> + Member { e with Member.comments = merge_comments comments } + | MetaProperty ({ MetaProperty.comments; _ } as e) -> + MetaProperty { e with MetaProperty.comments = merge_comments comments } + | New ({ New.comments; _ } as e) -> New { e with New.comments = merge_comments comments } + | Object ({ Object.comments; _ } as e) -> + Object { e with Object.comments = merge_comments_with_internal comments } + | OptionalCall ({ OptionalCall.call = { Call.comments; _ } as call; _ } as optional_call) -> + OptionalCall + { + optional_call with + OptionalCall.call = { call with Call.comments = merge_comments comments }; + } + | OptionalMember + ({ OptionalMember.member = { Member.comments; _ } as member; _ } as optional_member) -> + OptionalMember + { + optional_member with + OptionalMember.member = { member with Member.comments = merge_comments comments }; + } + | Sequence ({ Sequence.comments; _ } as e) -> + Sequence { e with Sequence.comments = merge_comments comments } + | Super { Super.comments; _ } -> Super { Super.comments = merge_comments comments } + | TaggedTemplate ({ TaggedTemplate.comments; _ } as e) -> + TaggedTemplate { e with TaggedTemplate.comments = merge_comments comments } + | TemplateLiteral ({ TemplateLiteral.comments; _ } as e) -> + TemplateLiteral { e with TemplateLiteral.comments = merge_comments comments } + | This { This.comments; _ } -> This { This.comments = merge_comments comments } + | TypeCast ({ TypeCast.comments; _ } as e) -> + TypeCast { e with TypeCast.comments = merge_comments comments } + | Unary ({ Unary.comments; _ } as e) -> + Unary { e with Unary.comments = merge_comments comments } + | Update ({ Update.comments; _ } as e) -> + Update { e with Update.comments = merge_comments comments } + | Yield ({ Yield.comments; _ } as e) -> + Yield { e with Yield.comments = merge_comments comments } + (* TODO: Delete once all expressions support comment attachment *) + | _ -> expression + ) + + and array_initializer = + let rec elements env (acc, errs) = + match Peek.token env with + | T_EOF + | T_RBRACKET -> + (List.rev acc, Pattern_cover.rev_errors errs) + | T_COMMA -> + let loc = Peek.loc env in + Eat.token env; + elements env (Expression.Array.Hole loc :: acc, errs) + | T_ELLIPSIS -> + let leading = Peek.comments env in + let (loc, (argument, new_errs)) = + with_loc + (fun env -> + Eat.token env; + match assignment_cover env with + | Cover_expr argument -> (argument, Pattern_cover.empty_errors) + | Cover_patt (argument, new_errs) -> (argument, new_errs)) + env + in + let elem = + Expression.( + Array.Spread + ( loc, + SpreadElement.{ argument; comments = Flow_ast_utils.mk_comments_opt ~leading () } + ) + ) + in + let is_last = Peek.token env = T_RBRACKET in + (* if this array is interpreted as a pattern, the spread becomes an AssignmentRestElement + which must be the last element. We can easily error about additional elements since + they will be in the element list, but a trailing elision, like `[...x,]`, is not part + of the AST. so, keep track of the error so we can raise it if this is a pattern. *) + let new_errs = + if (not is_last) && Peek.ith_token ~i:1 env = T_RBRACKET then + let if_patt = (loc, Parse_error.ElementAfterRestElement) :: new_errs.if_patt in + { new_errs with if_patt } + else + new_errs + in + if not is_last then Expect.token env T_COMMA; + let acc = elem :: acc in + let errs = Pattern_cover.rev_append_errors new_errs errs in + elements env (acc, errs) + | _ -> + let (elem, new_errs) = + match assignment_cover env with + | Cover_expr elem -> (elem, Pattern_cover.empty_errors) + | Cover_patt (elem, new_errs) -> (elem, new_errs) + in + if Peek.token env <> T_RBRACKET then Expect.token env T_COMMA; + let acc = Expression.Array.Expression elem :: acc in + let errs = Pattern_cover.rev_append_errors new_errs errs in + elements env (acc, errs) + in + fun env -> + let leading = Peek.comments env in + Expect.token env T_LBRACKET; + let (elems, errs) = elements env ([], Pattern_cover.empty_errors) in + let internal = Peek.comments env in + Expect.token env T_RBRACKET; + let trailing = Eat.trailing_comments env in + ( { + Ast.Expression.Array.elements = elems; + comments = Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal (); + }, + errs + ) + + and regexp env = + Eat.push_lex_mode env Lex_mode.REGEXP; + let loc = Peek.loc env in + let leading = Peek.comments env in + let tkn = Peek.token env in + let (raw, pattern, raw_flags, trailing) = + match tkn with + | T_REGEXP (_, pattern, flags) -> + Eat.token env; + let trailing = Eat.trailing_comments env in + let raw = "/" ^ pattern ^ "/" ^ flags in + (raw, pattern, flags, trailing) + | _ -> assert false + in + Eat.pop_lex_mode env; + let filtered_flags = Buffer.create (String.length raw_flags) in + String.iter + (function + | ('g' | 'i' | 'm' | 's' | 'u' | 'y') as c -> Buffer.add_char filtered_flags c + | _ -> ()) + raw_flags; + let flags = Buffer.contents filtered_flags in + if flags <> raw_flags then error env (Parse_error.InvalidRegExpFlags raw_flags); + let value = Literal.(RegExp { RegExp.pattern; flags }) in + ( loc, + let open Expression in + Literal + { Literal.value; raw; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + + and try_arrow_function = + (* Certain errors (almost all errors) cause a rollback *) + let error_callback _ = + Parse_error.( + function + (* Don't rollback on these errors. *) + | StrictParamName + | StrictReservedWord + | ParameterAfterRestParameter + | NewlineBeforeArrow + | YieldInFormalParameters + | ThisParamBannedInArrowFunctions -> + () + (* Everything else causes a rollback *) + | _ -> raise Try.Rollback + ) + in + let concise_function_body env ~async = + (* arrow functions can't be generators *) + let env = enter_function env ~async ~generator:false in + match Peek.token env with + | T_LCURLY -> + let (loc, body, strict) = Parse.function_block_body env ~expression:true in + (Function.BodyBlock (loc, body), strict) + | _ -> + let expr = Parse.assignment env in + (Function.BodyExpression expr, in_strict_mode env) + in + fun env -> + let env = env |> with_error_callback error_callback in + let start_loc = Peek.loc env in + (* a T_ASYNC could either be a parameter name or it could be indicating + * that it's an async function *) + let (async, leading) = + if Peek.ith_token ~i:1 env <> T_ARROW then + Declaration.async env + else + (false, []) + in + let (sig_loc, (tparams, params, return, predicate)) = + with_loc + (fun env -> + let tparams = type_params_remove_trailing env (Type.type_params env) in + (* Disallow all fancy features for identifier => body *) + if Peek.is_identifier env && tparams = None then + let ((loc, _) as name) = + Parse.identifier ~restricted_error:Parse_error.StrictParamName env + in + let param = + ( loc, + { + Ast.Function.Param.argument = + ( loc, + Pattern.Identifier + { + Pattern.Identifier.name; + annot = Ast.Type.Missing (Peek.loc_skip_lookahead env); + optional = false; + } + ); + default = None; + } + ) + in + ( tparams, + ( loc, + { + Ast.Function.Params.params = [param]; + rest = None; + comments = None; + this_ = None; + } + ), + Ast.Type.Missing Loc.{ loc with start = loc._end }, + None + ) + else + let params = + let yield = allow_yield env in + let await = allow_await env in + Declaration.function_params ~await ~yield env + in + (* There's an ambiguity if you use a function type as the return + * type for an arrow function. So we disallow anonymous function + * types in arrow function return types unless the function type is + * enclosed in parens *) + let (return, predicate) = + env |> with_no_anon_function_type true |> Type.annotation_and_predicate_opt + in + (tparams, params, return, predicate)) + env + in + (* It's hard to tell if an invalid expression was intended to be an + * arrow function before we see the =>. If there are no params, that + * implies "()" which is only ever found in arrow params. Similarly, + * rest params indicate arrow functions. Therefore, if we see a rest + * param or an empty param list then we can disable the rollback and + * instead generate errors as if we were parsing an arrow function *) + let env = + match params with + | (_, { Ast.Function.Params.params = _; rest = Some _; this_ = None; comments = _ }) + | (_, { Ast.Function.Params.params = []; rest = _; this_ = None; comments = _ }) -> + without_error_callback env + | _ -> env + in + + (* Disallow this param annotations in arrow functions *) + let params = + match params with + | (loc, ({ Ast.Function.Params.this_ = Some (this_loc, _); _ } as params)) -> + error_at env (this_loc, Parse_error.ThisParamBannedInArrowFunctions); + (loc, { params with Ast.Function.Params.this_ = None }) + | _ -> params + in + + if Peek.is_line_terminator env && Peek.token env = T_ARROW then + error env Parse_error.NewlineBeforeArrow; + Expect.token env T_ARROW; + + (* Now we know for sure this is an arrow function *) + let env = without_error_callback env in + let (end_loc, (body, strict)) = with_loc (concise_function_body ~async) env in + let simple = Declaration.is_simple_function_params params in + Declaration.strict_post_check env ~strict ~simple None params; + let loc = Loc.btwn start_loc end_loc in + Cover_expr + ( loc, + let open Expression in + ArrowFunction + { + Function.id = None; + params; + body; + async; + generator = false; + (* arrow functions cannot be generators *) + predicate; + return; + tparams; + sig_loc; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + + and sequence = + let rec helper acc env = + match Peek.token env with + | T_COMMA -> + Eat.token env; + let expr = assignment env in + helper (expr :: acc) env + | _ -> + let expressions = List.rev acc in + Expression.(Sequence Sequence.{ expressions; comments = None }) + in + (fun env ~start_loc acc -> with_loc ~start_loc (helper acc) env) +end diff --git a/flow/parser/file_key.ml b/flow/parser/file_key.ml new file mode 100644 index 0000000000..3f315fcfe1 --- /dev/null +++ b/flow/parser/file_key.ml @@ -0,0 +1,85 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +type t = + | LibFile of string + | SourceFile of string + | JsonFile of string + (* A resource that might get required, like .css, .jpg, etc. We don't parse + these, just check that they exist *) + | ResourceFile of string + | Builtins +[@@deriving show, eq] + +let to_string = function + | LibFile x + | SourceFile x + | JsonFile x + | ResourceFile x -> + x + | Builtins -> "(global)" + +let to_path = function + | LibFile x + | SourceFile x + | JsonFile x + | ResourceFile x -> + Ok x + | Builtins -> Error "File key refers to a builtin" + +let compare = + (* builtins, then libs, then source and json files at the same priority since + JSON files are basically source files. We don't actually read resource + files so they come last *) + let order_of_filename = function + | Builtins -> 1 + | LibFile _ -> 2 + | SourceFile _ -> 3 + | JsonFile _ -> 3 + | ResourceFile _ -> 4 + in + fun a b -> + let k = order_of_filename a - order_of_filename b in + if k <> 0 then + k + else + String.compare (to_string a) (to_string b) + +let compare_opt a b = + match (a, b) with + | (Some _, None) -> -1 + | (None, Some _) -> 1 + | (None, None) -> 0 + | (Some a, Some b) -> compare a b + +let is_lib_file = function + | LibFile _ -> true + | Builtins -> true + | SourceFile _ -> false + | JsonFile _ -> false + | ResourceFile _ -> false + +let map f = function + | LibFile filename -> LibFile (f filename) + | SourceFile filename -> SourceFile (f filename) + | JsonFile filename -> JsonFile (f filename) + | ResourceFile filename -> ResourceFile (f filename) + | Builtins -> Builtins + +let exists f = function + | LibFile filename + | SourceFile filename + | JsonFile filename + | ResourceFile filename -> + f filename + | Builtins -> false + +let check_suffix filename suffix = exists (fun fn -> Filename.check_suffix fn suffix) filename + +let chop_suffix filename suffix = map (fun fn -> Filename.chop_suffix fn suffix) filename + +let with_suffix filename suffix = map (fun fn -> fn ^ suffix) filename diff --git a/flow/parser/flow_ast.ml b/flow/parser/flow_ast.ml new file mode 100644 index 0000000000..e29ab69453 --- /dev/null +++ b/flow/parser/flow_ast.ml @@ -0,0 +1,1898 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +(* + * An Ocaml implementation of the SpiderMonkey Parser API + * https://developer.mozilla.org/en-US/docs/SpiderMonkey/Parser_API + *) +module rec Syntax : sig + type ('M, 'internal) t = { + leading: 'M Comment.t list; + trailing: 'M Comment.t list; + internal: 'internal; + } + [@@deriving show] +end = + Syntax + +and Identifier : sig + type ('M, 'T) t = 'T * 'M t' + + and 'M t' = { + name: string; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] +end = + Identifier + +and PrivateName : sig + type 'M t = 'M * 'M t' + + and 'M t' = { + name: string; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] +end = + PrivateName + +and Literal : sig + module RegExp : sig + type t = { + pattern: string; + flags: string; + } + [@@deriving show] + end + + (* Literals also carry along their raw value *) + type 'M t = { + value: value; + raw: string; + comments: ('M, unit) Syntax.t option; + } + + and value = + | String of string + | Boolean of bool + | Null + | Number of float + | BigInt of float + | RegExp of RegExp.t + [@@deriving show] +end = + Literal + +and StringLiteral : sig + type 'M t = { + value: string; + raw: string; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] +end = + StringLiteral + +and NumberLiteral : sig + type 'M t = { + value: float; + raw: string; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] +end = + NumberLiteral + +and BigIntLiteral : sig + type 'M t = { + approx_value: float; + (* Warning! Might lose precision! *) + bigint: string; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] +end = + BigIntLiteral + +and BooleanLiteral : sig + type 'M t = { + value: bool; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] +end = + BooleanLiteral + +and Variance : sig + type 'M t = 'M * 'M t' + + and kind = + | Plus + | Minus + + and 'M t' = { + kind: kind; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] +end = + Variance + +and ComputedKey : sig + type ('M, 'T) t = 'M * ('M, 'T) ComputedKey.t' + + and ('M, 'T) t' = { + expression: ('M, 'T) Expression.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] +end = + ComputedKey + +and Type : sig + module Function : sig + module Param : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + name: ('M, 'T) Identifier.t option; + annot: ('M, 'T) Type.t; + optional: bool; + } + [@@deriving show] + end + + module RestParam : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + argument: ('M, 'T) Param.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module ThisParam : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + annot: ('M, 'T) Type.annotation; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Params : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + this_: ('M, 'T) ThisParam.t option; + params: ('M, 'T) Param.t list; + rest: ('M, 'T) RestParam.t option; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + [@@deriving show] + end + + type ('M, 'T) t = { + tparams: ('M, 'T) Type.TypeParams.t option; + params: ('M, 'T) Params.t; + return: ('M, 'T) Type.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Generic : sig + module Identifier : sig + type ('M, 'T) t = + | Unqualified of ('M, 'T) Identifier.t + | Qualified of ('M, 'T) qualified + + and ('M, 'T) qualified = 'M * ('M, 'T) qualified' + + and ('M, 'T) qualified' = { + qualification: ('M, 'T) t; + id: ('M, 'T) Identifier.t; + } + [@@deriving show] + end + + type ('M, 'T) t = { + id: ('M, 'T) Identifier.t; + targs: ('M, 'T) Type.TypeArgs.t option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module IndexedAccess : sig + type ('M, 'T) t = { + _object: ('M, 'T) Type.t; + index: ('M, 'T) Type.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module OptionalIndexedAccess : sig + type ('M, 'T) t = { + indexed_access: ('M, 'T) IndexedAccess.t; + optional: bool; + } + [@@deriving show] + end + + module Object : sig + module Property : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + key: ('M, 'T) Expression.Object.Property.key; + value: ('M, 'T) value; + optional: bool; + static: bool; + proto: bool; + _method: bool; + variance: 'M Variance.t option; + comments: ('M, unit) Syntax.t option; + } + + and ('M, 'T) value = + | Init of ('M, 'T) Type.t + | Get of ('M * ('M, 'T) Function.t) + | Set of ('M * ('M, 'T) Function.t) + [@@deriving show] + end + + module SpreadProperty : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + argument: ('M, 'T) Type.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Indexer : sig + type ('M, 'T) t' = { + id: ('M, 'M) Identifier.t option; + key: ('M, 'T) Type.t; + value: ('M, 'T) Type.t; + static: bool; + variance: 'M Variance.t option; + comments: ('M, unit) Syntax.t option; + } + + and ('M, 'T) t = 'M * ('M, 'T) t' [@@deriving show] + end + + module CallProperty : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + value: 'M * ('M, 'T) Function.t; + static: bool; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module InternalSlot : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + id: ('M, 'M) Identifier.t; + value: ('M, 'T) Type.t; + optional: bool; + static: bool; + _method: bool; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + type ('M, 'T) t = { + exact: bool; + (* Inexact indicates the presence of ... in the object. It is more + * easily understood if exact is read as "explicitly exact" and "inexact" + * is read as "explicitly inexact". + * + * This confusion will go away when we get rid of the exact flag in favor + * of inexact as part of the work to make object types exact by default. + * *) + inexact: bool; + properties: ('M, 'T) property list; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + + and ('M, 'T) property = + | Property of ('M, 'T) Property.t + | SpreadProperty of ('M, 'T) SpreadProperty.t + | Indexer of ('M, 'T) Indexer.t + | CallProperty of ('M, 'T) CallProperty.t + | InternalSlot of ('M, 'T) InternalSlot.t + [@@deriving show] + end + + module Interface : sig + type ('M, 'T) t = { + body: 'M * ('M, 'T) Object.t; + extends: ('M * ('M, 'T) Generic.t) list; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Nullable : sig + type ('M, 'T) t = { + argument: ('M, 'T) Type.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Typeof : sig + module Target : sig + type ('M, 'T) t = + | Unqualified of ('M, 'T) Identifier.t + | Qualified of ('M, 'T) qualified + + and ('M, 'T) qualified' = { + qualification: ('M, 'T) t; + id: ('M, 'T) Identifier.t; + } + + and ('M, 'T) qualified = 'T * ('M, 'T) qualified' [@@deriving show] + end + + type ('M, 'T) t = { + argument: ('M, 'T) Target.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Tuple : sig + type ('M, 'T) t = { + types: ('M, 'T) Type.t list; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Array : sig + type ('M, 'T) t = { + argument: ('M, 'T) Type.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Union : sig + type ('M, 'T) t = { + types: ('M, 'T) Type.t * ('M, 'T) Type.t * ('M, 'T) Type.t list; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Intersection : sig + type ('M, 'T) t = { + types: ('M, 'T) Type.t * ('M, 'T) Type.t * ('M, 'T) Type.t list; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + type ('M, 'T) t = 'T * ('M, 'T) t' + + (* Yes, we could add a little complexity here to show that Any and Void + * should never be declared nullable, but that check can happen later *) + and ('M, 'T) t' = + | Any of ('M, unit) Syntax.t option + | Mixed of ('M, unit) Syntax.t option + | Empty of ('M, unit) Syntax.t option + | Void of ('M, unit) Syntax.t option + | Null of ('M, unit) Syntax.t option + | Number of ('M, unit) Syntax.t option + | BigInt of ('M, unit) Syntax.t option + | String of ('M, unit) Syntax.t option + | Boolean of ('M, unit) Syntax.t option + | Symbol of ('M, unit) Syntax.t option + | Exists of ('M, unit) Syntax.t option + | Nullable of ('M, 'T) Nullable.t + | Function of ('M, 'T) Function.t + | Object of ('M, 'T) Object.t + | Interface of ('M, 'T) Interface.t + | Array of ('M, 'T) Array.t + | Generic of ('M, 'T) Generic.t + | IndexedAccess of ('M, 'T) IndexedAccess.t + | OptionalIndexedAccess of ('M, 'T) OptionalIndexedAccess.t + | Union of ('M, 'T) Union.t + | Intersection of ('M, 'T) Intersection.t + | Typeof of ('M, 'T) Typeof.t + | Tuple of ('M, 'T) Tuple.t + | StringLiteral of 'M StringLiteral.t + | NumberLiteral of 'M NumberLiteral.t + | BigIntLiteral of 'M BigIntLiteral.t + | BooleanLiteral of 'M BooleanLiteral.t + + (* Type.annotation is a concrete syntax node with a location that starts at + * the colon and ends after the type. For example, "var a: number", the + * identifier a would have a property annot which contains a + * Type.annotation with a location from column 6-14 *) + and ('M, 'T) annotation = 'M * ('M, 'T) t + + and ('M, 'T) annotation_or_hint = + | Missing of 'T + | Available of ('M, 'T) Type.annotation + [@@deriving show] + + module TypeParam : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + name: ('M, 'M) Identifier.t; + bound: ('M, 'T) Type.annotation_or_hint; + variance: 'M Variance.t option; + default: ('M, 'T) Type.t option; + } + [@@deriving show] + end + + module TypeParams : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + params: ('M, 'T) TypeParam.t list; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + [@@deriving show] + end + + module TypeArgs : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + arguments: ('M, 'T) Type.t list; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + [@@deriving show] + end + + module Predicate : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + kind: ('M, 'T) kind; + comments: ('M, unit) Syntax.t option; + } + + and ('M, 'T) kind = + | Declared of ('M, 'T) Expression.t + | Inferred + [@@deriving show] + end +end = + Type + +and Statement : sig + module Block : sig + type ('M, 'T) t = { + body: ('M, 'T) Statement.t list; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + [@@deriving show] + end + + module If : sig + module Alternate : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + body: ('M, 'T) Statement.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + type ('M, 'T) t = { + test: ('M, 'T) Expression.t; + consequent: ('M, 'T) Statement.t; + alternate: ('M, 'T) Alternate.t option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Labeled : sig + type ('M, 'T) t = { + label: ('M, 'M) Identifier.t; + body: ('M, 'T) Statement.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Break : sig + type 'M t = { + label: ('M, 'M) Identifier.t option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Continue : sig + type 'M t = { + label: ('M, 'M) Identifier.t option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Debugger : sig + type 'M t = { comments: ('M, unit) Syntax.t option } [@@deriving show] + end + + module With : sig + type ('M, 'T) t = { + _object: ('M, 'T) Expression.t; + body: ('M, 'T) Statement.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module TypeAlias : sig + type ('M, 'T) t = { + id: ('M, 'T) Identifier.t; + tparams: ('M, 'T) Type.TypeParams.t option; + right: ('M, 'T) Type.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module OpaqueType : sig + type ('M, 'T) t = { + id: ('M, 'T) Identifier.t; + tparams: ('M, 'T) Type.TypeParams.t option; + impltype: ('M, 'T) Type.t option; + supertype: ('M, 'T) Type.t option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Switch : sig + module Case : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + test: ('M, 'T) Expression.t option; + consequent: ('M, 'T) Statement.t list; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + type ('M, 'T) t = { + discriminant: ('M, 'T) Expression.t; + cases: ('M, 'T) Case.t list; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Return : sig + type ('M, 'T) t = { + argument: ('M, 'T) Expression.t option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Throw : sig + type ('M, 'T) t = { + argument: ('M, 'T) Expression.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Try : sig + module CatchClause : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + param: ('M, 'T) Pattern.t option; + body: 'M * ('M, 'T) Block.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + type ('M, 'T) t = { + block: 'M * ('M, 'T) Block.t; + handler: ('M, 'T) CatchClause.t option; + finalizer: ('M * ('M, 'T) Block.t) option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module VariableDeclaration : sig + module Declarator : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + id: ('M, 'T) Pattern.t; + init: ('M, 'T) Expression.t option; + } + [@@deriving show] + end + + type ('M, 'T) t = { + declarations: ('M, 'T) Declarator.t list; + kind: kind; + comments: ('M, unit) Syntax.t option; + } + + and kind = + | Var + | Let + | Const + [@@deriving show] + end + + module While : sig + type ('M, 'T) t = { + test: ('M, 'T) Expression.t; + body: ('M, 'T) Statement.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module DoWhile : sig + type ('M, 'T) t = { + body: ('M, 'T) Statement.t; + test: ('M, 'T) Expression.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module For : sig + type ('M, 'T) t = { + init: ('M, 'T) init option; + test: ('M, 'T) Expression.t option; + update: ('M, 'T) Expression.t option; + body: ('M, 'T) Statement.t; + comments: ('M, unit) Syntax.t option; + } + + and ('M, 'T) init = + | InitDeclaration of ('M * ('M, 'T) VariableDeclaration.t) + | InitExpression of ('M, 'T) Expression.t + [@@deriving show] + end + + module ForIn : sig + type ('M, 'T) t = { + left: ('M, 'T) left; + right: ('M, 'T) Expression.t; + body: ('M, 'T) Statement.t; + each: bool; + comments: ('M, unit) Syntax.t option; + } + + and ('M, 'T) left = + | LeftDeclaration of ('M * ('M, 'T) VariableDeclaration.t) + | LeftPattern of ('M, 'T) Pattern.t + [@@deriving show] + end + + module ForOf : sig + type ('M, 'T) t = { + left: ('M, 'T) left; + right: ('M, 'T) Expression.t; + body: ('M, 'T) Statement.t; + await: bool; + comments: ('M, unit) Syntax.t option; + } + + and ('M, 'T) left = + | LeftDeclaration of ('M * ('M, 'T) VariableDeclaration.t) + | LeftPattern of ('M, 'T) Pattern.t + [@@deriving show] + end + + module EnumDeclaration : sig + module DefaultedMember : sig + type 'M t = 'M * 'M t' + + and 'M t' = { id: ('M, 'M) Identifier.t } [@@deriving show] + end + + module InitializedMember : sig + type ('I, 'M) t = 'M * ('I, 'M) t' + + and ('I, 'M) t' = { + id: ('M, 'M) Identifier.t; + init: 'M * 'I; + } + [@@deriving show] + end + + module BooleanBody : sig + type 'M t = { + members: ('M BooleanLiteral.t, 'M) InitializedMember.t list; + explicit_type: bool; + has_unknown_members: bool; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + [@@deriving show] + end + + module NumberBody : sig + type 'M t = { + members: ('M NumberLiteral.t, 'M) InitializedMember.t list; + explicit_type: bool; + has_unknown_members: bool; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + [@@deriving show] + end + + module StringBody : sig + type 'M t = { + members: ('M StringLiteral.t, 'M) members; + explicit_type: bool; + has_unknown_members: bool; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + + and ('I, 'M) members = + | Defaulted of 'M DefaultedMember.t list + | Initialized of ('I, 'M) InitializedMember.t list + [@@deriving show] + end + + module SymbolBody : sig + type 'M t = { + members: 'M DefaultedMember.t list; + has_unknown_members: bool; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + [@@deriving show] + end + + type ('M, 'T) t = { + id: ('M, 'T) Identifier.t; + body: 'M body; + comments: ('M, unit) Syntax.t option; + } + + and 'M body = 'M * 'M body' + + and 'M body' = + | BooleanBody of 'M BooleanBody.t + | NumberBody of 'M NumberBody.t + | StringBody of 'M StringBody.t + | SymbolBody of 'M SymbolBody.t + [@@deriving show] + end + + module Interface : sig + type ('M, 'T) t = { + id: ('M, 'T) Identifier.t; + tparams: ('M, 'T) Type.TypeParams.t option; + extends: ('M * ('M, 'T) Type.Generic.t) list; + body: 'M * ('M, 'T) Type.Object.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module DeclareClass : sig + type ('M, 'T) t = { + id: ('M, 'T) Identifier.t; + tparams: ('M, 'T) Type.TypeParams.t option; + body: 'M * ('M, 'T) Type.Object.t; + extends: ('M * ('M, 'T) Type.Generic.t) option; + mixins: ('M * ('M, 'T) Type.Generic.t) list; + implements: ('M, 'T) Class.Implements.t option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module DeclareVariable : sig + type ('M, 'T) t = { + id: ('M, 'T) Identifier.t; + annot: ('M, 'T) Type.annotation; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module DeclareFunction : sig + type ('M, 'T) t = { + id: ('M, 'T) Identifier.t; + annot: ('M, 'T) Type.annotation; + predicate: ('M, 'T) Type.Predicate.t option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module DeclareModule : sig + type ('M, 'T) id = + | Identifier of ('M, 'T) Identifier.t + | Literal of ('T * 'M StringLiteral.t) + + and 'M module_kind = + | CommonJS of 'M + | ES of 'M + + and ('M, 'T) t = { + id: ('M, 'T) id; + body: 'M * ('M, 'T) Block.t; + kind: 'M module_kind; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module DeclareModuleExports : sig + type ('M, 'T) t = { + annot: ('M, 'T) Type.annotation; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module ExportNamedDeclaration : sig + module ExportSpecifier : sig + type 'M t = 'M * 'M t' + + and 'M t' = { + local: ('M, 'M) Identifier.t; + exported: ('M, 'M) Identifier.t option; + } + [@@deriving show] + end + + module ExportBatchSpecifier : sig + type 'M t = 'M * ('M, 'M) Identifier.t option [@@deriving show] + end + + type ('M, 'T) t = { + declaration: ('M, 'T) Statement.t option; + specifiers: 'M specifier option; + source: ('M * 'M StringLiteral.t) option; + export_kind: Statement.export_kind; + comments: ('M, unit) Syntax.t option; + } + + and 'M specifier = + | ExportSpecifiers of 'M ExportSpecifier.t list + | ExportBatchSpecifier of 'M ExportBatchSpecifier.t + [@@deriving show] + end + + module ExportDefaultDeclaration : sig + type ('M, 'T) t = { + default: 'M; + declaration: ('M, 'T) declaration; + comments: ('M, unit) Syntax.t option; + } + + and ('M, 'T) declaration = + | Declaration of ('M, 'T) Statement.t + | Expression of ('M, 'T) Expression.t + [@@deriving show] + end + + module DeclareExportDeclaration : sig + type ('M, 'T) declaration = + (* declare export var *) + | Variable of ('M * ('M, 'T) DeclareVariable.t) + (* declare export function *) + | Function of ('M * ('M, 'T) DeclareFunction.t) + (* declare export class *) + | Class of ('M * ('M, 'T) DeclareClass.t) + (* declare export default [type] + * this corresponds to things like + * export default 1+1; *) + | DefaultType of ('M, 'T) Type.t + (* declare export type *) + | NamedType of ('M * ('M, 'T) TypeAlias.t) + (* declare export opaque type *) + | NamedOpaqueType of ('M * ('M, 'T) OpaqueType.t) + (* declare export interface *) + | Interface of ('M * ('M, 'T) Interface.t) + + and ('M, 'T) t = { + default: 'M option; + declaration: ('M, 'T) declaration option; + specifiers: 'M ExportNamedDeclaration.specifier option; + source: ('M * 'M StringLiteral.t) option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module ImportDeclaration : sig + type import_kind = + | ImportType + | ImportTypeof + | ImportValue + + and ('M, 'T) specifier = + | ImportNamedSpecifiers of ('M, 'T) named_specifier list + | ImportNamespaceSpecifier of ('M * ('M, 'T) Identifier.t) + + and ('M, 'T) named_specifier = { + kind: import_kind option; + local: ('M, 'T) Identifier.t option; + remote: ('M, 'T) Identifier.t; + } + + and ('M, 'T) t = { + import_kind: import_kind; + source: 'M * 'M StringLiteral.t; + default: ('M, 'T) Identifier.t option; + specifiers: ('M, 'T) specifier option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Expression : sig + type ('M, 'T) t = { + expression: ('M, 'T) Expression.t; + directive: string option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Empty : sig + type 'M t = { comments: ('M, unit) Syntax.t option } [@@deriving show] + end + + type export_kind = + | ExportType + | ExportValue + + and ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = + | Block of ('M, 'T) Block.t + | Break of 'M Break.t + | ClassDeclaration of ('M, 'T) Class.t + | Continue of 'M Continue.t + | Debugger of 'M Debugger.t + | DeclareClass of ('M, 'T) DeclareClass.t + | DeclareExportDeclaration of ('M, 'T) DeclareExportDeclaration.t + | DeclareFunction of ('M, 'T) DeclareFunction.t + | DeclareInterface of ('M, 'T) Interface.t + | DeclareModule of ('M, 'T) DeclareModule.t + | DeclareModuleExports of ('M, 'T) DeclareModuleExports.t + | DeclareTypeAlias of ('M, 'T) TypeAlias.t + | DeclareOpaqueType of ('M, 'T) OpaqueType.t + | DeclareVariable of ('M, 'T) DeclareVariable.t + | DoWhile of ('M, 'T) DoWhile.t + | Empty of 'M Empty.t + | EnumDeclaration of ('M, 'T) EnumDeclaration.t + | ExportDefaultDeclaration of ('M, 'T) ExportDefaultDeclaration.t + | ExportNamedDeclaration of ('M, 'T) ExportNamedDeclaration.t + | Expression of ('M, 'T) Expression.t + | For of ('M, 'T) For.t + | ForIn of ('M, 'T) ForIn.t + | ForOf of ('M, 'T) ForOf.t + | FunctionDeclaration of ('M, 'T) Function.t + | If of ('M, 'T) If.t + | ImportDeclaration of ('M, 'T) ImportDeclaration.t + | InterfaceDeclaration of ('M, 'T) Interface.t + | Labeled of ('M, 'T) Labeled.t + | Return of ('M, 'T) Return.t + | Switch of ('M, 'T) Switch.t + | Throw of ('M, 'T) Throw.t + | Try of ('M, 'T) Try.t + | TypeAlias of ('M, 'T) TypeAlias.t + | OpaqueType of ('M, 'T) OpaqueType.t + | VariableDeclaration of ('M, 'T) VariableDeclaration.t + | While of ('M, 'T) While.t + | With of ('M, 'T) With.t + [@@deriving show] +end = + Statement + +and Expression : sig + module CallTypeArg : sig + module Implicit : sig + type ('M, 'T) t = 'T * 'M t' + + and 'M t' = { comments: ('M, unit) Syntax.t option } [@@deriving show] + end + + type ('M, 'T) t = + | Explicit of ('M, 'T) Type.t + | Implicit of ('M, 'T) Implicit.t + [@@deriving show] + end + + module CallTypeArgs : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + arguments: ('M, 'T) CallTypeArg.t list; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + [@@deriving show] + end + + module SpreadElement : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + argument: ('M, 'T) Expression.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Array : sig + type ('M, 'T) element = + | Expression of ('M, 'T) Expression.t + | Spread of ('M, 'T) SpreadElement.t + | Hole of 'M + [@@deriving show] + + type ('M, 'T) t = { + elements: ('M, 'T) element list; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + [@@deriving show] + end + + module TemplateLiteral : sig + module Element : sig + type value = { + raw: string; + cooked: string; + } + + and 'M t = 'M * t' + + and t' = { + value: value; + tail: bool; + } + [@@deriving show] + end + + type ('M, 'T) t = { + quasis: 'M Element.t list; + expressions: ('M, 'T) Expression.t list; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module TaggedTemplate : sig + type ('M, 'T) t = { + tag: ('M, 'T) Expression.t; + quasi: 'M * ('M, 'T) TemplateLiteral.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Object : sig + module Property : sig + type ('M, 'T) key = + | Literal of ('T * 'M Literal.t) + | Identifier of ('M, 'T) Identifier.t + | PrivateName of 'M PrivateName.t + | Computed of ('M, 'T) ComputedKey.t + + and ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = + | Init of { + key: ('M, 'T) key; + value: ('M, 'T) Expression.t; + shorthand: bool; + } + | Method of { + key: ('M, 'T) key; + value: 'M * ('M, 'T) Function.t; + } + | Get of { + key: ('M, 'T) key; + value: 'M * ('M, 'T) Function.t; + comments: ('M, unit) Syntax.t option; + } + | Set of { + key: ('M, 'T) key; + value: 'M * ('M, 'T) Function.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module SpreadProperty : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + argument: ('M, 'T) Expression.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + type ('M, 'T) property = + | Property of ('M, 'T) Property.t + | SpreadProperty of ('M, 'T) SpreadProperty.t + + and ('M, 'T) t = { + properties: ('M, 'T) property list; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + [@@deriving show] + end + + module Sequence : sig + type ('M, 'T) t = { + expressions: ('M, 'T) Expression.t list; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Unary : sig + type operator = + | Minus + | Plus + | Not + | BitNot + | Typeof + | Void + | Delete + | Await + + and ('M, 'T) t = { + operator: operator; + argument: ('M, 'T) Expression.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Binary : sig + type operator = + | Equal + | NotEqual + | StrictEqual + | StrictNotEqual + | LessThan + | LessThanEqual + | GreaterThan + | GreaterThanEqual + | LShift + | RShift + | RShift3 + | Plus + | Minus + | Mult + | Exp + | Div + | Mod + | BitOr + | Xor + | BitAnd + | In + | Instanceof + + and ('M, 'T) t = { + operator: operator; + left: ('M, 'T) Expression.t; + right: ('M, 'T) Expression.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Assignment : sig + type operator = + | PlusAssign + | MinusAssign + | MultAssign + | ExpAssign + | DivAssign + | ModAssign + | LShiftAssign + | RShiftAssign + | RShift3Assign + | BitOrAssign + | BitXorAssign + | BitAndAssign + + and ('M, 'T) t = { + operator: operator option; + left: ('M, 'T) Pattern.t; + right: ('M, 'T) Expression.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Update : sig + type operator = + | Increment + | Decrement + + and ('M, 'T) t = { + operator: operator; + argument: ('M, 'T) Expression.t; + prefix: bool; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Logical : sig + type operator = + | Or + | And + | NullishCoalesce + + and ('M, 'T) t = { + operator: operator; + left: ('M, 'T) Expression.t; + right: ('M, 'T) Expression.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Conditional : sig + type ('M, 'T) t = { + test: ('M, 'T) Expression.t; + consequent: ('M, 'T) Expression.t; + alternate: ('M, 'T) Expression.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + type ('M, 'T) expression_or_spread = + | Expression of ('M, 'T) Expression.t + | Spread of ('M, 'T) SpreadElement.t + [@@deriving show] + + module ArgList : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + arguments: ('M, 'T) expression_or_spread list; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + [@@deriving show] + end + + module New : sig + type ('M, 'T) t = { + callee: ('M, 'T) Expression.t; + targs: ('M, 'T) Expression.CallTypeArgs.t option; + arguments: ('M, 'T) ArgList.t option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Call : sig + type ('M, 'T) t = { + callee: ('M, 'T) Expression.t; + targs: ('M, 'T) Expression.CallTypeArgs.t option; + arguments: ('M, 'T) ArgList.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module OptionalCall : sig + type ('M, 'T) t = { + call: ('M, 'T) Call.t; + optional: bool; + } + [@@deriving show] + end + + module Member : sig + type ('M, 'T) property = + | PropertyIdentifier of ('M, 'T) Identifier.t + | PropertyPrivateName of 'M PrivateName.t + | PropertyExpression of ('M, 'T) Expression.t + + and ('M, 'T) t = { + _object: ('M, 'T) Expression.t; + property: ('M, 'T) property; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module OptionalMember : sig + type ('M, 'T) t = { + member: ('M, 'T) Member.t; + optional: bool; + } + [@@deriving show] + end + + module Yield : sig + type ('M, 'T) t = { + argument: ('M, 'T) Expression.t option; + comments: ('M, unit) Syntax.t option; + delegate: bool; + } + [@@deriving show] + end + + module Comprehension : sig + module Block : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + left: ('M, 'T) Pattern.t; + right: ('M, 'T) Expression.t; + each: bool; + } + [@@deriving show] + end + + type ('M, 'T) t = { + blocks: ('M, 'T) Block.t list; + filter: ('M, 'T) Expression.t option; + } + [@@deriving show] + end + + module Generator : sig + type ('M, 'T) t = { + blocks: ('M, 'T) Comprehension.Block.t list; + filter: ('M, 'T) Expression.t option; + } + [@@deriving show] + end + + module TypeCast : sig + type ('M, 'T) t = { + expression: ('M, 'T) Expression.t; + annot: ('M, 'T) Type.annotation; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module MetaProperty : sig + type 'M t = { + meta: ('M, 'M) Identifier.t; + property: ('M, 'M) Identifier.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module This : sig + type 'M t = { comments: ('M, unit) Syntax.t option } [@@deriving show] + end + + module Super : sig + type 'M t = { comments: ('M, unit) Syntax.t option } [@@deriving show] + end + + module Import : sig + type ('M, 'T) t = { + argument: ('M, 'T) Expression.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + type ('M, 'T) t = 'T * ('M, 'T) t' + + and ('M, 'T) t' = + | Array of ('M, 'T) Array.t + | ArrowFunction of ('M, 'T) Function.t + | Assignment of ('M, 'T) Assignment.t + | Binary of ('M, 'T) Binary.t + | Call of ('M, 'T) Call.t + | Class of ('M, 'T) Class.t + | Comprehension of ('M, 'T) Comprehension.t + | Conditional of ('M, 'T) Conditional.t + | Function of ('M, 'T) Function.t + | Generator of ('M, 'T) Generator.t + | Identifier of ('M, 'T) Identifier.t + | Import of ('M, 'T) Import.t + | JSXElement of ('M, 'T) JSX.element + | JSXFragment of ('M, 'T) JSX.fragment + | Literal of 'M Literal.t + | Logical of ('M, 'T) Logical.t + | Member of ('M, 'T) Member.t + | MetaProperty of 'M MetaProperty.t + | New of ('M, 'T) New.t + | Object of ('M, 'T) Object.t + | OptionalCall of ('M, 'T) OptionalCall.t + | OptionalMember of ('M, 'T) OptionalMember.t + | Sequence of ('M, 'T) Sequence.t + | Super of 'M Super.t + | TaggedTemplate of ('M, 'T) TaggedTemplate.t + | TemplateLiteral of ('M, 'T) TemplateLiteral.t + | This of 'M This.t + | TypeCast of ('M, 'T) TypeCast.t + | Unary of ('M, 'T) Unary.t + | Update of ('M, 'T) Update.t + | Yield of ('M, 'T) Yield.t + [@@deriving show] +end = + Expression + +and JSX : sig + module Identifier : sig + type ('M, 'T) t = 'T * 'M t' + + and 'M t' = { + name: string; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module NamespacedName : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + namespace: ('M, 'T) Identifier.t; + name: ('M, 'T) Identifier.t; + } + [@@deriving show] + end + + module ExpressionContainer : sig + type ('M, 'T) t = { + expression: ('M, 'T) expression; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + + and ('M, 'T) expression = + | Expression of ('M, 'T) Expression.t + | EmptyExpression + [@@deriving show] + end + + module Text : sig + type t = { + value: string; + raw: string; + } + [@@deriving show] + end + + module Attribute : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) name = + | Identifier of ('M, 'T) Identifier.t + | NamespacedName of ('M, 'T) NamespacedName.t + + and ('M, 'T) value = + | Literal of 'T * 'M Literal.t + | ExpressionContainer of 'T * ('M, 'T) ExpressionContainer.t + + and ('M, 'T) t' = { + name: ('M, 'T) name; + value: ('M, 'T) value option; + } + [@@deriving show] + end + + module SpreadAttribute : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + argument: ('M, 'T) Expression.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module MemberExpression : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) _object = + | Identifier of ('M, 'T) Identifier.t + | MemberExpression of ('M, 'T) t + + and ('M, 'T) t' = { + _object: ('M, 'T) _object; + property: ('M, 'T) Identifier.t; + } + [@@deriving show] + end + + type ('M, 'T) name = + | Identifier of ('M, 'T) Identifier.t + | NamespacedName of ('M, 'T) NamespacedName.t + | MemberExpression of ('M, 'T) MemberExpression.t + [@@deriving show] + + module Opening : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) attribute = + | Attribute of ('M, 'T) Attribute.t + | SpreadAttribute of ('M, 'T) SpreadAttribute.t + + and ('M, 'T) t' = { + name: ('M, 'T) name; + self_closing: bool; + attributes: ('M, 'T) attribute list; + } + [@@deriving show] + end + + module Closing : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { name: ('M, 'T) name } [@@deriving show] + end + + module SpreadChild : sig + type ('M, 'T) t = { + expression: ('M, 'T) Expression.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + type ('M, 'T) child = 'M * ('M, 'T) child' + + and ('M, 'T) child' = + | Element of ('M, 'T) element + | Fragment of ('M, 'T) fragment + | ExpressionContainer of ('M, 'T) ExpressionContainer.t + | SpreadChild of ('M, 'T) SpreadChild.t + | Text of Text.t + + and ('M, 'T) element = { + opening_element: ('M, 'T) Opening.t; + closing_element: ('M, 'T) Closing.t option; + children: 'M * ('M, 'T) child list; + comments: ('M, unit) Syntax.t option; + } + + and ('M, 'T) fragment = { + frag_opening_element: 'M; + frag_closing_element: 'M; + frag_children: 'M * ('M, 'T) child list; + frag_comments: ('M, unit) Syntax.t option; + } + [@@deriving show] +end = + JSX + +and Pattern : sig + module RestElement : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + argument: ('M, 'T) Pattern.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Object : sig + module Property : sig + type ('M, 'T) key = + | Literal of ('M * 'M Literal.t) + | Identifier of ('M, 'T) Identifier.t + | Computed of ('M, 'T) ComputedKey.t + + and ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + key: ('M, 'T) key; + pattern: ('M, 'T) Pattern.t; + default: ('M, 'T) Expression.t option; + shorthand: bool; + } + [@@deriving show] + end + + type ('M, 'T) property = + | Property of ('M, 'T) Property.t + | RestElement of ('M, 'T) RestElement.t + + and ('M, 'T) t = { + properties: ('M, 'T) property list; + annot: ('M, 'T) Type.annotation_or_hint; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + [@@deriving show] + end + + module Array : sig + module Element : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + argument: ('M, 'T) Pattern.t; + default: ('M, 'T) Expression.t option; + } + [@@deriving show] + end + + type ('M, 'T) element = + | Element of ('M, 'T) Element.t + | RestElement of ('M, 'T) RestElement.t + | Hole of 'M + + and ('M, 'T) t = { + elements: ('M, 'T) element list; + annot: ('M, 'T) Type.annotation_or_hint; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + [@@deriving show] + end + + module Identifier : sig + type ('M, 'T) t = { + name: ('M, 'T) Identifier.t; + annot: ('M, 'T) Type.annotation_or_hint; + optional: bool; + } + [@@deriving show] + end + + type ('M, 'T) t = 'T * ('M, 'T) t' + + and ('M, 'T) t' = + | Object of ('M, 'T) Object.t + | Array of ('M, 'T) Array.t + | Identifier of ('M, 'T) Identifier.t + | Expression of ('M, 'T) Expression.t + [@@deriving show] +end = + Pattern + +and Comment : sig + type 'M t = 'M * t' + + and kind = + | Block + | Line + + and t' = { + kind: kind; + text: string; + on_newline: bool; + } + [@@deriving show] +end = + Comment + +and Class : sig + module Method : sig + type ('M, 'T) t = 'T * ('M, 'T) t' + + and kind = + | Constructor + | Method + | Get + | Set + + and ('M, 'T) t' = { + kind: kind; + key: ('M, 'T) Expression.Object.Property.key; + value: 'M * ('M, 'T) Function.t; + static: bool; + decorators: ('M, 'T) Class.Decorator.t list; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Property : sig + type ('M, 'T) t = 'T * ('M, 'T) t' + + and ('M, 'T) t' = { + key: ('M, 'T) Expression.Object.Property.key; + value: ('M, 'T) value; + annot: ('M, 'T) Type.annotation_or_hint; + static: bool; + variance: 'M Variance.t option; + comments: ('M, unit) Syntax.t option; + } + + and ('M, 'T) value = + | Declared + | Uninitialized + | Initialized of ('M, 'T) Expression.t + [@@deriving show] + end + + module PrivateField : sig + type ('M, 'T) t = 'T * ('M, 'T) t' + + and ('M, 'T) t' = { + key: 'M PrivateName.t; + value: ('M, 'T) Class.Property.value; + annot: ('M, 'T) Type.annotation_or_hint; + static: bool; + variance: 'M Variance.t option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Extends : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + expr: ('M, 'T) Expression.t; + targs: ('M, 'T) Type.TypeArgs.t option; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Implements : sig + module Interface : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + id: ('M, 'T) Identifier.t; + targs: ('M, 'T) Type.TypeArgs.t option; + } + [@@deriving show] + end + + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + interfaces: ('M, 'T) Interface.t list; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Body : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + body: ('M, 'T) element list; + comments: ('M, unit) Syntax.t option; + } + + and ('M, 'T) element = + | Method of ('M, 'T) Method.t + | Property of ('M, 'T) Property.t + | PrivateField of ('M, 'T) PrivateField.t + [@@deriving show] + end + + module Decorator : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + expression: ('M, 'T) Expression.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + type ('M, 'T) t = { + id: ('M, 'T) Identifier.t option; + body: ('M, 'T) Class.Body.t; + tparams: ('M, 'T) Type.TypeParams.t option; + extends: ('M, 'T) Extends.t option; + implements: ('M, 'T) Implements.t option; + class_decorators: ('M, 'T) Decorator.t list; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] +end = + Class + +and Function : sig + module RestParam : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + argument: ('M, 'T) Pattern.t; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Param : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + argument: ('M, 'T) Pattern.t; + default: ('M, 'T) Expression.t option; + } + [@@deriving show] + end + + module ThisParam : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + annot: ('M, 'T) Type.annotation; + comments: ('M, unit) Syntax.t option; + } + [@@deriving show] + end + + module Params : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + this_: ('M, 'T) ThisParam.t option; + params: ('M, 'T) Param.t list; + rest: ('M, 'T) RestParam.t option; + comments: ('M, 'M Comment.t list) Syntax.t option; + } + [@@deriving show] + end + + type ('M, 'T) t = { + id: ('M, 'T) Identifier.t option; + params: ('M, 'T) Params.t; + body: ('M, 'T) body; + async: bool; + generator: bool; + predicate: ('M, 'T) Type.Predicate.t option; + return: ('M, 'T) Type.annotation_or_hint; + tparams: ('M, 'T) Type.TypeParams.t option; + comments: ('M, unit) Syntax.t option; + (* Location of the signature portion of a function, e.g. + * function foo(): void {} + * ^^^^^^^^^^^^^^^^^^^^ + *) + sig_loc: 'M; + } + + and ('M, 'T) body = + | BodyBlock of ('M * ('M, 'T) Statement.Block.t) + | BodyExpression of ('M, 'T) Expression.t + [@@deriving show] +end = + Function + +and Program : sig + type ('M, 'T) t = 'M * ('M, 'T) t' + + and ('M, 'T) t' = { + statements: ('M, 'T) Statement.t list; + comments: ('M, unit) Syntax.t option; + all_comments: 'M Comment.t list; + } + [@@deriving show] +end = + Program diff --git a/flow/parser/flow_ast_mapper.ml b/flow/parser/flow_ast_mapper.ml new file mode 100644 index 0000000000..8a8263c4e1 --- /dev/null +++ b/flow/parser/flow_ast_mapper.ml @@ -0,0 +1,2628 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +module Ast = Flow_ast + +let map_opt : 'node. ('node -> 'node) -> 'node option -> 'node option = + fun map opt -> + match opt with + | Some item -> + let item' = map item in + if item == item' then + opt + else + Some item' + | None -> opt + +let id_loc : 'node 'a. ('loc -> 'node -> 'node) -> 'loc -> 'node -> 'a -> ('node -> 'a) -> 'a = + fun map loc item same diff -> + let item' = map loc item in + if item == item' then + same + else + diff item' + +let id : 'node 'a. ('node -> 'node) -> 'node -> 'a -> ('node -> 'a) -> 'a = + fun map item same diff -> + let item' = map item in + if item == item' then + same + else + diff item' + +let map_loc : 'node. ('loc -> 'node -> 'node) -> 'loc * 'node -> 'loc * 'node = + fun map same -> + let (loc, item) = same in + id_loc map loc item same (fun diff -> (loc, diff)) + +let map_list map lst = + let (rev_lst, changed) = + List.fold_left + (fun (lst', changed) item -> + let item' = map item in + (item' :: lst', changed || item' != item)) + ([], false) + lst + in + if changed then + List.rev rev_lst + else + lst + +let map_list_multiple map lst = + let (rev_lst, changed) = + List.fold_left + (fun (lst', changed) item -> + match map item with + | [] -> (lst', true) + | [item'] -> (item' :: lst', changed || item != item') + | items' -> (List.rev_append items' lst', true)) + ([], false) + lst + in + if changed then + List.rev rev_lst + else + lst + +class ['loc] mapper = + object (this) + method program (program : ('loc, 'loc) Ast.Program.t) = + let open Ast.Program in + let (loc, { statements; comments; all_comments }) = program in + let statements' = this#toplevel_statement_list statements in + let comments' = this#syntax_opt comments in + let all_comments' = map_list this#comment all_comments in + if statements == statements' && comments == comments' && all_comments == all_comments' then + program + else + (loc, { statements = statements'; comments = comments'; all_comments = all_comments' }) + + method statement (stmt : ('loc, 'loc) Ast.Statement.t) = + let open Ast.Statement in + match stmt with + | (loc, Block block) -> id_loc this#block loc block stmt (fun block -> (loc, Block block)) + | (loc, Break break) -> id_loc this#break loc break stmt (fun break -> (loc, Break break)) + | (loc, ClassDeclaration cls) -> + id_loc this#class_declaration loc cls stmt (fun cls -> (loc, ClassDeclaration cls)) + | (loc, Continue cont) -> id_loc this#continue loc cont stmt (fun cont -> (loc, Continue cont)) + | (loc, Debugger dbg) -> id_loc this#debugger loc dbg stmt (fun dbg -> (loc, Debugger dbg)) + | (loc, DeclareClass stuff) -> + id_loc this#declare_class loc stuff stmt (fun stuff -> (loc, DeclareClass stuff)) + | (loc, DeclareExportDeclaration decl) -> + id_loc this#declare_export_declaration loc decl stmt (fun decl -> + (loc, DeclareExportDeclaration decl) + ) + | (loc, DeclareFunction stuff) -> + id_loc this#declare_function loc stuff stmt (fun stuff -> (loc, DeclareFunction stuff)) + | (loc, DeclareInterface stuff) -> + id_loc this#declare_interface loc stuff stmt (fun stuff -> (loc, DeclareInterface stuff)) + | (loc, DeclareModule m) -> + id_loc this#declare_module loc m stmt (fun m -> (loc, DeclareModule m)) + | (loc, DeclareTypeAlias stuff) -> + id_loc this#declare_type_alias loc stuff stmt (fun stuff -> (loc, DeclareTypeAlias stuff)) + | (loc, DeclareVariable stuff) -> + id_loc this#declare_variable loc stuff stmt (fun stuff -> (loc, DeclareVariable stuff)) + | (loc, DeclareModuleExports annot) -> + id_loc this#declare_module_exports loc annot stmt (fun annot -> + (loc, DeclareModuleExports annot) + ) + | (loc, DoWhile stuff) -> + id_loc this#do_while loc stuff stmt (fun stuff -> (loc, DoWhile stuff)) + | (loc, Empty empty) -> id_loc this#empty loc empty stmt (fun empty -> (loc, Empty empty)) + | (loc, EnumDeclaration enum) -> + id_loc this#enum_declaration loc enum stmt (fun enum -> (loc, EnumDeclaration enum)) + | (loc, ExportDefaultDeclaration decl) -> + id_loc this#export_default_declaration loc decl stmt (fun decl -> + (loc, ExportDefaultDeclaration decl) + ) + | (loc, ExportNamedDeclaration decl) -> + id_loc this#export_named_declaration loc decl stmt (fun decl -> + (loc, ExportNamedDeclaration decl) + ) + | (loc, Expression expr) -> + id_loc this#expression_statement loc expr stmt (fun expr -> (loc, Expression expr)) + | (loc, For for_stmt) -> + id_loc this#for_statement loc for_stmt stmt (fun for_stmt -> (loc, For for_stmt)) + | (loc, ForIn stuff) -> + id_loc this#for_in_statement loc stuff stmt (fun stuff -> (loc, ForIn stuff)) + | (loc, ForOf stuff) -> + id_loc this#for_of_statement loc stuff stmt (fun stuff -> (loc, ForOf stuff)) + | (loc, FunctionDeclaration func) -> + id_loc this#function_declaration loc func stmt (fun func -> (loc, FunctionDeclaration func)) + | (loc, If if_stmt) -> + id_loc this#if_statement loc if_stmt stmt (fun if_stmt -> (loc, If if_stmt)) + | (loc, ImportDeclaration decl) -> + id_loc this#import_declaration loc decl stmt (fun decl -> (loc, ImportDeclaration decl)) + | (loc, InterfaceDeclaration stuff) -> + id_loc this#interface_declaration loc stuff stmt (fun stuff -> + (loc, InterfaceDeclaration stuff) + ) + | (loc, Labeled label) -> + id_loc this#labeled_statement loc label stmt (fun label -> (loc, Labeled label)) + | (loc, OpaqueType otype) -> + id_loc this#opaque_type loc otype stmt (fun otype -> (loc, OpaqueType otype)) + | (loc, Return ret) -> id_loc this#return loc ret stmt (fun ret -> (loc, Return ret)) + | (loc, Switch switch) -> + id_loc this#switch loc switch stmt (fun switch -> (loc, Switch switch)) + | (loc, Throw throw) -> id_loc this#throw loc throw stmt (fun throw -> (loc, Throw throw)) + | (loc, Try try_stmt) -> + id_loc this#try_catch loc try_stmt stmt (fun try_stmt -> (loc, Try try_stmt)) + | (loc, VariableDeclaration decl) -> + id_loc this#variable_declaration loc decl stmt (fun decl -> (loc, VariableDeclaration decl)) + | (loc, While stuff) -> id_loc this#while_ loc stuff stmt (fun stuff -> (loc, While stuff)) + | (loc, With stuff) -> id_loc this#with_ loc stuff stmt (fun stuff -> (loc, With stuff)) + | (loc, TypeAlias stuff) -> + id_loc this#type_alias loc stuff stmt (fun stuff -> (loc, TypeAlias stuff)) + | (loc, DeclareOpaqueType otype) -> + id_loc this#opaque_type loc otype stmt (fun otype -> (loc, OpaqueType otype)) + + method comment (c : 'loc Ast.Comment.t) = c + + method syntax_opt + : 'internal. ('loc, 'internal) Ast.Syntax.t option -> ('loc, 'internal) Ast.Syntax.t option + = + map_opt this#syntax + + method syntax : 'internal. ('loc, 'internal) Ast.Syntax.t -> ('loc, 'internal) Ast.Syntax.t = + fun attached -> + let open Ast.Syntax in + let { leading; trailing; internal } = attached in + let leading' = map_list this#comment leading in + let trailing' = map_list this#comment trailing in + if leading == leading' && trailing == trailing' then + attached + else + { leading = leading'; trailing = trailing'; internal } + + method expression (expr : ('loc, 'loc) Ast.Expression.t) = + let open Ast.Expression in + match expr with + | (loc, Array x) -> id_loc this#array loc x expr (fun x -> (loc, Array x)) + | (loc, ArrowFunction x) -> + id_loc this#arrow_function loc x expr (fun x -> (loc, ArrowFunction x)) + | (loc, Assignment x) -> id_loc this#assignment loc x expr (fun x -> (loc, Assignment x)) + | (loc, Binary x) -> id_loc this#binary loc x expr (fun x -> (loc, Binary x)) + | (loc, Call x) -> id_loc this#call loc x expr (fun x -> (loc, Call x)) + | (loc, Class x) -> id_loc this#class_expression loc x expr (fun x -> (loc, Class x)) + | (loc, Comprehension x) -> + id_loc this#comprehension loc x expr (fun x -> (loc, Comprehension x)) + | (loc, Conditional x) -> id_loc this#conditional loc x expr (fun x -> (loc, Conditional x)) + | (loc, Function x) -> id_loc this#function_expression loc x expr (fun x -> (loc, Function x)) + | (loc, Generator x) -> id_loc this#generator loc x expr (fun x -> (loc, Generator x)) + | (loc, Identifier x) -> id this#identifier x expr (fun x -> (loc, Identifier x)) + | (loc, Import x) -> id (this#import loc) x expr (fun x -> (loc, Import x)) + | (loc, JSXElement x) -> id_loc this#jsx_element loc x expr (fun x -> (loc, JSXElement x)) + | (loc, JSXFragment x) -> id_loc this#jsx_fragment loc x expr (fun x -> (loc, JSXFragment x)) + | (loc, Literal x) -> id_loc this#literal loc x expr (fun x -> (loc, Literal x)) + | (loc, Logical x) -> id_loc this#logical loc x expr (fun x -> (loc, Logical x)) + | (loc, Member x) -> id_loc this#member loc x expr (fun x -> (loc, Member x)) + | (loc, MetaProperty x) -> + id_loc this#meta_property loc x expr (fun x -> (loc, MetaProperty x)) + | (loc, New x) -> id_loc this#new_ loc x expr (fun x -> (loc, New x)) + | (loc, Object x) -> id_loc this#object_ loc x expr (fun x -> (loc, Object x)) + | (loc, OptionalCall x) -> id (this#optional_call loc) x expr (fun x -> (loc, OptionalCall x)) + | (loc, OptionalMember x) -> + id_loc this#optional_member loc x expr (fun x -> (loc, OptionalMember x)) + | (loc, Sequence x) -> id_loc this#sequence loc x expr (fun x -> (loc, Sequence x)) + | (loc, Super x) -> id_loc this#super_expression loc x expr (fun x -> (loc, Super x)) + | (loc, TaggedTemplate x) -> + id_loc this#tagged_template loc x expr (fun x -> (loc, TaggedTemplate x)) + | (loc, TemplateLiteral x) -> + id_loc this#template_literal loc x expr (fun x -> (loc, TemplateLiteral x)) + | (loc, This x) -> id_loc this#this_expression loc x expr (fun x -> (loc, This x)) + | (loc, TypeCast x) -> id_loc this#type_cast loc x expr (fun x -> (loc, TypeCast x)) + | (loc, Unary x) -> id_loc this#unary_expression loc x expr (fun x -> (loc, Unary x)) + | (loc, Update x) -> id_loc this#update_expression loc x expr (fun x -> (loc, Update x)) + | (loc, Yield x) -> id_loc this#yield loc x expr (fun x -> (loc, Yield x)) + + method array _loc (expr : ('loc, 'loc) Ast.Expression.Array.t) = + let open Ast.Expression in + let { Array.elements; comments } = expr in + let elements' = map_list this#array_element elements in + let comments' = this#syntax_opt comments in + if elements == elements' && comments == comments' then + expr + else + { Array.elements = elements'; comments = comments' } + + method array_element element = + let open Ast.Expression.Array in + match element with + | Expression expr -> id this#expression expr element (fun expr -> Expression expr) + | Spread spread -> id this#spread_element spread element (fun spread -> Spread spread) + | Hole _ -> element + + method arrow_function loc (expr : ('loc, 'loc) Ast.Function.t) = this#function_ loc expr + + method assignment _loc (expr : ('loc, 'loc) Ast.Expression.Assignment.t) = + let open Ast.Expression.Assignment in + let { operator = _; left; right; comments } = expr in + let left' = this#assignment_pattern left in + let right' = this#expression right in + let comments' = this#syntax_opt comments in + if left == left' && right == right' && comments == comments' then + expr + else + { expr with left = left'; right = right'; comments = comments' } + + method binary _loc (expr : ('loc, 'loc) Ast.Expression.Binary.t) = + let open Ast.Expression.Binary in + let { operator = _; left; right; comments } = expr in + let left' = this#expression left in + let right' = this#expression right in + let comments' = this#syntax_opt comments in + if left == left' && right == right' && comments == comments' then + expr + else + { expr with left = left'; right = right'; comments = comments' } + + method block _loc (stmt : ('loc, 'loc) Ast.Statement.Block.t) = + let open Ast.Statement.Block in + let { body; comments } = stmt in + let body' = this#statement_list body in + let comments' = this#syntax_opt comments in + if body == body' && comments == comments' then + stmt + else + { body = body'; comments = comments' } + + method break _loc (break : 'loc Ast.Statement.Break.t) = + let open Ast.Statement.Break in + let { label; comments } = break in + let label' = map_opt this#label_identifier label in + let comments' = this#syntax_opt comments in + if label == label' && comments == comments' then + break + else + { label = label'; comments = comments' } + + method call _loc (expr : ('loc, 'loc) Ast.Expression.Call.t) = + let open Ast.Expression.Call in + let { callee; targs; arguments; comments } = expr in + let callee' = this#expression callee in + let targs' = map_opt this#call_type_args targs in + let arguments' = this#call_arguments arguments in + let comments' = this#syntax_opt comments in + if callee == callee' && targs == targs' && arguments == arguments' && comments == comments' + then + expr + else + { callee = callee'; targs = targs'; arguments = arguments'; comments = comments' } + + method call_arguments (arg_list : ('loc, 'loc) Ast.Expression.ArgList.t) = + let open Ast.Expression.ArgList in + let (loc, { arguments; comments }) = arg_list in + let arguments' = map_list this#expression_or_spread arguments in + let comments' = this#syntax_opt comments in + if arguments == arguments' && comments == comments' then + arg_list + else + (loc, { arguments = arguments'; comments = comments' }) + + method optional_call loc (expr : ('loc, 'loc) Ast.Expression.OptionalCall.t) = + let open Ast.Expression.OptionalCall in + let { call; optional = _ } = expr in + let call' = this#call loc call in + if call == call' then + expr + else + { expr with call = call' } + + method call_type_args (targs : ('loc, 'loc) Ast.Expression.CallTypeArgs.t) = + let open Ast.Expression.CallTypeArgs in + let (loc, { arguments; comments }) = targs in + let arguments' = map_list this#call_type_arg arguments in + let comments' = this#syntax_opt comments in + if arguments == arguments' && comments == comments' then + targs + else + (loc, { arguments = arguments'; comments = comments' }) + + method call_type_arg t = + let open Ast.Expression.CallTypeArg in + match t with + | Explicit x -> + let x' = this#type_ x in + if x' == x then + t + else + Explicit x' + | Implicit (loc, { Implicit.comments }) -> + let comments' = this#syntax_opt comments in + if comments == comments' then + t + else + Implicit (loc, { Implicit.comments = comments' }) + + method catch_body (body : 'loc * ('loc, 'loc) Ast.Statement.Block.t) = map_loc this#block body + + method catch_clause _loc (clause : ('loc, 'loc) Ast.Statement.Try.CatchClause.t') = + let open Ast.Statement.Try.CatchClause in + let { param; body; comments } = clause in + let param' = map_opt this#catch_clause_pattern param in + let body' = this#catch_body body in + let comments' = this#syntax_opt comments in + if param == param' && body == body' && comments == comments' then + clause + else + { param = param'; body = body'; comments = comments' } + + method class_declaration loc (cls : ('loc, 'loc) Ast.Class.t) = this#class_ loc cls + + method class_expression loc (cls : ('loc, 'loc) Ast.Class.t) = this#class_ loc cls + + method class_ _loc (cls : ('loc, 'loc) Ast.Class.t) = + let open Ast.Class in + let { id; body; tparams; extends; implements; class_decorators; comments } = cls in + let id' = map_opt this#class_identifier id in + let body' = this#class_body body in + let tparams' = map_opt this#type_params tparams in + let extends' = map_opt (map_loc this#class_extends) extends in + let implements' = map_opt this#class_implements implements in + let class_decorators' = map_list this#class_decorator class_decorators in + let comments' = this#syntax_opt comments in + if + id == id' + && body == body' + && extends == extends' + && implements == implements' + && class_decorators == class_decorators' + && comments == comments' + && tparams == tparams' + then + cls + else + { + id = id'; + body = body'; + extends = extends'; + implements = implements'; + class_decorators = class_decorators'; + comments = comments'; + tparams = tparams'; + } + + method class_extends _loc (extends : ('loc, 'loc) Ast.Class.Extends.t') = + let open Ast.Class.Extends in + let { expr; targs; comments } = extends in + let expr' = this#expression expr in + let targs' = map_opt this#type_args targs in + let comments' = this#syntax_opt comments in + if expr == expr' && targs == targs' && comments == comments' then + extends + else + { expr = expr'; targs = targs'; comments = comments' } + + method class_identifier (ident : ('loc, 'loc) Ast.Identifier.t) = + this#pattern_identifier ~kind:Ast.Statement.VariableDeclaration.Let ident + + method class_body (cls_body : ('loc, 'loc) Ast.Class.Body.t) = + let open Ast.Class.Body in + let (loc, { body; comments }) = cls_body in + let body' = map_list this#class_element body in + let comments' = this#syntax_opt comments in + if body == body' && comments == comments' then + cls_body + else + (loc, { body = body'; comments = comments' }) + + method class_decorator (dec : ('loc, 'loc) Ast.Class.Decorator.t) = + let open Ast.Class.Decorator in + let (loc, { expression; comments }) = dec in + let expression' = this#expression expression in + let comments' = this#syntax_opt comments in + if expression == expression' && comments == comments' then + dec + else + (loc, { expression = expression'; comments = comments' }) + + method class_element (elem : ('loc, 'loc) Ast.Class.Body.element) = + let open Ast.Class.Body in + match elem with + | Method (loc, meth) -> id_loc this#class_method loc meth elem (fun meth -> Method (loc, meth)) + | Property (loc, prop) -> + id_loc this#class_property loc prop elem (fun prop -> Property (loc, prop)) + | PrivateField (loc, field) -> + id_loc this#class_private_field loc field elem (fun field -> PrivateField (loc, field)) + + method class_implements (implements : ('loc, 'loc) Ast.Class.Implements.t) = + let open Ast.Class.Implements in + let (loc, { interfaces; comments }) = implements in + let interfaces' = map_list this#class_implements_interface interfaces in + let comments' = this#syntax_opt comments in + if interfaces == interfaces' && comments == comments' then + implements + else + (loc, { interfaces = interfaces'; comments = comments' }) + + method class_implements_interface (interface : ('loc, 'loc) Ast.Class.Implements.Interface.t) = + let open Ast.Class.Implements.Interface in + let (loc, { id; targs }) = interface in + let id' = this#type_identifier_reference id in + let targs' = map_opt this#type_args targs in + if id == id' && targs == targs' then + interface + else + (loc, { id = id'; targs = targs' }) + + method class_method _loc (meth : ('loc, 'loc) Ast.Class.Method.t') = + let open Ast.Class.Method in + let { kind = _; key; value; static = _; decorators; comments } = meth in + let key' = this#object_key key in + let value' = map_loc this#function_expression_or_method value in + let decorators' = map_list this#class_decorator decorators in + let comments' = this#syntax_opt comments in + if key == key' && value == value' && decorators == decorators' && comments == comments' then + meth + else + { meth with key = key'; value = value'; decorators = decorators'; comments = comments' } + + method class_property _loc (prop : ('loc, 'loc) Ast.Class.Property.t') = + let open Ast.Class.Property in + let { key; value; annot; static = _; variance; comments } = prop in + let key' = this#object_key key in + let value' = this#class_property_value value in + let annot' = this#type_annotation_hint annot in + let variance' = this#variance_opt variance in + let comments' = this#syntax_opt comments in + if + key == key' + && value == value' + && annot' == annot + && variance' == variance + && comments' == comments + then + prop + else + { + prop with + key = key'; + value = value'; + annot = annot'; + variance = variance'; + comments = comments'; + } + + method class_property_value (value : ('loc, 'loc) Ast.Class.Property.value) = + let open Ast.Class.Property in + match value with + | Declared -> value + | Uninitialized -> value + | Initialized x -> + let x' = this#expression x in + if x == x' then + value + else + Initialized x' + + method class_private_field _loc (prop : ('loc, 'loc) Ast.Class.PrivateField.t') = + let open Ast.Class.PrivateField in + let { key; value; annot; static = _; variance; comments } = prop in + let key' = this#private_name key in + let value' = this#class_property_value value in + let annot' = this#type_annotation_hint annot in + let variance' = this#variance_opt variance in + let comments' = this#syntax_opt comments in + if + key == key' + && value == value' + && annot' == annot + && variance' == variance + && comments' == comments + then + prop + else + { + prop with + key = key'; + value = value'; + annot = annot'; + variance = variance'; + comments = comments'; + } + + (* TODO *) + method comprehension _loc (expr : ('loc, 'loc) Ast.Expression.Comprehension.t) = expr + + method conditional _loc (expr : ('loc, 'loc) Ast.Expression.Conditional.t) = + let open Ast.Expression.Conditional in + let { test; consequent; alternate; comments } = expr in + let test' = this#predicate_expression test in + let consequent' = this#expression consequent in + let alternate' = this#expression alternate in + let comments' = this#syntax_opt comments in + if + test == test' + && consequent == consequent' + && alternate == alternate' + && comments == comments' + then + expr + else + { test = test'; consequent = consequent'; alternate = alternate'; comments = comments' } + + method continue _loc (cont : 'loc Ast.Statement.Continue.t) = + let open Ast.Statement.Continue in + let { label; comments } = cont in + let label' = map_opt this#label_identifier label in + let comments' = this#syntax_opt comments in + if label == label' && comments == comments' then + cont + else + { label = label'; comments = comments' } + + method debugger _loc (dbg : 'loc Ast.Statement.Debugger.t) = + let open Ast.Statement.Debugger in + let { comments } = dbg in + let comments' = this#syntax_opt comments in + if comments == comments' then + dbg + else + { comments = comments' } + + method declare_class _loc (decl : ('loc, 'loc) Ast.Statement.DeclareClass.t) = + let open Ast.Statement.DeclareClass in + let { id = ident; tparams; body; extends; mixins; implements; comments } = decl in + let id' = this#class_identifier ident in + let tparams' = map_opt this#type_params tparams in + let body' = map_loc this#object_type body in + let extends' = map_opt (map_loc this#generic_type) extends in + let mixins' = map_list (map_loc this#generic_type) mixins in + let implements' = map_opt this#class_implements implements in + let comments' = this#syntax_opt comments in + if + id' == ident + && tparams' == tparams + && body' == body + && extends' == extends + && mixins' == mixins + && implements' == implements + && comments' == comments + then + decl + else + { + id = id'; + tparams = tparams'; + body = body'; + extends = extends'; + mixins = mixins'; + implements = implements'; + comments = comments'; + } + + method declare_export_declaration + _loc (decl : ('loc, 'loc) Ast.Statement.DeclareExportDeclaration.t) = + let open Ast.Statement.DeclareExportDeclaration in + let { default; source; specifiers; declaration; comments } = decl in + let specifiers' = map_opt this#export_named_specifier specifiers in + let declaration' = map_opt this#declare_export_declaration_decl declaration in + let comments' = this#syntax_opt comments in + if specifiers == specifiers' && declaration == declaration' && comments == comments' then + decl + else + { + default; + source; + specifiers = specifiers'; + declaration = declaration'; + comments = comments'; + } + + method declare_export_declaration_decl + (decl : ('loc, 'loc) Ast.Statement.DeclareExportDeclaration.declaration) = + let open Ast.Statement.DeclareExportDeclaration in + match decl with + | Variable (loc, dv) -> + let dv' = this#declare_variable loc dv in + if dv' == dv then + decl + else + Variable (loc, dv') + | Function (loc, df) -> + let df' = this#declare_function loc df in + if df' == df then + decl + else + Function (loc, df') + | Class (loc, dc) -> + let dc' = this#declare_class loc dc in + if dc' == dc then + decl + else + Class (loc, dc') + | DefaultType t -> + let t' = this#type_ t in + if t' == t then + decl + else + DefaultType t' + | NamedType (loc, ta) -> + let ta' = this#type_alias loc ta in + if ta' == ta then + decl + else + NamedType (loc, ta') + | NamedOpaqueType (loc, ot) -> + let ot' = this#opaque_type loc ot in + if ot' == ot then + decl + else + NamedOpaqueType (loc, ot') + | Interface (loc, i) -> + let i' = this#interface loc i in + if i' == i then + decl + else + Interface (loc, i') + + method declare_function _loc (decl : ('loc, 'loc) Ast.Statement.DeclareFunction.t) = + let open Ast.Statement.DeclareFunction in + let { id = ident; annot; predicate; comments } = decl in + let id' = this#function_identifier ident in + let annot' = this#type_annotation annot in + let predicate' = map_opt this#predicate predicate in + let comments' = this#syntax_opt comments in + if id' == ident && annot' == annot && predicate' == predicate && comments' == comments then + decl + else + { id = id'; annot = annot'; predicate = predicate'; comments = comments' } + + method declare_interface loc (decl : ('loc, 'loc) Ast.Statement.Interface.t) = + this#interface loc decl + + method declare_module _loc (m : ('loc, 'loc) Ast.Statement.DeclareModule.t) = + let open Ast.Statement.DeclareModule in + let { id; body; kind; comments } = m in + let body' = map_loc this#block body in + let comments' = this#syntax_opt comments in + if body' == body && comments == comments' then + m + else + { id; body = body'; kind; comments = comments' } + + method declare_module_exports _loc (exports : ('loc, 'loc) Ast.Statement.DeclareModuleExports.t) + = + let open Ast.Statement.DeclareModuleExports in + let { annot; comments } = exports in + let annot' = this#type_annotation annot in + let comments' = this#syntax_opt comments in + if annot == annot' && comments == comments' then + exports + else + { annot = annot'; comments = comments' } + + method declare_type_alias loc (decl : ('loc, 'loc) Ast.Statement.TypeAlias.t) = + this#type_alias loc decl + + method declare_variable _loc (decl : ('loc, 'loc) Ast.Statement.DeclareVariable.t) = + let open Ast.Statement.DeclareVariable in + let { id = ident; annot; comments } = decl in + let id' = this#pattern_identifier ~kind:Ast.Statement.VariableDeclaration.Var ident in + let annot' = this#type_annotation annot in + let comments' = this#syntax_opt comments in + if id' == ident && annot' == annot && comments' == comments then + decl + else + { id = id'; annot = annot'; comments = comments' } + + method do_while _loc (stuff : ('loc, 'loc) Ast.Statement.DoWhile.t) = + let open Ast.Statement.DoWhile in + let { body; test; comments } = stuff in + let body' = this#statement body in + let test' = this#predicate_expression test in + let comments' = this#syntax_opt comments in + if body == body' && test == test' && comments == comments' then + stuff + else + { body = body'; test = test'; comments = comments' } + + method empty _loc empty = + let open Ast.Statement.Empty in + let { comments } = empty in + let comments' = this#syntax_opt comments in + if comments == comments' then + empty + else + { comments = comments' } + + method enum_declaration _loc (enum : ('loc, 'loc) Ast.Statement.EnumDeclaration.t) = + let open Ast.Statement.EnumDeclaration in + let { id = ident; body; comments } = enum in + let id' = this#pattern_identifier ~kind:Ast.Statement.VariableDeclaration.Const ident in + let body' = this#enum_body body in + let comments' = this#syntax_opt comments in + if ident == id' && body == body' && comments == comments' then + enum + else + { id = id'; body = body'; comments = comments' } + + method enum_body (body : 'loc Ast.Statement.EnumDeclaration.body) = + let open Ast.Statement.EnumDeclaration in + match body with + | (loc, BooleanBody boolean_body) -> + id this#enum_boolean_body boolean_body body (fun body -> (loc, BooleanBody body)) + | (loc, NumberBody number_body) -> + id this#enum_number_body number_body body (fun body -> (loc, NumberBody body)) + | (loc, StringBody string_body) -> + id this#enum_string_body string_body body (fun body -> (loc, StringBody body)) + | (loc, SymbolBody symbol_body) -> + id this#enum_symbol_body symbol_body body (fun body -> (loc, SymbolBody body)) + + method enum_boolean_body (body : 'loc Ast.Statement.EnumDeclaration.BooleanBody.t) = + let open Ast.Statement.EnumDeclaration.BooleanBody in + let { members; explicit_type = _; has_unknown_members = _; comments } = body in + let members' = map_list this#enum_boolean_member members in + let comments' = this#syntax_opt comments in + if members == members' && comments == comments' then + body + else + { body with members = members'; comments = comments' } + + method enum_number_body (body : 'loc Ast.Statement.EnumDeclaration.NumberBody.t) = + let open Ast.Statement.EnumDeclaration.NumberBody in + let { members; explicit_type = _; has_unknown_members = _; comments } = body in + let members' = map_list this#enum_number_member members in + let comments' = this#syntax_opt comments in + if members == members' && comments == comments' then + body + else + { body with members = members'; comments = comments' } + + method enum_string_body (body : 'loc Ast.Statement.EnumDeclaration.StringBody.t) = + let open Ast.Statement.EnumDeclaration.StringBody in + let { members; explicit_type = _; has_unknown_members = _; comments } = body in + let members' = + match members with + | Defaulted m -> id (map_list this#enum_defaulted_member) m members (fun m -> Defaulted m) + | Initialized m -> id (map_list this#enum_string_member) m members (fun m -> Initialized m) + in + let comments' = this#syntax_opt comments in + if members == members' && comments == comments' then + body + else + { body with members = members'; comments = comments' } + + method enum_symbol_body (body : 'loc Ast.Statement.EnumDeclaration.SymbolBody.t) = + let open Ast.Statement.EnumDeclaration.SymbolBody in + let { members; has_unknown_members = _; comments } = body in + let members' = map_list this#enum_defaulted_member members in + let comments' = this#syntax_opt comments in + if members == members' && comments == comments' then + body + else + { body with members = members'; comments = comments' } + + method enum_defaulted_member (member : 'loc Ast.Statement.EnumDeclaration.DefaultedMember.t) = + let open Ast.Statement.EnumDeclaration.DefaultedMember in + let (loc, { id = ident }) = member in + let id' = this#enum_member_identifier ident in + if ident == id' then + member + else + (loc, { id = id' }) + + method enum_boolean_member + (member : + ('loc Ast.BooleanLiteral.t, 'loc) Ast.Statement.EnumDeclaration.InitializedMember.t + ) = + let open Ast.Statement.EnumDeclaration.InitializedMember in + let (loc, { id = ident; init }) = member in + let id' = this#enum_member_identifier ident in + if ident == id' then + member + else + (loc, { id = id'; init }) + + method enum_number_member + (member : ('loc Ast.NumberLiteral.t, 'loc) Ast.Statement.EnumDeclaration.InitializedMember.t) + = + let open Ast.Statement.EnumDeclaration.InitializedMember in + let (loc, { id = ident; init }) = member in + let id' = this#enum_member_identifier ident in + if ident == id' then + member + else + (loc, { id = id'; init }) + + method enum_string_member + (member : ('loc Ast.StringLiteral.t, 'loc) Ast.Statement.EnumDeclaration.InitializedMember.t) + = + let open Ast.Statement.EnumDeclaration.InitializedMember in + let (loc, { id = ident; init }) = member in + let id' = this#enum_member_identifier ident in + if ident == id' then + member + else + (loc, { id = id'; init }) + + method enum_member_identifier (id : ('loc, 'loc) Ast.Identifier.t) = this#identifier id + + method export_default_declaration + _loc (decl : ('loc, 'loc) Ast.Statement.ExportDefaultDeclaration.t) = + let open Ast.Statement.ExportDefaultDeclaration in + let { default; declaration; comments } = decl in + let declaration' = this#export_default_declaration_decl declaration in + let comments' = this#syntax_opt comments in + if declaration' == declaration && comments' == comments then + decl + else + { default; declaration = declaration'; comments = comments' } + + method export_default_declaration_decl + (decl : ('loc, 'loc) Ast.Statement.ExportDefaultDeclaration.declaration) = + let open Ast.Statement.ExportDefaultDeclaration in + match decl with + | Declaration stmt -> id this#statement stmt decl (fun stmt -> Declaration stmt) + | Expression expr -> id this#expression expr decl (fun expr -> Expression expr) + + method export_named_declaration _loc (decl : ('loc, 'loc) Ast.Statement.ExportNamedDeclaration.t) + = + let open Ast.Statement.ExportNamedDeclaration in + let { export_kind; source; specifiers; declaration; comments } = decl in + let specifiers' = map_opt this#export_named_specifier specifiers in + let declaration' = map_opt this#statement declaration in + let comments' = this#syntax_opt comments in + if specifiers == specifiers' && declaration == declaration' && comments == comments' then + decl + else + { + export_kind; + source; + specifiers = specifiers'; + declaration = declaration'; + comments = comments'; + } + + method export_named_declaration_specifier + (spec : 'loc Ast.Statement.ExportNamedDeclaration.ExportSpecifier.t) = + let open Ast.Statement.ExportNamedDeclaration.ExportSpecifier in + let (loc, { local; exported }) = spec in + let local' = this#identifier local in + let exported' = map_opt this#identifier exported in + if local == local' && exported == exported' then + spec + else + (loc, { local = local'; exported = exported' }) + + method export_batch_specifier + (spec : 'loc Ast.Statement.ExportNamedDeclaration.ExportBatchSpecifier.t) = + let (loc, id_opt) = spec in + let id_opt' = map_opt this#identifier id_opt in + if id_opt == id_opt' then + spec + else + (loc, id_opt') + + method export_named_specifier (spec : 'loc Ast.Statement.ExportNamedDeclaration.specifier) = + let open Ast.Statement.ExportNamedDeclaration in + match spec with + | ExportSpecifiers spec_list -> + let spec_list' = map_list this#export_named_declaration_specifier spec_list in + if spec_list == spec_list' then + spec + else + ExportSpecifiers spec_list' + | ExportBatchSpecifier batch -> + let batch' = this#export_batch_specifier batch in + if batch == batch' then + spec + else + ExportBatchSpecifier batch' + + method expression_statement _loc (stmt : ('loc, 'loc) Ast.Statement.Expression.t) = + let open Ast.Statement.Expression in + let { expression = expr; directive; comments } = stmt in + let expr' = this#expression expr in + let comments' = this#syntax_opt comments in + if expr == expr' && comments == comments' then + stmt + else + { expression = expr'; directive; comments = comments' } + + method expression_or_spread expr_or_spread = + let open Ast.Expression in + match expr_or_spread with + | Expression expr -> id this#expression expr expr_or_spread (fun expr -> Expression expr) + | Spread spread -> id this#spread_element spread expr_or_spread (fun spread -> Spread spread) + + method for_in_statement _loc (stmt : ('loc, 'loc) Ast.Statement.ForIn.t) = + let open Ast.Statement.ForIn in + let { left; right; body; each; comments } = stmt in + let left' = this#for_in_statement_lhs left in + let right' = this#expression right in + let body' = this#statement body in + let comments' = this#syntax_opt comments in + if left == left' && right == right' && body == body' && comments == comments' then + stmt + else + { left = left'; right = right'; body = body'; each; comments = comments' } + + method for_in_statement_lhs (left : ('loc, 'loc) Ast.Statement.ForIn.left) = + let open Ast.Statement.ForIn in + match left with + | LeftDeclaration decl -> + id this#for_in_left_declaration decl left (fun decl -> LeftDeclaration decl) + | LeftPattern patt -> + id this#for_in_assignment_pattern patt left (fun patt -> LeftPattern patt) + + method for_in_left_declaration left = + let (loc, decl) = left in + id_loc this#variable_declaration loc decl left (fun decl -> (loc, decl)) + + method for_of_statement _loc (stuff : ('loc, 'loc) Ast.Statement.ForOf.t) = + let open Ast.Statement.ForOf in + let { left; right; body; await; comments } = stuff in + let left' = this#for_of_statement_lhs left in + let right' = this#expression right in + let body' = this#statement body in + let comments' = this#syntax_opt comments in + if left == left' && right == right' && body == body' && comments == comments' then + stuff + else + { left = left'; right = right'; body = body'; await; comments = comments' } + + method for_of_statement_lhs (left : ('loc, 'loc) Ast.Statement.ForOf.left) = + let open Ast.Statement.ForOf in + match left with + | LeftDeclaration decl -> + id this#for_of_left_declaration decl left (fun decl -> LeftDeclaration decl) + | LeftPattern patt -> + id this#for_of_assignment_pattern patt left (fun patt -> LeftPattern patt) + + method for_of_left_declaration left = + let (loc, decl) = left in + id_loc this#variable_declaration loc decl left (fun decl -> (loc, decl)) + + method for_statement _loc (stmt : ('loc, 'loc) Ast.Statement.For.t) = + let open Ast.Statement.For in + let { init; test; update; body; comments } = stmt in + let init' = map_opt this#for_statement_init init in + let test' = map_opt this#predicate_expression test in + let update' = map_opt this#expression update in + let body' = this#statement body in + let comments' = this#syntax_opt comments in + if + init == init' + && test == test' + && update == update' + && body == body' + && comments == comments' + then + stmt + else + { init = init'; test = test'; update = update'; body = body'; comments = comments' } + + method for_statement_init (init : ('loc, 'loc) Ast.Statement.For.init) = + let open Ast.Statement.For in + match init with + | InitDeclaration decl -> + id this#for_init_declaration decl init (fun decl -> InitDeclaration decl) + | InitExpression expr -> id this#expression expr init (fun expr -> InitExpression expr) + + method for_init_declaration init = + let (loc, decl) = init in + id_loc this#variable_declaration loc decl init (fun decl -> (loc, decl)) + + method function_param_type (fpt : ('loc, 'loc) Ast.Type.Function.Param.t) = + let open Ast.Type.Function.Param in + let (loc, { annot; name; optional }) = fpt in + let annot' = this#type_ annot in + let name' = map_opt this#identifier name in + if annot' == annot && name' == name then + fpt + else + (loc, { annot = annot'; name = name'; optional }) + + method function_rest_param_type (frpt : ('loc, 'loc) Ast.Type.Function.RestParam.t) = + let open Ast.Type.Function.RestParam in + let (loc, { argument; comments }) = frpt in + let argument' = this#function_param_type argument in + let comments' = this#syntax_opt comments in + if argument' == argument && comments' == comments then + frpt + else + (loc, { argument = argument'; comments = comments' }) + + method function_this_param_type (this_param : ('loc, 'loc) Ast.Type.Function.ThisParam.t) = + let open Ast.Type.Function.ThisParam in + let (loc, { annot; comments }) = this_param in + let annot' = this#type_annotation annot in + let comments' = this#syntax_opt comments in + if annot' == annot && comments' == comments then + this_param + else + (loc, { annot = annot'; comments = comments' }) + + method function_type _loc (ft : ('loc, 'loc) Ast.Type.Function.t) = + let open Ast.Type.Function in + let { + params = (params_loc, { Params.this_; params = ps; rest = rpo; comments = params_comments }); + return; + tparams; + comments = func_comments; + } = + ft + in + let this_' = map_opt this#function_this_param_type this_ in + let ps' = map_list this#function_param_type ps in + let rpo' = map_opt this#function_rest_param_type rpo in + let return' = this#type_ return in + let tparams' = map_opt this#type_params tparams in + let func_comments' = this#syntax_opt func_comments in + let params_comments' = this#syntax_opt params_comments in + if + ps' == ps + && rpo' == rpo + && return' == return + && tparams' == tparams + && func_comments' == func_comments + && params_comments' == params_comments + && this_' == this_ + then + ft + else + { + params = + ( params_loc, + { Params.this_ = this_'; params = ps'; rest = rpo'; comments = params_comments' } + ); + return = return'; + tparams = tparams'; + comments = func_comments'; + } + + method label_identifier (ident : ('loc, 'loc) Ast.Identifier.t) = this#identifier ident + + method object_property_value_type (opvt : ('loc, 'loc) Ast.Type.Object.Property.value) = + let open Ast.Type.Object.Property in + match opvt with + | Init t -> id this#type_ t opvt (fun t -> Init t) + | Get t -> id this#object_type_property_getter t opvt (fun t -> Get t) + | Set t -> id this#object_type_property_setter t opvt (fun t -> Set t) + + method object_type_property_getter getter = + let (loc, ft) = getter in + id_loc this#function_type loc ft getter (fun ft -> (loc, ft)) + + method object_type_property_setter setter = + let (loc, ft) = setter in + id_loc this#function_type loc ft setter (fun ft -> (loc, ft)) + + method object_property_type (opt : ('loc, 'loc) Ast.Type.Object.Property.t) = + let open Ast.Type.Object.Property in + let (loc, { key; value; optional; static; proto; _method; variance; comments }) = opt in + let key' = this#object_key key in + let value' = this#object_property_value_type value in + let variance' = this#variance_opt variance in + let comments' = this#syntax_opt comments in + if key' == key && value' == value && variance' == variance && comments' == comments then + opt + else + ( loc, + { + key = key'; + value = value'; + optional; + static; + proto; + _method; + variance = variance'; + comments = comments'; + } + ) + + method object_spread_property_type (opt : ('loc, 'loc) Ast.Type.Object.SpreadProperty.t) = + let open Ast.Type.Object.SpreadProperty in + let (loc, { argument; comments }) = opt in + let argument' = this#type_ argument in + let comments' = this#syntax_opt comments in + if argument' == argument && comments == comments' then + opt + else + (loc, { argument = argument'; comments = comments' }) + + method object_indexer_property_type (opt : ('loc, 'loc) Ast.Type.Object.Indexer.t) = + let open Ast.Type.Object.Indexer in + let (loc, { id; key; value; static; variance; comments }) = opt in + let key' = this#type_ key in + let value' = this#type_ value in + let variance' = this#variance_opt variance in + let comments' = this#syntax_opt comments in + if key' == key && value' == value && variance' == variance && comments' == comments then + opt + else + (loc, { id; key = key'; value = value'; static; variance = variance'; comments = comments' }) + + method object_internal_slot_property_type (slot : ('loc, 'loc) Ast.Type.Object.InternalSlot.t) = + let open Ast.Type.Object.InternalSlot in + let (loc, { id; value; optional; static; _method; comments }) = slot in + let id' = this#identifier id in + let value' = this#type_ value in + let comments' = this#syntax_opt comments in + if id == id' && value == value' && comments == comments' then + slot + else + (loc, { id = id'; value = value'; optional; static; _method; comments = comments' }) + + method object_call_property_type (call : ('loc, 'loc) Ast.Type.Object.CallProperty.t) = + let open Ast.Type.Object.CallProperty in + let (loc, { value = (value_loc, value); static; comments }) = call in + let value' = this#function_type value_loc value in + let comments' = this#syntax_opt comments in + if value == value' && comments == comments' then + call + else + (loc, { value = (value_loc, value'); static; comments = comments' }) + + method object_type _loc (ot : ('loc, 'loc) Ast.Type.Object.t) = + let open Ast.Type.Object in + let { properties; exact; inexact; comments } = ot in + let properties' = + map_list + (fun p -> + match p with + | Property p' -> id this#object_property_type p' p (fun p' -> Property p') + | SpreadProperty p' -> + id this#object_spread_property_type p' p (fun p' -> SpreadProperty p') + | Indexer p' -> id this#object_indexer_property_type p' p (fun p' -> Indexer p') + | InternalSlot p' -> + id this#object_internal_slot_property_type p' p (fun p' -> InternalSlot p') + | CallProperty p' -> id this#object_call_property_type p' p (fun p' -> CallProperty p')) + properties + in + let comments' = this#syntax_opt comments in + if properties' == properties && comments == comments' then + ot + else + { properties = properties'; exact; inexact; comments = comments' } + + method interface_type _loc (i : ('loc, 'loc) Ast.Type.Interface.t) = + let open Ast.Type.Interface in + let { extends; body; comments } = i in + let extends' = map_list (map_loc this#generic_type) extends in + let body' = map_loc this#object_type body in + let comments' = this#syntax_opt comments in + if extends' == extends && body' == body && comments == comments' then + i + else + { extends = extends'; body = body'; comments = comments' } + + method generic_identifier_type (git : ('loc, 'loc) Ast.Type.Generic.Identifier.t) = + let open Ast.Type.Generic.Identifier in + match git with + | Unqualified i -> id this#type_identifier_reference i git (fun i -> Unqualified i) + | Qualified i -> id this#generic_qualified_identifier_type i git (fun i -> Qualified i) + + method generic_qualified_identifier_type qual = + let open Ast.Type.Generic.Identifier in + let (loc, { qualification; id }) = qual in + let qualification' = this#generic_identifier_type qualification in + let id' = this#member_type_identifier id in + if qualification' == qualification && id' == id then + qual + else + (loc, { qualification = qualification'; id = id' }) + + method member_type_identifier id = this#identifier id + + method variance (variance : 'loc Ast.Variance.t) = + let (loc, { Ast.Variance.kind; comments }) = variance in + let comments' = this#syntax_opt comments in + if comments == comments' then + variance + else + (loc, { Ast.Variance.kind; comments = comments' }) + + method variance_opt (opt : 'loc Ast.Variance.t option) = map_opt this#variance opt + + method type_args (targs : ('loc, 'loc) Ast.Type.TypeArgs.t) = + let open Ast.Type.TypeArgs in + let (loc, { arguments; comments }) = targs in + let arguments' = map_list this#type_ arguments in + let comments' = this#syntax_opt comments in + if arguments == arguments' && comments == comments' then + targs + else + (loc, { arguments = arguments'; comments = comments' }) + + method type_params (tparams : ('loc, 'loc) Ast.Type.TypeParams.t) = + let open Ast.Type.TypeParams in + let (loc, { params = tps; comments }) = tparams in + let tps' = map_list this#type_param tps in + let comments' = this#syntax_opt comments in + if tps' == tps && comments' == comments then + tparams + else + (loc, { params = tps'; comments = comments' }) + + method type_param (tparam : ('loc, 'loc) Ast.Type.TypeParam.t) = + let open Ast.Type.TypeParam in + let (loc, { name; bound; variance; default }) = tparam in + let bound' = this#type_annotation_hint bound in + let variance' = this#variance_opt variance in + let default' = map_opt this#type_ default in + let name' = this#binding_type_identifier name in + if name' == name && bound' == bound && variance' == variance && default' == default then + tparam + else + (loc, { name = name'; bound = bound'; variance = variance'; default = default' }) + + method generic_type _loc (gt : ('loc, 'loc) Ast.Type.Generic.t) = + let open Ast.Type.Generic in + let { id; targs; comments } = gt in + let id' = this#generic_identifier_type id in + let targs' = map_opt this#type_args targs in + let comments' = this#syntax_opt comments in + if id' == id && targs' == targs && comments' == comments then + gt + else + { id = id'; targs = targs'; comments = comments' } + + method indexed_access _loc (ia : ('loc, 'loc) Ast.Type.IndexedAccess.t) = + let open Ast.Type.IndexedAccess in + let { _object; index; comments } = ia in + let _object' = this#type_ _object in + let index' = this#type_ index in + let comments' = this#syntax_opt comments in + if _object' == _object && index' == index && comments' == comments then + ia + else + { _object = _object'; index = index'; comments = comments' } + + method optional_indexed_access loc (ia : ('loc, 'loc) Ast.Type.OptionalIndexedAccess.t) = + let open Ast.Type.OptionalIndexedAccess in + let { indexed_access; optional } = ia in + let indexed_access' = this#indexed_access loc indexed_access in + if indexed_access' == indexed_access then + ia + else + { indexed_access = indexed_access'; optional } + + method string_literal_type _loc (lit : 'loc Ast.StringLiteral.t) = + let open Ast.StringLiteral in + let { value; raw; comments } = lit in + let comments' = this#syntax_opt comments in + if comments == comments' then + lit + else + { value; raw; comments = comments' } + + method number_literal_type _loc (lit : 'loc Ast.NumberLiteral.t) = + let open Ast.NumberLiteral in + let { value; raw; comments } = lit in + let comments' = this#syntax_opt comments in + if comments == comments' then + lit + else + { value; raw; comments = comments' } + + method bigint_literal_type _loc (lit : 'loc Ast.BigIntLiteral.t) = + let open Ast.BigIntLiteral in + let { approx_value; bigint; comments } = lit in + let comments' = this#syntax_opt comments in + if comments == comments' then + lit + else + { approx_value; bigint; comments = comments' } + + method boolean_literal_type _loc (lit : 'loc Ast.BooleanLiteral.t) = + let open Ast.BooleanLiteral in + let { value; comments } = lit in + let comments' = this#syntax_opt comments in + if comments == comments' then + lit + else + { value; comments = comments' } + + method nullable_type (t : ('loc, 'loc) Ast.Type.Nullable.t) = + let open Ast.Type.Nullable in + let { argument; comments } = t in + let argument' = this#type_ argument in + let comments' = this#syntax_opt comments in + if argument == argument' && comments == comments' then + t + else + { argument = argument'; comments = comments' } + + method typeof_type (t : ('loc, 'loc) Ast.Type.Typeof.t) = + let open Ast.Type.Typeof in + let { argument; comments } = t in + let argument' = this#typeof_expression argument in + let comments' = this#syntax_opt comments in + if argument == argument' && comments == comments' then + t + else + { argument = argument'; comments = comments' } + + method typeof_expression (git : ('loc, 'loc) Ast.Type.Typeof.Target.t) = + let open Ast.Type.Typeof.Target in + match git with + | Unqualified i -> id this#typeof_identifier i git (fun i -> Unqualified i) + | Qualified i -> id this#typeof_qualified_identifier i git (fun i -> Qualified i) + + method typeof_identifier id = this#identifier id + + method typeof_member_identifier id = this#identifier id + + method typeof_qualified_identifier qual = + let open Ast.Type.Typeof.Target in + let (loc, { qualification; id }) = qual in + let qualification' = this#typeof_expression qualification in + let id' = this#typeof_member_identifier id in + if qualification' == qualification && id' == id then + qual + else + (loc, { qualification = qualification'; id = id' }) + + method tuple_type (t : ('loc, 'loc) Ast.Type.Tuple.t) = + let open Ast.Type.Tuple in + let { types; comments } = t in + let types' = map_list this#type_ types in + let comments' = this#syntax_opt comments in + if types == types' && comments == comments' then + t + else + { types = types'; comments = comments' } + + method array_type (t : ('loc, 'loc) Ast.Type.Array.t) = + let open Ast.Type.Array in + let { argument; comments } = t in + let argument' = this#type_ argument in + let comments' = this#syntax_opt comments in + if argument == argument' && comments == comments' then + t + else + { argument = argument'; comments = comments' } + + method union_type _loc (t : ('loc, 'loc) Ast.Type.Union.t) = + let open Ast.Type.Union in + let { types = (t0, t1, ts); comments } = t in + let t0' = this#type_ t0 in + let t1' = this#type_ t1 in + let ts' = map_list this#type_ ts in + let comments' = this#syntax_opt comments in + if t0' == t0 && t1' == t1 && ts' == ts && comments' == comments then + t + else + { types = (t0', t1', ts'); comments = comments' } + + method intersection_type _loc (t : ('loc, 'loc) Ast.Type.Intersection.t) = + let open Ast.Type.Intersection in + let { types = (t0, t1, ts); comments } = t in + let t0' = this#type_ t0 in + let t1' = this#type_ t1 in + let ts' = map_list this#type_ ts in + let comments' = this#syntax_opt comments in + if t0' == t0 && t1' == t1 && ts' == ts && comments' == comments then + t + else + { types = (t0', t1', ts'); comments = comments' } + + method type_ (t : ('loc, 'loc) Ast.Type.t) = + let open Ast.Type in + match t with + | (loc, Any comments) -> id this#syntax_opt comments t (fun comments -> (loc, Any comments)) + | (loc, Mixed comments) -> + id this#syntax_opt comments t (fun comments -> (loc, Mixed comments)) + | (loc, Empty comments) -> + id this#syntax_opt comments t (fun comments -> (loc, Empty comments)) + | (loc, Void comments) -> id this#syntax_opt comments t (fun comments -> (loc, Void comments)) + | (loc, Null comments) -> id this#syntax_opt comments t (fun comments -> (loc, Null comments)) + | (loc, Symbol comments) -> + id this#syntax_opt comments t (fun comments -> (loc, Symbol comments)) + | (loc, Number comments) -> + id this#syntax_opt comments t (fun comments -> (loc, Number comments)) + | (loc, BigInt comments) -> + id this#syntax_opt comments t (fun comments -> (loc, BigInt comments)) + | (loc, String comments) -> + id this#syntax_opt comments t (fun comments -> (loc, String comments)) + | (loc, Boolean comments) -> + id this#syntax_opt comments t (fun comments -> (loc, Boolean comments)) + | (loc, Exists comments) -> + id this#syntax_opt comments t (fun comments -> (loc, Exists comments)) + | (loc, Nullable t') -> id this#nullable_type t' t (fun t' -> (loc, Nullable t')) + | (loc, Array t') -> id this#array_type t' t (fun t' -> (loc, Array t')) + | (loc, Typeof t') -> id this#typeof_type t' t (fun t' -> (loc, Typeof t')) + | (loc, Function ft) -> id_loc this#function_type loc ft t (fun ft -> (loc, Function ft)) + | (loc, Object ot) -> id_loc this#object_type loc ot t (fun ot -> (loc, Object ot)) + | (loc, Interface i) -> id_loc this#interface_type loc i t (fun i -> (loc, Interface i)) + | (loc, Generic gt) -> id_loc this#generic_type loc gt t (fun gt -> (loc, Generic gt)) + | (loc, IndexedAccess ia) -> + id_loc this#indexed_access loc ia t (fun ia -> (loc, IndexedAccess ia)) + | (loc, OptionalIndexedAccess ia) -> + id_loc this#optional_indexed_access loc ia t (fun ia -> (loc, OptionalIndexedAccess ia)) + | (loc, StringLiteral lit) -> + id_loc this#string_literal_type loc lit t (fun lit -> (loc, StringLiteral lit)) + | (loc, NumberLiteral lit) -> + id_loc this#number_literal_type loc lit t (fun lit -> (loc, NumberLiteral lit)) + | (loc, BigIntLiteral lit) -> + id_loc this#bigint_literal_type loc lit t (fun lit -> (loc, BigIntLiteral lit)) + | (loc, BooleanLiteral lit) -> + id_loc this#boolean_literal_type loc lit t (fun lit -> (loc, BooleanLiteral lit)) + | (loc, Union t') -> id_loc this#union_type loc t' t (fun t' -> (loc, Union t')) + | (loc, Intersection t') -> + id_loc this#intersection_type loc t' t (fun t' -> (loc, Intersection t')) + | (loc, Tuple t') -> id this#tuple_type t' t (fun t' -> (loc, Tuple t')) + + method type_annotation (annot : ('loc, 'loc) Ast.Type.annotation) = + let (loc, a) = annot in + id this#type_ a annot (fun a -> (loc, a)) + + method type_annotation_hint (return : ('M, 'T) Ast.Type.annotation_or_hint) = + let open Ast.Type in + match return with + | Available annot -> + let annot' = this#type_annotation annot in + if annot' == annot then + return + else + Available annot' + | Missing _loc -> return + + method function_declaration loc (stmt : ('loc, 'loc) Ast.Function.t) = this#function_ loc stmt + + method function_expression loc (stmt : ('loc, 'loc) Ast.Function.t) = + this#function_expression_or_method loc stmt + + (** previously, we conflated [function_expression] and [class_method]. callers should be + updated to override those individually. *) + method function_expression_or_method loc (stmt : ('loc, 'loc) Ast.Function.t) = + this#function_ loc stmt + [@@alert deprecated "Use either function_expression or class_method"] + + (* Internal helper for function declarations, function expressions and arrow functions *) + method function_ _loc (expr : ('loc, 'loc) Ast.Function.t) = + let open Ast.Function in + let { + id = ident; + params; + body; + async; + generator; + predicate; + return; + tparams; + sig_loc; + comments; + } = + expr + in + let ident' = map_opt this#function_identifier ident in + let params' = this#function_params params in + let return' = this#type_annotation_hint return in + let body' = this#function_body_any body in + let predicate' = map_opt this#predicate predicate in + let tparams' = map_opt this#type_params tparams in + let comments' = this#syntax_opt comments in + if + ident == ident' + && params == params' + && body == body' + && predicate == predicate' + && return == return' + && tparams == tparams' + && comments == comments' + then + expr + else + { + id = ident'; + params = params'; + return = return'; + body = body'; + async; + generator; + predicate = predicate'; + tparams = tparams'; + sig_loc; + comments = comments'; + } + + method function_params (params : ('loc, 'loc) Ast.Function.Params.t) = + let open Ast.Function in + let (loc, { Params.params = params_list; rest; comments; this_ }) = params in + let params_list' = map_list this#function_param params_list in + let rest' = map_opt this#function_rest_param rest in + let this_' = map_opt this#function_this_param this_ in + let comments' = this#syntax_opt comments in + if params_list == params_list' && rest == rest' && comments == comments' && this_ == this_' + then + params + else + (loc, { Params.params = params_list'; rest = rest'; comments = comments'; this_ = this_' }) + + method function_this_param (this_param : ('loc, 'loc) Ast.Function.ThisParam.t) = + let open Ast.Function.ThisParam in + let (loc, { annot; comments }) = this_param in + let annot' = this#type_annotation annot in + let comments' = this#syntax_opt comments in + if annot' == annot && comments' == comments then + this_param + else + (loc, { annot = annot'; comments = comments' }) + + method function_param (param : ('loc, 'loc) Ast.Function.Param.t) = + let open Ast.Function.Param in + let (loc, { argument; default }) = param in + let argument' = this#function_param_pattern argument in + let default' = map_opt this#expression default in + if argument == argument' && default == default' then + param + else + (loc, { argument = argument'; default = default' }) + + method function_body_any (body : ('loc, 'loc) Ast.Function.body) = + match body with + | Ast.Function.BodyBlock block -> + id this#function_body block body (fun block -> Ast.Function.BodyBlock block) + | Ast.Function.BodyExpression expr -> + id this#expression expr body (fun expr -> Ast.Function.BodyExpression expr) + + method function_body (body : 'loc * ('loc, 'loc) Ast.Statement.Block.t) = + let (loc, block) = body in + id_loc this#block loc block body (fun block -> (loc, block)) + + method function_identifier (ident : ('loc, 'loc) Ast.Identifier.t) = + this#pattern_identifier ~kind:Ast.Statement.VariableDeclaration.Var ident + + (* TODO *) + method generator _loc (expr : ('loc, 'loc) Ast.Expression.Generator.t) = expr + + method identifier (id : ('loc, 'loc) Ast.Identifier.t) = + let open Ast.Identifier in + let (loc, { name; comments }) = id in + let comments' = this#syntax_opt comments in + if comments == comments' then + id + else + (loc, { name; comments = comments' }) + + method type_identifier (id : ('loc, 'loc) Ast.Identifier.t) = this#identifier id + + method type_identifier_reference (id : ('loc, 'loc) Ast.Identifier.t) = this#type_identifier id + + method binding_type_identifier (id : ('loc, 'loc) Ast.Identifier.t) = this#type_identifier id + + method interface _loc (interface : ('loc, 'loc) Ast.Statement.Interface.t) = + let open Ast.Statement.Interface in + let { id = ident; tparams; extends; body; comments } = interface in + let id' = this#binding_type_identifier ident in + let tparams' = map_opt this#type_params tparams in + let extends' = map_list (map_loc this#generic_type) extends in + let body' = map_loc this#object_type body in + let comments' = this#syntax_opt comments in + if + id' == ident + && tparams' == tparams + && extends' == extends + && body' == body + && comments' == comments + then + interface + else + { id = id'; tparams = tparams'; extends = extends'; body = body'; comments = comments' } + + method interface_declaration loc (decl : ('loc, 'loc) Ast.Statement.Interface.t) = + this#interface loc decl + + method private_name (id : 'loc Ast.PrivateName.t) = + let open Ast.PrivateName in + let (loc, { name; comments }) = id in + let comments' = this#syntax_opt comments in + if comments == comments' then + id + else + (loc, { name; comments = comments' }) + + method computed_key (key : ('loc, 'loc) Ast.ComputedKey.t) = + let open Ast.ComputedKey in + let (loc, { expression; comments }) = key in + let expression' = this#expression expression in + let comments' = this#syntax_opt comments in + if expression == expression' && comments == comments' then + key + else + (loc, { expression = expression'; comments = comments' }) + + method import _loc (expr : ('loc, 'loc) Ast.Expression.Import.t) = + let open Ast.Expression.Import in + let { argument; comments } = expr in + let argument' = this#expression argument in + let comments' = this#syntax_opt comments in + if argument == argument' && comments == comments' then + expr + else + { argument = argument'; comments = comments' } + + method if_consequent_statement ~has_else (stmt : ('loc, 'loc) Ast.Statement.t) = + ignore has_else; + this#statement stmt + + method if_alternate_statement _loc (altern : ('loc, 'loc) Ast.Statement.If.Alternate.t') = + let open Ast.Statement.If.Alternate in + let { body; comments } = altern in + let body' = this#statement body in + let comments' = this#syntax_opt comments in + if body == body' && comments == comments' then + altern + else + { body = body'; comments = comments' } + + method if_statement _loc (stmt : ('loc, 'loc) Ast.Statement.If.t) = + let open Ast.Statement.If in + let { test; consequent; alternate; comments } = stmt in + let test' = this#predicate_expression test in + let consequent' = this#if_consequent_statement ~has_else:(alternate <> None) consequent in + let alternate' = map_opt (map_loc this#if_alternate_statement) alternate in + let comments' = this#syntax_opt comments in + if + test == test' + && consequent == consequent' + && alternate == alternate' + && comments == comments' + then + stmt + else + { test = test'; consequent = consequent'; alternate = alternate'; comments = comments' } + + method import_declaration _loc (decl : ('loc, 'loc) Ast.Statement.ImportDeclaration.t) = + let open Ast.Statement.ImportDeclaration in + let { import_kind; source; specifiers; default; comments } = decl in + let specifiers' = map_opt (this#import_specifier ~import_kind) specifiers in + let default' = map_opt (this#import_default_specifier ~import_kind) default in + let comments' = this#syntax_opt comments in + if specifiers == specifiers' && default == default' && comments == comments' then + decl + else + { import_kind; source; specifiers = specifiers'; default = default'; comments = comments' } + + method import_specifier + ~import_kind (specifier : ('loc, 'loc) Ast.Statement.ImportDeclaration.specifier) = + let open Ast.Statement.ImportDeclaration in + match specifier with + | ImportNamedSpecifiers named_specifiers -> + let named_specifiers' = + map_list (this#import_named_specifier ~import_kind) named_specifiers + in + if named_specifiers == named_specifiers' then + specifier + else + ImportNamedSpecifiers named_specifiers' + | ImportNamespaceSpecifier (loc, ident) -> + id_loc (this#import_namespace_specifier ~import_kind) loc ident specifier (fun ident -> + ImportNamespaceSpecifier (loc, ident) + ) + + method import_named_specifier + ~(import_kind : Ast.Statement.ImportDeclaration.import_kind) + (specifier : ('loc, 'loc) Ast.Statement.ImportDeclaration.named_specifier) = + let open Ast.Statement.ImportDeclaration in + let { kind; local; remote } = specifier in + let (is_type_remote, is_type_local) = + match (import_kind, kind) with + | (ImportType, _) + | (_, Some ImportType) -> + (true, true) + | (ImportTypeof, _) + | (_, Some ImportTypeof) -> + (false, true) + | _ -> (false, false) + in + let remote' = + if is_type_remote then + this#type_identifier_reference remote + else + this#identifier remote + in + let local' = + match local with + | None -> None + | Some ident -> + let local_visitor = + if is_type_local then + this#binding_type_identifier + else + this#pattern_identifier ~kind:Ast.Statement.VariableDeclaration.Let + in + id local_visitor ident local (fun ident -> Some ident) + in + if local == local' && remote == remote' then + specifier + else + { kind; local = local'; remote = remote' } + + method import_default_specifier ~import_kind (id : ('loc, 'loc) Ast.Identifier.t) = + let open Ast.Statement.ImportDeclaration in + let local_visitor = + match import_kind with + | ImportType + | ImportTypeof -> + this#binding_type_identifier + | _ -> this#pattern_identifier ~kind:Ast.Statement.VariableDeclaration.Let + in + local_visitor id + + method import_namespace_specifier ~import_kind _loc (id : ('loc, 'loc) Ast.Identifier.t) = + let open Ast.Statement.ImportDeclaration in + let local_visitor = + match import_kind with + | ImportType + | ImportTypeof -> + this#binding_type_identifier + | _ -> this#pattern_identifier ~kind:Ast.Statement.VariableDeclaration.Let + in + local_visitor id + + method jsx_element _loc (expr : ('loc, 'loc) Ast.JSX.element) = + let open Ast.JSX in + let { opening_element; closing_element; children; comments } = expr in + let opening_element' = this#jsx_opening_element opening_element in + let closing_element' = map_opt this#jsx_closing_element closing_element in + let children' = this#jsx_children children in + let comments' = this#syntax_opt comments in + if + opening_element == opening_element' + && closing_element == closing_element' + && children == children' + && comments == comments' + then + expr + else + { + opening_element = opening_element'; + closing_element = closing_element'; + children = children'; + comments = comments'; + } + + method jsx_fragment _loc (expr : ('loc, 'loc) Ast.JSX.fragment) = + let open Ast.JSX in + let { frag_children; frag_comments; _ } = expr in + let children' = this#jsx_children frag_children in + let frag_comments' = this#syntax_opt frag_comments in + if frag_children == children' && frag_comments == frag_comments' then + expr + else + { expr with frag_children = children'; frag_comments = frag_comments' } + + method jsx_opening_element (elem : ('loc, 'loc) Ast.JSX.Opening.t) = + let open Ast.JSX.Opening in + let (loc, { name; self_closing; attributes }) = elem in + let name' = this#jsx_element_name name in + let attributes' = map_list this#jsx_opening_attribute attributes in + if name == name' && attributes == attributes' then + elem + else + (loc, { name = name'; self_closing; attributes = attributes' }) + + method jsx_closing_element (elem : ('loc, 'loc) Ast.JSX.Closing.t) = + let open Ast.JSX.Closing in + let (loc, { name }) = elem in + let name' = this#jsx_element_name name in + if name == name' then + elem + else + (loc, { name = name' }) + + method jsx_opening_attribute (jsx_attr : ('loc, 'loc) Ast.JSX.Opening.attribute) = + let open Ast.JSX.Opening in + match jsx_attr with + | Attribute attr -> id this#jsx_attribute attr jsx_attr (fun attr -> Attribute attr) + | SpreadAttribute (loc, attr) -> + id_loc this#jsx_spread_attribute loc attr jsx_attr (fun attr -> SpreadAttribute (loc, attr)) + + method jsx_spread_attribute _loc (attr : ('loc, 'loc) Ast.JSX.SpreadAttribute.t') = + let open Ast.JSX.SpreadAttribute in + let { argument; comments } = attr in + let argument' = this#expression argument in + let comments' = this#syntax_opt comments in + if argument == argument' && comments == comments' then + attr + else + { argument = argument'; comments = comments' } + + method jsx_attribute (attr : ('loc, 'loc) Ast.JSX.Attribute.t) = + let open Ast.JSX.Attribute in + let (loc, { name; value }) = attr in + let name' = this#jsx_attribute_name name in + let value' = map_opt this#jsx_attribute_value value in + if name == name' && value == value' then + attr + else + (loc, { name = name'; value = value' }) + + method jsx_attribute_name (name : ('loc, 'loc) Ast.JSX.Attribute.name) = + let open Ast.JSX.Attribute in + match name with + | Identifier ident -> + id this#jsx_attribute_name_identifier ident name (fun ident -> Identifier ident) + | NamespacedName ns -> + id this#jsx_attribute_name_namespaced ns name (fun ns -> NamespacedName ns) + + method jsx_attribute_name_identifier ident = this#jsx_identifier ident + + method jsx_attribute_name_namespaced ns = this#jsx_namespaced_name ns + + method jsx_attribute_value (value : ('loc, 'loc) Ast.JSX.Attribute.value) = + let open Ast.JSX.Attribute in + match value with + | Literal (loc, lit) -> + id_loc this#jsx_attribute_value_literal loc lit value (fun lit -> Literal (loc, lit)) + | ExpressionContainer (loc, expr) -> + id_loc this#jsx_attribute_value_expression loc expr value (fun expr -> + ExpressionContainer (loc, expr) + ) + + method jsx_attribute_value_expression loc (jsx_expr : ('loc, 'loc) Ast.JSX.ExpressionContainer.t) + = + this#jsx_expression loc jsx_expr + + method jsx_attribute_value_literal loc (lit : 'loc Ast.Literal.t) = this#literal loc lit + + method jsx_children ((loc, children) as orig : 'loc * ('loc, 'loc) Ast.JSX.child list) = + let children' = map_list this#jsx_child children in + if children == children' then + orig + else + (loc, children') + + method jsx_child (child : ('loc, 'loc) Ast.JSX.child) = + let open Ast.JSX in + match child with + | (loc, Element elem) -> + id_loc this#jsx_element loc elem child (fun elem -> (loc, Element elem)) + | (loc, Fragment frag) -> + id_loc this#jsx_fragment loc frag child (fun frag -> (loc, Fragment frag)) + | (loc, ExpressionContainer expr) -> + id_loc this#jsx_expression loc expr child (fun expr -> (loc, ExpressionContainer expr)) + | (loc, SpreadChild spread) -> + id this#jsx_spread_child spread child (fun spread -> (loc, SpreadChild spread)) + | (_loc, Text _) -> child + + method jsx_expression _loc (jsx_expr : ('loc, 'loc) Ast.JSX.ExpressionContainer.t) = + let open Ast.JSX.ExpressionContainer in + let { expression; comments } = jsx_expr in + let comments' = this#syntax_opt comments in + match expression with + | Expression expr -> + let expr' = this#expression expr in + if expr == expr' && comments == comments' then + jsx_expr + else + { expression = Expression expr'; comments = comments' } + | EmptyExpression -> + if comments == comments' then + jsx_expr + else + { expression = EmptyExpression; comments = comments' } + + method jsx_spread_child (jsx_spread_child : ('loc, 'loc) Ast.JSX.SpreadChild.t) = + let open Ast.JSX.SpreadChild in + let { expression; comments } = jsx_spread_child in + let expression' = this#expression expression in + let comments' = this#syntax_opt comments in + if expression == expression' && comments == comments' then + jsx_spread_child + else + { expression = expression'; comments = comments' } + + method jsx_element_name (name : ('loc, 'loc) Ast.JSX.name) = + let open Ast.JSX in + match name with + | Identifier ident -> + id this#jsx_element_name_identifier ident name (fun ident -> Identifier ident) + | NamespacedName ns -> + id this#jsx_element_name_namespaced ns name (fun ns -> NamespacedName ns) + | MemberExpression expr -> + id this#jsx_element_name_member_expression expr name (fun expr -> MemberExpression expr) + + method jsx_element_name_identifier ident = this#jsx_identifier ident + + method jsx_element_name_namespaced ns = this#jsx_namespaced_name ns + + method jsx_element_name_member_expression expr = this#jsx_member_expression expr + + method jsx_namespaced_name (namespaced_name : ('loc, 'loc) Ast.JSX.NamespacedName.t) = + let open Ast.JSX in + NamespacedName.( + let (loc, { namespace; name }) = namespaced_name in + let namespace' = this#jsx_identifier namespace in + let name' = this#jsx_identifier name in + if namespace == namespace' && name == name' then + namespaced_name + else + (loc, { namespace = namespace'; name = name' }) + ) + + method jsx_member_expression (member_exp : ('loc, 'loc) Ast.JSX.MemberExpression.t) = + let open Ast.JSX in + let (loc, { MemberExpression._object; MemberExpression.property }) = member_exp in + let _object' = this#jsx_member_expression_object _object in + let property' = this#jsx_identifier property in + if _object == _object' && property == property' then + member_exp + else + (loc, MemberExpression.{ _object = _object'; property = property' }) + + method jsx_member_expression_object (_object : ('loc, 'loc) Ast.JSX.MemberExpression._object) = + let open Ast.JSX.MemberExpression in + match _object with + | Identifier ident -> + id this#jsx_member_expression_identifier ident _object (fun ident -> Identifier ident) + | MemberExpression nested_exp -> + id this#jsx_member_expression nested_exp _object (fun exp -> MemberExpression exp) + + method jsx_member_expression_identifier ident = this#jsx_element_name_identifier ident + + method jsx_identifier (id : ('loc, 'loc) Ast.JSX.Identifier.t) = + let open Ast.JSX.Identifier in + let (loc, { name; comments }) = id in + let comments' = this#syntax_opt comments in + if comments == comments' then + id + else + (loc, { name; comments = comments' }) + + method labeled_statement _loc (stmt : ('loc, 'loc) Ast.Statement.Labeled.t) = + let open Ast.Statement.Labeled in + let { label; body; comments } = stmt in + let label' = this#label_identifier label in + let body' = this#statement body in + let comments' = this#syntax_opt comments in + if label == label' && body == body' && comments == comments' then + stmt + else + { label = label'; body = body'; comments = comments' } + + method literal _loc (expr : 'loc Ast.Literal.t) = + let open Ast.Literal in + let { value; raw; comments } = expr in + let comments' = this#syntax_opt comments in + if comments == comments' then + expr + else + { value; raw; comments = comments' } + + method logical _loc (expr : ('loc, 'loc) Ast.Expression.Logical.t) = + let open Ast.Expression.Logical in + let { operator = _; left; right; comments } = expr in + let left' = this#expression left in + let right' = this#expression right in + let comments' = this#syntax_opt comments in + if left == left' && right == right' && comments == comments' then + expr + else + { expr with left = left'; right = right'; comments = comments' } + + method member _loc (expr : ('loc, 'loc) Ast.Expression.Member.t) = + let open Ast.Expression.Member in + let { _object; property; comments } = expr in + let _object' = this#expression _object in + let property' = this#member_property property in + let comments' = this#syntax_opt comments in + if _object == _object' && property == property' && comments == comments' then + expr + else + { _object = _object'; property = property'; comments = comments' } + + method optional_member loc (expr : ('loc, 'loc) Ast.Expression.OptionalMember.t) = + let open Ast.Expression.OptionalMember in + let { member; optional = _ } = expr in + let member' = this#member loc member in + if member == member' then + expr + else + { expr with member = member' } + + method member_property (expr : ('loc, 'loc) Ast.Expression.Member.property) = + let open Ast.Expression.Member in + match expr with + | PropertyIdentifier ident -> + id this#member_property_identifier ident expr (fun ident -> PropertyIdentifier ident) + | PropertyPrivateName ident -> + id this#member_private_name ident expr (fun ident -> PropertyPrivateName ident) + | PropertyExpression e -> + id this#member_property_expression e expr (fun e -> PropertyExpression e) + + method member_property_identifier (ident : ('loc, 'loc) Ast.Identifier.t) = + this#identifier ident + + method member_private_name (name : 'loc Ast.PrivateName.t) = this#private_name name + + method member_property_expression (expr : ('loc, 'loc) Ast.Expression.t) = this#expression expr + + method meta_property _loc (expr : 'loc Ast.Expression.MetaProperty.t) = + let open Ast.Expression.MetaProperty in + let { meta; property; comments } = expr in + let meta' = this#identifier meta in + let property' = this#identifier property in + let comments' = this#syntax_opt comments in + if meta == meta' && property == property' && comments == comments' then + expr + else + { meta = meta'; property = property'; comments = comments' } + + method new_ _loc (expr : ('loc, 'loc) Ast.Expression.New.t) = + let open Ast.Expression.New in + let { callee; targs; arguments; comments } = expr in + let callee' = this#expression callee in + let targs' = map_opt this#call_type_args targs in + let arguments' = map_opt this#call_arguments arguments in + let comments' = this#syntax_opt comments in + if callee == callee' && targs == targs' && arguments == arguments' && comments == comments' + then + expr + else + { callee = callee'; targs = targs'; arguments = arguments'; comments = comments' } + + method object_ _loc (expr : ('loc, 'loc) Ast.Expression.Object.t) = + let open Ast.Expression.Object in + let { properties; comments } = expr in + let properties' = + map_list + (fun prop -> + match prop with + | Property p -> + let p' = this#object_property p in + if p == p' then + prop + else + Property p' + | SpreadProperty s -> + let s' = this#spread_property s in + if s == s' then + prop + else + SpreadProperty s') + properties + in + let comments' = this#syntax_opt comments in + if properties == properties' && comments == comments' then + expr + else + { properties = properties'; comments = comments' } + + method object_property (prop : ('loc, 'loc) Ast.Expression.Object.Property.t) = + let open Ast.Expression.Object.Property in + match prop with + | (loc, Init { key; value; shorthand }) -> + let key' = this#object_key key in + let value' = this#expression value in + let shorthand' = + (* Try to figure out if shorthand should still be true--if + key and value change differently, it should become false *) + shorthand + && + match (key', value') with + | ( Identifier (_, { Ast.Identifier.name = key_name; _ }), + (_, Ast.Expression.Identifier (_, { Ast.Identifier.name = value_name; _ })) + ) -> + String.equal key_name value_name + | _ -> key == key' && value == value' + in + if key == key' && value == value' && shorthand == shorthand' then + prop + else + (loc, Init { key = key'; value = value'; shorthand = shorthand' }) + | (loc, Method { key; value = fn }) -> + let key' = this#object_key key in + let fn' = map_loc this#function_expression_or_method fn in + if key == key' && fn == fn' then + prop + else + (loc, Method { key = key'; value = fn' }) + | (loc, Get { key; value = fn; comments }) -> + let key' = this#object_key key in + let fn' = map_loc this#function_expression_or_method fn in + let comments' = this#syntax_opt comments in + if key == key' && fn == fn' && comments == comments' then + prop + else + (loc, Get { key = key'; value = fn'; comments = comments' }) + | (loc, Set { key; value = fn; comments }) -> + let key' = this#object_key key in + let fn' = map_loc this#function_expression_or_method fn in + let comments' = this#syntax_opt comments in + if key == key' && fn == fn' && comments == comments' then + prop + else + (loc, Set { key = key'; value = fn'; comments = comments' }) + + method object_key (key : ('loc, 'loc) Ast.Expression.Object.Property.key) = + let open Ast.Expression.Object.Property in + match key with + | Literal literal -> id this#object_key_literal literal key (fun lit -> Literal lit) + | Identifier ident -> id this#object_key_identifier ident key (fun ident -> Identifier ident) + | PrivateName ident -> id this#private_name ident key (fun ident -> PrivateName ident) + | Computed computed -> id this#object_key_computed computed key (fun expr -> Computed expr) + + method object_key_literal (literal : 'loc * 'loc Ast.Literal.t) = + let (loc, lit) = literal in + id_loc this#literal loc lit literal (fun lit -> (loc, lit)) + + method object_key_identifier (ident : ('loc, 'loc) Ast.Identifier.t) = this#identifier ident + + method object_key_computed (key : ('loc, 'loc) Ast.ComputedKey.t) = this#computed_key key + + method opaque_type _loc (otype : ('loc, 'loc) Ast.Statement.OpaqueType.t) = + let open Ast.Statement.OpaqueType in + let { id; tparams; impltype; supertype; comments } = otype in + let id' = this#binding_type_identifier id in + let tparams' = map_opt this#type_params tparams in + let impltype' = map_opt this#type_ impltype in + let supertype' = map_opt this#type_ supertype in + let comments' = this#syntax_opt comments in + if + id == id' + && impltype == impltype' + && tparams == tparams' + && impltype == impltype' + && supertype == supertype' + && comments == comments' + then + otype + else + { + id = id'; + tparams = tparams'; + impltype = impltype'; + supertype = supertype'; + comments = comments'; + } + + method function_param_pattern (expr : ('loc, 'loc) Ast.Pattern.t) = + this#binding_pattern ~kind:Ast.Statement.VariableDeclaration.Let expr + + method variable_declarator_pattern ~kind (expr : ('loc, 'loc) Ast.Pattern.t) = + this#binding_pattern ~kind expr + + method catch_clause_pattern (expr : ('loc, 'loc) Ast.Pattern.t) = + this#binding_pattern ~kind:Ast.Statement.VariableDeclaration.Let expr + + method for_in_assignment_pattern (expr : ('loc, 'loc) Ast.Pattern.t) = + this#assignment_pattern expr + + method for_of_assignment_pattern (expr : ('loc, 'loc) Ast.Pattern.t) = + this#assignment_pattern expr + + method binding_pattern + ?(kind = Ast.Statement.VariableDeclaration.Var) (expr : ('loc, 'loc) Ast.Pattern.t) = + this#pattern ~kind expr + + method assignment_pattern (expr : ('loc, 'loc) Ast.Pattern.t) = this#pattern expr + + (* NOTE: Patterns are highly overloaded. A pattern can be a binding pattern, + which has a kind (Var/Let/Const, with Var being the default for all pre-ES5 + bindings), or an assignment pattern, which has no kind. Subterms that are + patterns inherit the kind (or lack thereof). *) + method pattern ?kind (expr : ('loc, 'loc) Ast.Pattern.t) = + let open Ast.Pattern in + let (loc, patt) = expr in + let patt' = + match patt with + | Object { Object.properties; annot; comments } -> + let properties' = map_list (this#pattern_object_p ?kind) properties in + let annot' = this#type_annotation_hint annot in + let comments' = this#syntax_opt comments in + if properties' == properties && annot' == annot && comments' == comments then + patt + else + Object { Object.properties = properties'; annot = annot'; comments = comments' } + | Array { Array.elements; annot; comments } -> + let elements' = map_list (this#pattern_array_e ?kind) elements in + let annot' = this#type_annotation_hint annot in + let comments' = this#syntax_opt comments in + if comments == comments' && elements' == elements && annot' == annot then + patt + else + Array { Array.elements = elements'; annot = annot'; comments = comments' } + | Identifier { Identifier.name; annot; optional } -> + let name' = this#pattern_identifier ?kind name in + let annot' = this#type_annotation_hint annot in + if name == name' && annot == annot' then + patt + else + Identifier { Identifier.name = name'; annot = annot'; optional } + | Expression e -> id this#pattern_expression e patt (fun e -> Expression e) + in + if patt == patt' then + expr + else + (loc, patt') + + method pattern_identifier ?kind (ident : ('loc, 'loc) Ast.Identifier.t) = + ignore kind; + this#identifier ident + + method pattern_literal ?kind loc (expr : 'loc Ast.Literal.t) = + ignore kind; + this#literal loc expr + + method pattern_object_p ?kind (p : ('loc, 'loc) Ast.Pattern.Object.property) = + let open Ast.Pattern.Object in + match p with + | Property prop -> id (this#pattern_object_property ?kind) prop p (fun prop -> Property prop) + | RestElement prop -> + id (this#pattern_object_rest_property ?kind) prop p (fun prop -> RestElement prop) + + method pattern_object_property ?kind (prop : ('loc, 'loc) Ast.Pattern.Object.Property.t) = + let open Ast.Pattern.Object.Property in + let (loc, { key; pattern; default; shorthand }) = prop in + let key' = this#pattern_object_property_key ?kind key in + let pattern' = this#pattern_object_property_pattern ?kind pattern in + let default' = map_opt this#expression default in + let shorthand' = + (* Try to figure out if shorthand should still be true--if + key and value change differently, it should become false *) + shorthand + && + match (key', pattern') with + | ( Identifier (_, { Ast.Identifier.name = key_name; _ }), + ( _, + Ast.Pattern.Identifier + { Ast.Pattern.Identifier.name = (_, { Ast.Identifier.name = value_name; _ }); _ } + ) + ) -> + String.equal key_name value_name + | _ -> key == key' && pattern == pattern' + in + if key' == key && pattern' == pattern && default' == default && shorthand == shorthand' then + prop + else + (loc, { key = key'; pattern = pattern'; default = default'; shorthand = shorthand' }) + + method pattern_object_property_key ?kind (key : ('loc, 'loc) Ast.Pattern.Object.Property.key) = + let open Ast.Pattern.Object.Property in + match key with + | Literal lit -> + id (this#pattern_object_property_literal_key ?kind) lit key (fun lit' -> Literal lit') + | Identifier identifier -> + id (this#pattern_object_property_identifier_key ?kind) identifier key (fun id' -> + Identifier id' + ) + | Computed expr -> + id (this#pattern_object_property_computed_key ?kind) expr key (fun expr' -> Computed expr') + + method pattern_object_property_literal_key ?kind (literal : 'loc * 'loc Ast.Literal.t) = + let (loc, key) = literal in + id_loc (this#pattern_literal ?kind) loc key literal (fun key' -> (loc, key')) + + method pattern_object_property_identifier_key ?kind (key : ('loc, 'loc) Ast.Identifier.t) = + this#pattern_identifier ?kind key + + method pattern_object_property_computed_key ?kind (key : ('loc, 'loc) Ast.ComputedKey.t) = + ignore kind; + this#computed_key key + + method pattern_object_rest_property ?kind (prop : ('loc, 'loc) Ast.Pattern.RestElement.t) = + let open Ast.Pattern.RestElement in + let (loc, { argument; comments }) = prop in + let argument' = this#pattern_object_rest_property_pattern ?kind argument in + let comments' = this#syntax_opt comments in + if argument' == argument && comments == comments' then + prop + else + (loc, { argument = argument'; comments = comments' }) + + method pattern_object_property_pattern ?kind (expr : ('loc, 'loc) Ast.Pattern.t) = + this#pattern ?kind expr + + method pattern_object_rest_property_pattern ?kind (expr : ('loc, 'loc) Ast.Pattern.t) = + this#pattern ?kind expr + + method pattern_array_e ?kind (e : ('loc, 'loc) Ast.Pattern.Array.element) = + let open Ast.Pattern.Array in + match e with + | Hole _ -> e + | Element elem -> id (this#pattern_array_element ?kind) elem e (fun elem -> Element elem) + | RestElement elem -> + id (this#pattern_array_rest_element ?kind) elem e (fun elem -> RestElement elem) + + method pattern_array_element ?kind (elem : ('loc, 'loc) Ast.Pattern.Array.Element.t) = + let open Ast.Pattern.Array.Element in + let (loc, { argument; default }) = elem in + let argument' = this#pattern_array_element_pattern ?kind argument in + let default' = map_opt this#expression default in + if argument == argument' && default == default' then + elem + else + (loc, { argument = argument'; default = default' }) + + method pattern_array_element_pattern ?kind (patt : ('loc, 'loc) Ast.Pattern.t) = + this#pattern ?kind patt + + method pattern_array_rest_element ?kind (elem : ('loc, 'loc) Ast.Pattern.RestElement.t) = + let open Ast.Pattern.RestElement in + let (loc, { argument; comments }) = elem in + let argument' = this#pattern_array_rest_element_pattern ?kind argument in + let comments' = this#syntax_opt comments in + if argument' == argument && comments == comments' then + elem + else + (loc, { argument = argument'; comments = comments' }) + + method pattern_array_rest_element_pattern ?kind (expr : ('loc, 'loc) Ast.Pattern.t) = + this#pattern ?kind expr + + method pattern_assignment_pattern ?kind (expr : ('loc, 'loc) Ast.Pattern.t) = + this#pattern ?kind expr + + method pattern_expression (expr : ('loc, 'loc) Ast.Expression.t) = this#expression expr + + method predicate (pred : ('loc, 'loc) Ast.Type.Predicate.t) = + let open Ast.Type.Predicate in + let (loc, { kind; comments }) = pred in + let kind' = + match kind with + | Inferred -> kind + | Declared expr -> id this#expression expr kind (fun expr' -> Declared expr') + in + let comments' = this#syntax_opt comments in + if kind == kind' && comments == comments' then + pred + else + (loc, { kind = kind'; comments = comments' }) + + method predicate_expression (expr : ('loc, 'loc) Ast.Expression.t) = this#expression expr + + method function_rest_param (expr : ('loc, 'loc) Ast.Function.RestParam.t) = + let open Ast.Function.RestParam in + let (loc, { argument; comments }) = expr in + let argument' = this#function_param_pattern argument in + let comments' = this#syntax_opt comments in + if argument == argument' && comments == comments' then + expr + else + (loc, { argument = argument'; comments = comments' }) + + method return _loc (stmt : ('loc, 'loc) Ast.Statement.Return.t) = + let open Ast.Statement.Return in + let { argument; comments } = stmt in + let argument' = map_opt this#expression argument in + let comments' = this#syntax_opt comments in + if argument == argument' && comments == comments' then + stmt + else + { argument = argument'; comments = comments' } + + method sequence _loc (expr : ('loc, 'loc) Ast.Expression.Sequence.t) = + let open Ast.Expression.Sequence in + let { expressions; comments } = expr in + let expressions' = map_list this#expression expressions in + let comments' = this#syntax_opt comments in + if expressions == expressions' && comments == comments' then + expr + else + { expressions = expressions'; comments = comments' } + + method toplevel_statement_list (stmts : ('loc, 'loc) Ast.Statement.t list) = + this#statement_list stmts + + method statement_list (stmts : ('loc, 'loc) Ast.Statement.t list) = + map_list_multiple this#statement_fork_point stmts + + method statement_fork_point (stmt : ('loc, 'loc) Ast.Statement.t) = [this#statement stmt] + + method spread_element (expr : ('loc, 'loc) Ast.Expression.SpreadElement.t) = + let open Ast.Expression.SpreadElement in + let (loc, { argument; comments }) = expr in + let argument' = this#expression argument in + let comments' = this#syntax_opt comments in + if argument == argument' && comments == comments' then + expr + else + (loc, { argument = argument'; comments = comments' }) + + method spread_property (expr : ('loc, 'loc) Ast.Expression.Object.SpreadProperty.t) = + let open Ast.Expression.Object.SpreadProperty in + let (loc, { argument; comments }) = expr in + let argument' = this#expression argument in + let comments' = this#syntax_opt comments in + if argument == argument' && comments == comments' then + expr + else + (loc, { argument = argument'; comments = comments' }) + + method super_expression _loc (expr : 'loc Ast.Expression.Super.t) = + let open Ast.Expression.Super in + let { comments } = expr in + let comments' = this#syntax_opt comments in + if comments == comments' then + expr + else + { comments = comments' } + + method switch _loc (switch : ('loc, 'loc) Ast.Statement.Switch.t) = + let open Ast.Statement.Switch in + let { discriminant; cases; comments } = switch in + let discriminant' = this#expression discriminant in + let cases' = map_list this#switch_case cases in + let comments' = this#syntax_opt comments in + if discriminant == discriminant' && cases == cases' && comments == comments' then + switch + else + { discriminant = discriminant'; cases = cases'; comments = comments' } + + method switch_case (case : ('loc, 'loc) Ast.Statement.Switch.Case.t) = + let open Ast.Statement.Switch.Case in + let (loc, { test; consequent; comments }) = case in + let test' = map_opt this#expression test in + let consequent' = this#statement_list consequent in + let comments' = this#syntax_opt comments in + if test == test' && consequent == consequent' && comments == comments' then + case + else + (loc, { test = test'; consequent = consequent'; comments = comments' }) + + method tagged_template _loc (expr : ('loc, 'loc) Ast.Expression.TaggedTemplate.t) = + let open Ast.Expression.TaggedTemplate in + let { tag; quasi; comments } = expr in + let tag' = this#expression tag in + let quasi' = map_loc this#template_literal quasi in + let comments' = this#syntax_opt comments in + if tag == tag' && quasi == quasi' && comments == comments' then + expr + else + { tag = tag'; quasi = quasi'; comments = comments' } + + method template_literal _loc (expr : ('loc, 'loc) Ast.Expression.TemplateLiteral.t) = + let open Ast.Expression.TemplateLiteral in + let { quasis; expressions; comments } = expr in + let quasis' = map_list this#template_literal_element quasis in + let expressions' = map_list this#expression expressions in + let comments' = this#syntax_opt comments in + if quasis == quasis' && expressions == expressions' && comments == comments' then + expr + else + { quasis = quasis'; expressions = expressions'; comments = comments' } + + (* TODO *) + method template_literal_element (elem : 'loc Ast.Expression.TemplateLiteral.Element.t) = elem + + method this_expression _loc (expr : 'loc Ast.Expression.This.t) = + let open Ast.Expression.This in + let { comments } = expr in + let comments' = this#syntax_opt comments in + if comments == comments' then + expr + else + { comments = comments' } + + method throw _loc (stmt : ('loc, 'loc) Ast.Statement.Throw.t) = + let open Ast.Statement.Throw in + let { argument; comments } = stmt in + let argument' = this#expression argument in + let comments' = this#syntax_opt comments in + if argument == argument' && comments == comments' then + stmt + else + { argument = argument'; comments = comments' } + + method try_catch _loc (stmt : ('loc, 'loc) Ast.Statement.Try.t) = + let open Ast.Statement.Try in + let { block; handler; finalizer; comments } = stmt in + let block' = map_loc this#block block in + let handler' = + match handler with + | Some (loc, clause) -> + id_loc this#catch_clause loc clause handler (fun clause -> Some (loc, clause)) + | None -> handler + in + let finalizer' = + match finalizer with + | Some (finalizer_loc, block) -> + id_loc this#block finalizer_loc block finalizer (fun block -> Some (finalizer_loc, block)) + | None -> finalizer + in + let comments' = this#syntax_opt comments in + if block == block' && handler == handler' && finalizer == finalizer' && comments == comments' + then + stmt + else + { block = block'; handler = handler'; finalizer = finalizer'; comments = comments' } + + method type_cast _loc (expr : ('loc, 'loc) Ast.Expression.TypeCast.t) = + let open Ast.Expression.TypeCast in + let { expression; annot; comments } = expr in + let expression' = this#expression expression in + let annot' = this#type_annotation annot in + let comments' = this#syntax_opt comments in + if expression' == expression && annot' == annot && comments' == comments then + expr + else + { expression = expression'; annot = annot'; comments = comments' } + + method unary_expression _loc (expr : ('loc, 'loc) Flow_ast.Expression.Unary.t) = + let open Flow_ast.Expression.Unary in + let { argument; operator = _; comments } = expr in + let argument' = this#expression argument in + let comments' = this#syntax_opt comments in + if argument == argument' && comments == comments' then + expr + else + { expr with argument = argument'; comments = comments' } + + method update_expression _loc (expr : ('loc, 'loc) Ast.Expression.Update.t) = + let open Ast.Expression.Update in + let { argument; operator = _; prefix = _; comments } = expr in + let argument' = this#expression argument in + let comments' = this#syntax_opt comments in + if argument == argument' && comments == comments' then + expr + else + { expr with argument = argument'; comments = comments' } + + method variable_declaration _loc (decl : ('loc, 'loc) Ast.Statement.VariableDeclaration.t) = + let open Ast.Statement.VariableDeclaration in + let { declarations; kind; comments } = decl in + let decls' = map_list (this#variable_declarator ~kind) declarations in + let comments' = this#syntax_opt comments in + if declarations == decls' && comments == comments' then + decl + else + { declarations = decls'; kind; comments = comments' } + + method variable_declarator + ~kind (decl : ('loc, 'loc) Ast.Statement.VariableDeclaration.Declarator.t) = + let open Ast.Statement.VariableDeclaration.Declarator in + let (loc, { id; init }) = decl in + let id' = this#variable_declarator_pattern ~kind id in + let init' = map_opt this#expression init in + if id == id' && init == init' then + decl + else + (loc, { id = id'; init = init' }) + + method while_ _loc (stuff : ('loc, 'loc) Ast.Statement.While.t) = + let open Ast.Statement.While in + let { test; body; comments } = stuff in + let test' = this#predicate_expression test in + let body' = this#statement body in + let comments' = this#syntax_opt comments in + if test == test' && body == body' && comments == comments' then + stuff + else + { test = test'; body = body'; comments = comments' } + + method with_ _loc (stuff : ('loc, 'loc) Ast.Statement.With.t) = + let open Ast.Statement.With in + let { _object; body; comments } = stuff in + let _object' = this#expression _object in + let body' = this#statement body in + let comments' = this#syntax_opt comments in + if _object == _object' && body == body' && comments == comments' then + stuff + else + { _object = _object'; body = body'; comments = comments' } + + method type_alias _loc (stuff : ('loc, 'loc) Ast.Statement.TypeAlias.t) = + let open Ast.Statement.TypeAlias in + let { id; tparams; right; comments } = stuff in + let id' = this#binding_type_identifier id in + let tparams' = map_opt this#type_params tparams in + let right' = this#type_ right in + let comments' = this#syntax_opt comments in + if id == id' && right == right' && tparams == tparams' && comments == comments' then + stuff + else + { id = id'; tparams = tparams'; right = right'; comments = comments' } + + method yield _loc (expr : ('loc, 'loc) Ast.Expression.Yield.t) = + let open Ast.Expression.Yield in + let { argument; delegate; comments } = expr in + let argument' = map_opt this#expression argument in + let comments' = this#syntax_opt comments in + if comments == comments' && argument == argument' then + expr + else + { argument = argument'; delegate; comments = comments' } + end + +let fold_program (mappers : 'a mapper list) ast = + List.fold_left (fun ast (m : 'a mapper) -> m#program ast) ast mappers diff --git a/flow/parser/flow_ast_utils.ml b/flow/parser/flow_ast_utils.ml new file mode 100644 index 0000000000..3a7f2c7989 --- /dev/null +++ b/flow/parser/flow_ast_utils.ml @@ -0,0 +1,248 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open Flow_ast + +type 'loc binding = 'loc * string + +type 'loc ident = 'loc * string [@@deriving show] + +type 'loc source = 'loc * string [@@deriving show] + +let rec fold_bindings_of_pattern = + Pattern.( + let property f acc = + Object.( + function + | Property (_, { Property.pattern = p; _ }) + | RestElement (_, { RestElement.argument = p; comments = _ }) -> + fold_bindings_of_pattern f acc p + ) + in + let element f acc = + Array.( + function + | Hole _ -> acc + | Element (_, { Element.argument = p; default = _ }) + | RestElement (_, { RestElement.argument = p; comments = _ }) -> + fold_bindings_of_pattern f acc p + ) + in + fun f acc -> function + | (_, Identifier { Identifier.name; _ }) -> f acc name + | (_, Object { Object.properties; _ }) -> List.fold_left (property f) acc properties + | (_, Array { Array.elements; _ }) -> List.fold_left (element f) acc elements + (* This is for assignment and default param destructuring `[a.b=1]=c`, ignore these for now. *) + | (_, Expression _) -> acc + ) + +let fold_bindings_of_variable_declarations f acc declarations = + let open Flow_ast.Statement.VariableDeclaration in + List.fold_left + (fun acc -> function + | (_, { Declarator.id = pattern; _ }) -> + let has_anno = + (* Only the toplevel annotation in a pattern is meaningful *) + let open Flow_ast.Pattern in + match pattern with + | (_, Array { Array.annot = Flow_ast.Type.Available _; _ }) + | (_, Object { Object.annot = Flow_ast.Type.Available _; _ }) + | (_, Identifier { Identifier.annot = Flow_ast.Type.Available _; _ }) -> + true + | _ -> false + in + fold_bindings_of_pattern (f has_anno) acc pattern) + acc + declarations + +let partition_directives statements = + let open Flow_ast.Statement in + let rec helper directives = function + | ((_, Expression { Expression.directive = Some _; _ }) as directive) :: rest -> + helper (directive :: directives) rest + | rest -> (List.rev directives, rest) + in + helper [] statements + +let negate_number_literal (value, raw) = + let raw_len = String.length raw in + let raw = + if raw_len > 0 && raw.[0] = '-' then + String.sub raw 1 (raw_len - 1) + else + "-" ^ raw + in + (~-.value, raw) + +let loc_of_statement = fst + +let loc_of_expression = fst + +let loc_of_pattern = fst + +let loc_of_ident = fst + +let name_of_ident (_, { Identifier.name; comments = _ }) = name + +let source_of_ident (loc, { Identifier.name; comments = _ }) = (loc, name) + +let ident_of_source ?comments (loc, name) = (loc, { Identifier.name; comments }) + +let mk_comments ?(leading = []) ?(trailing = []) a = { Syntax.leading; trailing; internal = a } + +let mk_comments_opt ?(leading = []) ?(trailing = []) () = + match (leading, trailing) with + | ([], []) -> None + | (_, _) -> Some (mk_comments ~leading ~trailing ()) + +let mk_comments_with_internal_opt ?(leading = []) ?(trailing = []) ~internal () = + match (leading, trailing, internal) with + | ([], [], []) -> None + | _ -> Some (mk_comments ~leading ~trailing internal) + +let merge_comments ~inner ~outer = + let open Syntax in + match (inner, outer) with + | (None, c) + | (c, None) -> + c + | (Some inner, Some outer) -> + mk_comments_opt + ~leading:(outer.leading @ inner.leading) + ~trailing:(inner.trailing @ outer.trailing) + () + +let merge_comments_with_internal ~inner ~outer = + match (inner, outer) with + | (inner, None) -> inner + | (None, Some { Syntax.leading; trailing; _ }) -> + mk_comments_with_internal_opt ~leading ~trailing ~internal:[] () + | ( Some { Syntax.leading = inner_leading; trailing = inner_trailing; internal }, + Some { Syntax.leading = outer_leading; trailing = outer_trailing; _ } + ) -> + mk_comments_with_internal_opt + ~leading:(outer_leading @ inner_leading) + ~trailing:(inner_trailing @ outer_trailing) + ~internal + () + +let split_comments comments = + match comments with + | None -> (None, None) + | Some { Syntax.leading; trailing; _ } -> + (mk_comments_opt ~leading (), mk_comments_opt ~trailing ()) + +let string_of_assignment_operator op = + let open Flow_ast.Expression.Assignment in + match op with + | PlusAssign -> "+=" + | MinusAssign -> "-=" + | MultAssign -> "*=" + | ExpAssign -> "**=" + | DivAssign -> "/=" + | ModAssign -> "%=" + | LShiftAssign -> "<<=" + | RShiftAssign -> ">>=" + | RShift3Assign -> ">>>=" + | BitOrAssign -> "|=" + | BitXorAssign -> "^=" + | BitAndAssign -> "&=" + +let string_of_binary_operator op = + let open Flow_ast.Expression.Binary in + match op with + | Equal -> "==" + | NotEqual -> "!=" + | StrictEqual -> "===" + | StrictNotEqual -> "!==" + | LessThan -> "<" + | LessThanEqual -> "<=" + | GreaterThan -> ">" + | GreaterThanEqual -> ">=" + | LShift -> "<<" + | RShift -> ">>" + | RShift3 -> ">>>" + | Plus -> "+" + | Minus -> "-" + | Mult -> "*" + | Exp -> "**" + | Div -> "/" + | Mod -> "%" + | BitOr -> "|" + | Xor -> "^" + | BitAnd -> "&" + | In -> "in" + | Instanceof -> "instanceof" + +module ExpressionSort = struct + type t = + | Array + | ArrowFunction + | Assignment + | Binary + | Call + | Class + | Comprehension + | Conditional + | Function + | Generator + | Identifier + | Import + | JSXElement + | JSXFragment + | Literal + | Logical + | Member + | MetaProperty + | New + | Object + | OptionalCall + | OptionalMember + | Sequence + | Super + | TaggedTemplate + | TemplateLiteral + | This + | TypeCast + | Unary + | Update + | Yield + [@@deriving show] + + let to_string = function + | Array -> "array" + | ArrowFunction -> "arrow function" + | Assignment -> "assignment expression" + | Binary -> "binary expression" + | Call -> "call expression" + | Class -> "class" + | Comprehension -> "comprehension expression" + | Conditional -> "conditional expression" + | Function -> "function" + | Generator -> "generator" + | Identifier -> "identifier" + | Import -> "import expression" + | JSXElement -> "JSX element" + | JSXFragment -> "JSX fragment" + | Literal -> "literal" + | Logical -> "logical expression" + | Member -> "member expression" + | MetaProperty -> "metaproperty expression" + | New -> "new expression" + | Object -> "object" + | OptionalCall -> "optional call expression" + | OptionalMember -> "optional member expression" + | Sequence -> "sequence" + | Super -> "`super` reference" + | TaggedTemplate -> "tagged template expression" + | TemplateLiteral -> "template literal" + | This -> "`this` reference" + | TypeCast -> "type cast" + | Unary -> "unary expression" + | Update -> "update expression" + | Yield -> "yield expression" +end diff --git a/flow/parser/flow_ast_utils.mli b/flow/parser/flow_ast_utils.mli new file mode 100644 index 0000000000..61fe717e78 --- /dev/null +++ b/flow/parser/flow_ast_utils.mli @@ -0,0 +1,117 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +type 'loc binding = 'loc * string + +type 'loc ident = 'loc * string [@@deriving show] + +type 'loc source = 'loc * string [@@deriving show] + +val fold_bindings_of_pattern : + ('a -> ('m, 't) Flow_ast.Identifier.t -> 'a) -> 'a -> ('m, 't) Flow_ast.Pattern.t -> 'a + +val fold_bindings_of_variable_declarations : + (bool -> 'a -> ('m, 't) Flow_ast.Identifier.t -> 'a) -> + 'a -> + ('m, 't) Flow_ast.Statement.VariableDeclaration.Declarator.t list -> + 'a + +val partition_directives : + (Loc.t, Loc.t) Flow_ast.Statement.t list -> + (Loc.t, Loc.t) Flow_ast.Statement.t list * (Loc.t, Loc.t) Flow_ast.Statement.t list + +val negate_number_literal : float * string -> float * string + +val loc_of_expression : ('a, 'a) Flow_ast.Expression.t -> 'a + +val loc_of_statement : ('a, 'a) Flow_ast.Statement.t -> 'a + +val loc_of_pattern : ('a, 'a) Flow_ast.Pattern.t -> 'a + +val loc_of_ident : ('a, 'a) Flow_ast.Identifier.t -> 'a + +val name_of_ident : ('loc, 'a) Flow_ast.Identifier.t -> string + +val source_of_ident : ('a, 'a) Flow_ast.Identifier.t -> 'a source + +val ident_of_source : + ?comments:('a, unit) Flow_ast.Syntax.t -> 'a source -> ('a, 'a) Flow_ast.Identifier.t + +val mk_comments : + ?leading:'loc Flow_ast.Comment.t list -> + ?trailing:'loc Flow_ast.Comment.t list -> + 'a -> + ('loc, 'a) Flow_ast.Syntax.t + +val mk_comments_opt : + ?leading:'loc Flow_ast.Comment.t list -> + ?trailing:'loc Flow_ast.Comment.t list -> + unit -> + ('loc, unit) Flow_ast.Syntax.t option + +val mk_comments_with_internal_opt : + ?leading:'loc Flow_ast.Comment.t list -> + ?trailing:'loc Flow_ast.Comment.t list -> + internal:'loc Flow_ast.Comment.t list -> + unit -> + ('loc, 'loc Flow_ast.Comment.t list) Flow_ast.Syntax.t option + +val merge_comments : + inner:('M, unit) Flow_ast.Syntax.t option -> + outer:('M, unit) Flow_ast.Syntax.t option -> + ('M, unit) Flow_ast.Syntax.t option + +val merge_comments_with_internal : + inner:('M, 'loc Flow_ast.Comment.t list) Flow_ast.Syntax.t option -> + outer:('M, 'a) Flow_ast.Syntax.t option -> + ('M, 'loc Flow_ast.Comment.t list) Flow_ast.Syntax.t option + +val split_comments : + ('loc, unit) Flow_ast.Syntax.t option -> + ('loc, unit) Flow_ast.Syntax.t option * ('loc, unit) Flow_ast.Syntax.t option + +module ExpressionSort : sig + type t = + | Array + | ArrowFunction + | Assignment + | Binary + | Call + | Class + | Comprehension + | Conditional + | Function + | Generator + | Identifier + | Import + | JSXElement + | JSXFragment + | Literal + | Logical + | Member + | MetaProperty + | New + | Object + | OptionalCall + | OptionalMember + | Sequence + | Super + | TaggedTemplate + | TemplateLiteral + | This + | TypeCast + | Unary + | Update + | Yield + [@@deriving show] + + val to_string : t -> string +end + +val string_of_assignment_operator : Flow_ast.Expression.Assignment.operator -> string + +val string_of_binary_operator : Flow_ast.Expression.Binary.operator -> string diff --git a/flow/parser/flow_lexer.ml b/flow/parser/flow_lexer.ml new file mode 100644 index 0000000000..f9da1be451 --- /dev/null +++ b/flow/parser/flow_lexer.ml @@ -0,0 +1,1871 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +[@@@warning "-39"] (* sedlex inserts some unnecessary `rec`s *) + +module Sedlexing = Flow_sedlexing +open Token +open Lex_env + +let lexeme = Sedlexing.Utf8.lexeme + +let lexeme_to_buffer = Sedlexing.Utf8.lexeme_to_buffer + +let lexeme_to_buffer2 = Sedlexing.Utf8.lexeme_to_buffer2 + +let sub_lexeme = Sedlexing.Utf8.sub_lexeme + +let letter = [%sedlex.regexp? 'a' .. 'z' | 'A' .. 'Z' | '$'] + +let id_letter = [%sedlex.regexp? letter | '_'] + +let digit = [%sedlex.regexp? '0' .. '9'] + +let digit_non_zero = [%sedlex.regexp? '1' .. '9'] + +let decintlit = [%sedlex.regexp? '0' | ('1' .. '9', Star digit)] + +(* DecimalIntegerLiteral *) + +let alphanumeric = [%sedlex.regexp? digit | letter] + +let word = [%sedlex.regexp? (letter, Star alphanumeric)] + +let hex_digit = [%sedlex.regexp? digit | 'a' .. 'f' | 'A' .. 'F'] + +let non_hex_letter = [%sedlex.regexp? 'g' .. 'z' | 'G' .. 'Z' | '$'] + +let bin_digit = [%sedlex.regexp? '0' | '1'] + +let oct_digit = [%sedlex.regexp? '0' .. '7'] + +(* This regex could be simplified to (digit Star (digit OR '_' digit)) + * That makes the underscore and failure cases faster, and the base case take x2-3 the steps + * As the codebase contains more base cases than underscored or errors, prefer this version *) +let underscored_bin = + [%sedlex.regexp? Plus bin_digit | (bin_digit, Star (bin_digit | ('_', bin_digit)))] + +let underscored_oct = + [%sedlex.regexp? Plus oct_digit | (oct_digit, Star (oct_digit | ('_', oct_digit)))] + +let underscored_hex = + [%sedlex.regexp? Plus hex_digit | (hex_digit, Star (hex_digit | ('_', hex_digit)))] + +let underscored_digit = [%sedlex.regexp? Plus digit | (digit_non_zero, Star (digit | ('_', digit)))] + +let underscored_decimal = [%sedlex.regexp? Plus digit | (digit, Star (digit | ('_', digit)))] + +(* Different ways you can write a number *) +let binnumber = [%sedlex.regexp? ('0', ('B' | 'b'), underscored_bin)] + +let octnumber = [%sedlex.regexp? ('0', ('O' | 'o'), underscored_oct)] + +let legacyoctnumber = [%sedlex.regexp? ('0', Plus oct_digit)] + +(* no underscores allowed *) + +let legacynonoctnumber = [%sedlex.regexp? ('0', Star oct_digit, '8' .. '9', Star digit)] + +let hexnumber = [%sedlex.regexp? ('0', ('X' | 'x'), underscored_hex)] + +let scinumber = + [%sedlex.regexp? + ( ((decintlit, Opt ('.', Opt underscored_decimal)) | ('.', underscored_decimal)), + ('e' | 'E'), + Opt ('-' | '+'), + underscored_digit + )] + +let wholenumber = [%sedlex.regexp? (underscored_digit, Opt '.')] + +let floatnumber = [%sedlex.regexp? (Opt underscored_digit, '.', underscored_decimal)] + +let binbigint = [%sedlex.regexp? (binnumber, 'n')] + +let octbigint = [%sedlex.regexp? (octnumber, 'n')] + +let hexbigint = [%sedlex.regexp? (hexnumber, 'n')] + +let scibigint = [%sedlex.regexp? (scinumber, 'n')] + +let wholebigint = [%sedlex.regexp? (underscored_digit, 'n')] + +let floatbigint = [%sedlex.regexp? ((floatnumber | (underscored_digit, '.')), 'n')] + +(* 2-8 alphanumeric characters. I could match them directly, but this leads to + * ~5k more lines of generated lexer + let htmlentity = "quot" | "amp" | "apos" | "lt" | "gt" | "nbsp" | "iexcl" + | "cent" | "pound" | "curren" | "yen" | "brvbar" | "sect" | "uml" | "copy" + | "ordf" | "laquo" | "not" | "shy" | "reg" | "macr" | "deg" | "plusmn" + | "sup2" | "sup3" | "acute" | "micro" | "para" | "middot" | "cedil" | "sup1" + | "ordm" | "raquo" | "frac14" | "frac12" | "frac34" | "iquest" | "Agrave" + | "Aacute" | "Acirc" | "Atilde" | "Auml" | "Aring" | "AElig" | "Ccedil" + | "Egrave" | "Eacute" | "Ecirc" | "Euml" | "Igrave" | "Iacute" | "Icirc" + | "Iuml" | "ETH" | "Ntilde" | "Ograve" | "Oacute" | "Ocirc" | "Otilde" + | "Ouml" | "times" | "Oslash" | "Ugrave" | "Uacute" | "Ucirc" | "Uuml" + | "Yacute" | "THORN" | "szlig" | "agrave" | "aacute" | "acirc" | "atilde" + | "auml" | "aring" | "aelig" | "ccedil" | "egrave" | "eacute" | "ecirc" + | "euml" | "igrave" | "iacute" | "icirc" | "iuml" | "eth" | "ntilde" + | "ograve" | "oacute" | "ocirc" | "otilde" | "ouml" | "divide" | "oslash" + | "ugrave" | "uacute" | "ucirc" | "uuml" | "yacute" | "thorn" | "yuml" + | "OElig" | "oelig" | "Scaron" | "scaron" | "Yuml" | "fnof" | "circ" | "tilde" + | "Alpha" | "Beta" | "Gamma" | "Delta" | "Epsilon" | "Zeta" | "Eta" | "Theta" + | "Iota" | "Kappa" | "Lambda" | "Mu" | "Nu" | "Xi" | "Omicron" | "Pi" | "Rho" + | "Sigma" | "Tau" | "Upsilon" | "Phi" | "Chi" | "Psi" | "Omega" | "alpha" + | "beta" | "gamma" | "delta" | "epsilon" | "zeta" | "eta" | "theta" | "iota" + | "kappa" | "lambda" | "mu" | "nu" | "xi" | "omicron" | "pi" | "rho" + | "sigmaf" | "sigma" | "tau" | "upsilon" | "phi" | "chi" | "psi" | "omega" + | "thetasym" | "upsih" | "piv" | "ensp" | "emsp" | "thinsp" | "zwnj" | "zwj" + | "lrm" | "rlm" | "ndash" | "mdash" | "lsquo" | "rsquo" | "sbquo" | "ldquo" + | "rdquo" | "bdquo" | "dagger" | "Dagger" | "bull" | "hellip" | "permil" + | "prime" | "Prime" | "lsaquo" | "rsaquo" | "oline" | "frasl" | "euro" + | "image" | "weierp" | "real" | "trade" | "alefsym" | "larr" | "uarr" | "rarr" + | "darr" | "harr" | "crarr" | "lArr" | "uArr" | "rArr" | "dArr" | "hArr" + | "forall" | "part" | "exist" | "empty" | "nabla" | "isin" | "notin" | "ni" + | "prod" | "sum" | "minus" | "lowast" | "radic" | "prop" | "infin" | "ang" + | "and" | "or" | "cap" | "cup" | "'int'" | "there4" | "sim" | "cong" | "asymp" + | "ne" | "equiv" | "le" | "ge" | "sub" | "sup" | "nsub" | "sube" | "supe" + | "oplus" | "otimes" | "perp" | "sdot" | "lceil" | "rceil" | "lfloor" + | "rfloor" | "lang" | "rang" | "loz" | "spades" | "clubs" | "hearts" | "diams" + *) +let htmlentity = + [%sedlex.regexp? + ( alphanumeric, + alphanumeric, + Opt alphanumeric, + Opt alphanumeric, + Opt alphanumeric, + Opt alphanumeric, + Opt alphanumeric, + Opt alphanumeric + )] + +(* https://tc39.github.io/ecma262/#sec-white-space *) +let whitespace = + [%sedlex.regexp? + ( 0x0009 | 0x000B | 0x000C | 0x0020 | 0x00A0 | 0xfeff | 0x1680 + | 0x2000 .. 0x200a + | 0x202f | 0x205f | 0x3000 )] + +(* minus sign in front of negative numbers + (only for types! regular numbers use T_MINUS!) *) +let neg = [%sedlex.regexp? ('-', Star whitespace)] + +let line_terminator_sequence = [%sedlex.regexp? '\n' | '\r' | "\r\n" | 0x2028 | 0x2029] + +let line_terminator_sequence_start = [%sedlex.regexp? '\n' | '\r' | 0x2028 | 0x2029] + +let hex_quad = [%sedlex.regexp? (hex_digit, hex_digit, hex_digit, hex_digit)] + +let unicode_escape = [%sedlex.regexp? ("\\u", hex_quad)] + +let codepoint_escape = [%sedlex.regexp? ("\\u{", Plus hex_digit, '}')] + +let js_id_start = [%sedlex.regexp? '$' | '_' | id_start | unicode_escape | codepoint_escape] + +let ascii_id_start = [%sedlex.regexp? '$' | '_' | 'a' .. 'z' | 'A' .. 'Z'] + +let ascii_id_continue = [%sedlex.regexp? '$' | '_' | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9'] + +let js_id_continue = + [%sedlex.regexp? '$' | '_' | 0x200C | 0x200D | id_continue | unicode_escape | codepoint_escape] + +let pos_at_offset env offset = + { Loc.line = Lex_env.line env; column = offset - Lex_env.bol_offset env } + +let loc_of_offsets env start_offset end_offset = + { + Loc.source = Lex_env.source env; + start = pos_at_offset env start_offset; + _end = pos_at_offset env end_offset; + } + +let start_pos_of_lexbuf env (lexbuf : Sedlexing.lexbuf) = + let start_offset = Sedlexing.lexeme_start lexbuf in + pos_at_offset env start_offset + +let end_pos_of_lexbuf env (lexbuf : Sedlexing.lexbuf) = + let end_offset = Sedlexing.lexeme_end lexbuf in + pos_at_offset env end_offset + +let loc_of_lexbuf env (lexbuf : Sedlexing.lexbuf) = + let start_offset = Sedlexing.lexeme_start lexbuf in + let end_offset = Sedlexing.lexeme_end lexbuf in + loc_of_offsets env start_offset end_offset + +let loc_of_token env lex_token = + match lex_token with + | T_STRING (loc, _, _, _) -> loc + | T_JSX_TEXT (loc, _, _) -> loc + | T_TEMPLATE_PART (loc, _, _) -> loc + | T_REGEXP (loc, _, _) -> loc + | _ -> loc_of_lexbuf env env.lex_lb + +let lex_error (env : Lex_env.t) loc err : Lex_env.t = + let lex_errors_acc = (loc, err) :: env.lex_state.lex_errors_acc in + { env with lex_state = { lex_errors_acc } } + +let unexpected_error (env : Lex_env.t) (loc : Loc.t) value = + lex_error env loc (Parse_error.Unexpected (quote_token_value value)) + +let unexpected_error_w_suggest (env : Lex_env.t) (loc : Loc.t) value suggest = + lex_error env loc (Parse_error.UnexpectedTokenWithSuggestion (value, suggest)) + +let illegal (env : Lex_env.t) (loc : Loc.t) = + lex_error env loc (Parse_error.Unexpected "token ILLEGAL") + +let new_line env lexbuf = + let offset = Sedlexing.lexeme_end lexbuf in + let lex_bol = { line = Lex_env.line env + 1; offset } in + { env with Lex_env.lex_bol } + +let bigint_strip_n raw = + let size = String.length raw in + let str = + if size != 0 && raw.[size - 1] == 'n' then + String.sub raw 0 (size - 1) + else + raw + in + str + +let mk_comment + (env : Lex_env.t) + (start : Loc.position) + (_end : Loc.position) + (buf : Buffer.t) + (multiline : bool) : Loc.t Flow_ast.Comment.t = + let open Flow_ast.Comment in + let loc = { Loc.source = Lex_env.source env; start; _end } in + let text = Buffer.contents buf in + let kind = + if multiline then + Block + else + Line + in + let on_newline = Loc.(env.lex_last_loc._end.Loc.line < loc.start.Loc.line) in + let c = { kind; text; on_newline } in + (loc, c) + +let mk_num_singleton number_type raw = + let (neg, num) = + if raw.[0] = '-' then + (true, String.sub raw 1 (String.length raw - 1)) + else + (false, raw) + in + (* convert singleton number type into a float *) + let value = + match number_type with + | LEGACY_OCTAL -> + begin + try Int64.to_float (Int64.of_string ("0o" ^ num)) with + | Failure _ -> failwith ("Invalid legacy octal " ^ num) + end + | BINARY + | OCTAL -> + begin + try Int64.to_float (Int64.of_string num) with + | Failure _ -> failwith ("Invalid binary/octal " ^ num) + end + | LEGACY_NON_OCTAL + | NORMAL -> + begin + try float_of_string num with + | Failure _ -> failwith ("Invalid number " ^ num) + end + in + let value = + if neg then + ~-.value + else + value + in + T_NUMBER_SINGLETON_TYPE { kind = number_type; value; raw } + +let mk_bignum_singleton kind raw = + let (neg, num) = + if raw.[0] = '-' then + (true, String.sub raw 1 (String.length raw - 1)) + else + (false, raw) + in + (* convert singleton number type into a float *) + let value = + match kind with + | BIG_BINARY + | BIG_OCTAL -> + let postraw = bigint_strip_n num in + begin + try Int64.to_float (Int64.of_string postraw) with + | Failure _ -> failwith ("Invalid (lexer) bigint binary/octal " ^ postraw) + end + | BIG_NORMAL -> + let postraw = bigint_strip_n num in + begin + try float_of_string postraw with + | Failure _ -> failwith ("Invalid (lexer) bigint " ^ postraw) + end + in + let approx_value = + if neg then + ~-.value + else + value + in + T_BIGINT_SINGLETON_TYPE { kind; approx_value; raw } + +let decode_identifier = + let assert_valid_unicode_in_identifier env loc code = + let lexbuf = Sedlexing.from_int_array [| code |] in + match%sedlex lexbuf with + | js_id_start -> env + | js_id_continue -> env + | any + | eof -> + lex_error env loc Parse_error.IllegalUnicodeEscape + | _ -> failwith "unreachable assert_valid_unicode_in_identifier" + in + let loc_and_sub_lexeme env offset lexbuf trim_start trim_end = + let start_offset = offset + Sedlexing.lexeme_start lexbuf in + let end_offset = offset + Sedlexing.lexeme_end lexbuf in + let loc = loc_of_offsets env start_offset end_offset in + (loc, sub_lexeme lexbuf trim_start (Sedlexing.lexeme_length lexbuf - trim_start - trim_end)) + in + let rec id_char env offset buf lexbuf = + match%sedlex lexbuf with + | unicode_escape -> + let (loc, hex) = loc_and_sub_lexeme env offset lexbuf 2 0 in + let code = int_of_string ("0x" ^ hex) in + let env = + if not (Uchar.is_valid code) then + lex_error env loc Parse_error.IllegalUnicodeEscape + else + assert_valid_unicode_in_identifier env loc code + in + Wtf8.add_wtf_8 buf code; + id_char env offset buf lexbuf + | codepoint_escape -> + let (loc, hex) = loc_and_sub_lexeme env offset lexbuf 3 1 in + let code = int_of_string ("0x" ^ hex) in + let env = assert_valid_unicode_in_identifier env loc code in + Wtf8.add_wtf_8 buf code; + id_char env offset buf lexbuf + | eof -> (env, Buffer.contents buf) + (* match multi-char substrings that don't contain the start chars of the above patterns *) + | Plus (Compl (eof | "\\")) + | any -> + lexeme_to_buffer lexbuf buf; + id_char env offset buf lexbuf + | _ -> failwith "unreachable id_char" + in + fun env raw -> + let offset = Sedlexing.lexeme_start env.lex_lb in + let lexbuf = Sedlexing.from_int_array raw in + let buf = Buffer.create (Array.length raw) in + id_char env offset buf lexbuf + +let recover env lexbuf ~f = + let env = illegal env (loc_of_lexbuf env lexbuf) in + Sedlexing.rollback lexbuf; + f env lexbuf + +type jsx_text_mode = + | JSX_SINGLE_QUOTED_TEXT + | JSX_DOUBLE_QUOTED_TEXT + | JSX_CHILD_TEXT + +type result = + | Token of Lex_env.t * Token.t + | Comment of Lex_env.t * Loc.t Flow_ast.Comment.t + | Continue of Lex_env.t + +let rec comment env buf lexbuf = + match%sedlex lexbuf with + | line_terminator_sequence -> + let env = new_line env lexbuf in + lexeme_to_buffer lexbuf buf; + comment env buf lexbuf + | "*/" -> + let env = + if is_in_comment_syntax env then + let loc = loc_of_lexbuf env lexbuf in + unexpected_error_w_suggest env loc "*/" "*-/" + else + env + in + (env, end_pos_of_lexbuf env lexbuf) + | "*-/" -> + if is_in_comment_syntax env then + (env, end_pos_of_lexbuf env lexbuf) + else ( + Buffer.add_string buf "*-/"; + comment env buf lexbuf + ) + (* match multi-char substrings that don't contain the start chars of the above patterns *) + | Plus (Compl (line_terminator_sequence_start | '*')) + | any -> + lexeme_to_buffer lexbuf buf; + comment env buf lexbuf + | _ -> + let env = illegal env (loc_of_lexbuf env lexbuf) in + (env, end_pos_of_lexbuf env lexbuf) + +let rec line_comment env buf lexbuf = + match%sedlex lexbuf with + | eof -> (env, end_pos_of_lexbuf env lexbuf) + | line_terminator_sequence -> + let { Loc.line; column } = end_pos_of_lexbuf env lexbuf in + let env = new_line env lexbuf in + let len = Sedlexing.lexeme_length lexbuf in + let end_pos = { Loc.line; column = column - len } in + (env, end_pos) + (* match multi-char substrings that don't contain the start chars of the above patterns *) + | Plus (Compl (eof | line_terminator_sequence_start)) + | any -> + lexeme_to_buffer lexbuf buf; + line_comment env buf lexbuf + | _ -> failwith "unreachable line_comment" + +let string_escape env lexbuf = + match%sedlex lexbuf with + | eof + | '\\' -> + let str = lexeme lexbuf in + let codes = Sedlexing.lexeme lexbuf in + (env, str, codes, false) + | ('x', hex_digit, hex_digit) -> + let str = lexeme lexbuf in + let code = int_of_string ("0" ^ str) in + (* 0xAB *) + (env, str, [| code |], false) + | ('0' .. '7', '0' .. '7', '0' .. '7') -> + let str = lexeme lexbuf in + let code = int_of_string ("0o" ^ str) in + (* 0o012 *) + (* If the 3 character octal code is larger than 256 + * then it is parsed as a 2 character octal code *) + if code < 256 then + (env, str, [| code |], true) + else + let remainder = code land 7 in + let code = code lsr 3 in + (env, str, [| code; Char.code '0' + remainder |], true) + | ('0' .. '7', '0' .. '7') -> + let str = lexeme lexbuf in + let code = int_of_string ("0o" ^ str) in + (* 0o01 *) + (env, str, [| code |], true) + | '0' -> (env, "0", [| 0x0 |], false) + | 'b' -> (env, "b", [| 0x8 |], false) + | 'f' -> (env, "f", [| 0xC |], false) + | 'n' -> (env, "n", [| 0xA |], false) + | 'r' -> (env, "r", [| 0xD |], false) + | 't' -> (env, "t", [| 0x9 |], false) + | 'v' -> (env, "v", [| 0xB |], false) + | '0' .. '7' -> + let str = lexeme lexbuf in + let code = int_of_string ("0o" ^ str) in + (* 0o1 *) + (env, str, [| code |], true) + | ('u', hex_quad) -> + let str = lexeme lexbuf in + let hex = String.sub str 1 (String.length str - 1) in + let code = int_of_string ("0x" ^ hex) in + (env, str, [| code |], false) + | ("u{", Plus hex_digit, '}') -> + let str = lexeme lexbuf in + let hex = String.sub str 2 (String.length str - 3) in + let code = int_of_string ("0x" ^ hex) in + (* 11.8.4.1 *) + let env = + if code > 0x10FFFF then + illegal env (loc_of_lexbuf env lexbuf) + else + env + in + (env, str, [| code |], false) + | 'u' + | 'x' + | '0' .. '7' -> + let str = lexeme lexbuf in + let codes = Sedlexing.lexeme lexbuf in + let env = illegal env (loc_of_lexbuf env lexbuf) in + (env, str, codes, false) + | line_terminator_sequence -> + let str = lexeme lexbuf in + let env = new_line env lexbuf in + (env, str, [||], false) + | any -> + let str = lexeme lexbuf in + let codes = Sedlexing.lexeme lexbuf in + (env, str, codes, false) + | _ -> failwith "unreachable string_escape" + +(* Really simple version of string lexing. Just try to find beginning and end of + * string. We can inspect the string later to find invalid escapes, etc *) +let rec string_quote env q buf raw octal lexbuf = + match%sedlex lexbuf with + | "'" + | '"' -> + let q' = lexeme lexbuf in + Buffer.add_string raw q'; + if q = q' then + (env, end_pos_of_lexbuf env lexbuf, octal) + else ( + Buffer.add_string buf q'; + string_quote env q buf raw octal lexbuf + ) + | '\\' -> + Buffer.add_string raw "\\"; + let (env, str, codes, octal') = string_escape env lexbuf in + let octal = octal' || octal in + Buffer.add_string raw str; + Array.iter (Wtf8.add_wtf_8 buf) codes; + string_quote env q buf raw octal lexbuf + | '\n' -> + let x = lexeme lexbuf in + Buffer.add_string raw x; + let env = illegal env (loc_of_lexbuf env lexbuf) in + let env = new_line env lexbuf in + Buffer.add_string buf x; + (env, end_pos_of_lexbuf env lexbuf, octal) + | eof -> + let x = lexeme lexbuf in + Buffer.add_string raw x; + let env = illegal env (loc_of_lexbuf env lexbuf) in + Buffer.add_string buf x; + (env, end_pos_of_lexbuf env lexbuf, octal) + (* match multi-char substrings that don't contain the start chars of the above patterns *) + | Plus (Compl ("'" | '"' | '\\' | '\n' | eof)) + | any -> + lexeme_to_buffer2 lexbuf raw buf; + string_quote env q buf raw octal lexbuf + | _ -> failwith "unreachable string_quote" + +let rec template_part env cooked raw literal lexbuf = + match%sedlex lexbuf with + | eof -> + let env = illegal env (loc_of_lexbuf env lexbuf) in + (env, true) + | '`' -> + Buffer.add_char literal '`'; + (env, true) + | "${" -> + Buffer.add_string literal "${"; + (env, false) + | '\\' -> + Buffer.add_char raw '\\'; + Buffer.add_char literal '\\'; + let (env, str, codes, _) = string_escape env lexbuf in + Buffer.add_string raw str; + Buffer.add_string literal str; + Array.iter (Wtf8.add_wtf_8 cooked) codes; + template_part env cooked raw literal lexbuf + (* ECMAScript 6th Syntax, 11.8.6.1 Static Semantics: TV's and TRV's + * Long story short, is 0xA, is 0xA, and is 0xA + * *) + | "\r\n" -> + Buffer.add_string raw "\r\n"; + Buffer.add_string literal "\r\n"; + Buffer.add_string cooked "\n"; + let env = new_line env lexbuf in + template_part env cooked raw literal lexbuf + | "\n" + | "\r" -> + let lf = lexeme lexbuf in + Buffer.add_string raw lf; + Buffer.add_string literal lf; + Buffer.add_char cooked '\n'; + let env = new_line env lexbuf in + template_part env cooked raw literal lexbuf + (* match multi-char substrings that don't contain the start chars of the above patterns *) + | Plus (Compl (eof | '`' | '$' | '\\' | '\r' | '\n')) + | any -> + let c = lexeme lexbuf in + Buffer.add_string raw c; + Buffer.add_string literal c; + Buffer.add_string cooked c; + template_part env cooked raw literal lexbuf + | _ -> failwith "unreachable template_part" + +let token (env : Lex_env.t) lexbuf : result = + match%sedlex lexbuf with + | line_terminator_sequence -> + let env = new_line env lexbuf in + Continue env + | '\\' -> + let env = illegal env (loc_of_lexbuf env lexbuf) in + Continue env + | Plus whitespace -> Continue env + | "/*" -> + let start_pos = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + let (env, end_pos) = comment env buf lexbuf in + Comment (env, mk_comment env start_pos end_pos buf true) + | ("/*", Star whitespace, (":" | "::" | "flow-include")) -> + let pattern = lexeme lexbuf in + if not (is_comment_syntax_enabled env) then ( + let start_pos = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + Buffer.add_string buf (String.sub pattern 2 (String.length pattern - 2)); + let (env, end_pos) = comment env buf lexbuf in + Comment (env, mk_comment env start_pos end_pos buf true) + ) else + let env = + if is_in_comment_syntax env then + let loc = loc_of_lexbuf env lexbuf in + unexpected_error env loc pattern + else + env + in + let env = in_comment_syntax true env in + let len = Sedlexing.lexeme_length lexbuf in + if + Sedlexing.Utf8.sub_lexeme lexbuf (len - 1) 1 = ":" + && Sedlexing.Utf8.sub_lexeme lexbuf (len - 2) 1 <> ":" + then + Token (env, T_COLON) + else + Continue env + | "*/" -> + if is_in_comment_syntax env then + let env = in_comment_syntax false env in + Continue env + else ( + Sedlexing.rollback lexbuf; + match%sedlex lexbuf with + | "*" -> Token (env, T_MULT) + | _ -> failwith "expected *" + ) + | "//" -> + let start_pos = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + let (env, end_pos) = line_comment env buf lexbuf in + Comment (env, mk_comment env start_pos end_pos buf false) + (* Support for the shebang at the beginning of a file. It is treated like a + * comment at the beginning or an error elsewhere *) + | "#!" -> + if Sedlexing.lexeme_start lexbuf = 0 then + let (env, _) = line_comment env (Buffer.create 127) lexbuf in + Continue env + else + Token (env, T_ERROR "#!") + (* Values *) + | "'" + | '"' -> + let quote = lexeme lexbuf in + let start = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + let raw = Buffer.create 127 in + Buffer.add_string raw quote; + let octal = false in + let (env, _end, octal) = string_quote env quote buf raw octal lexbuf in + let loc = { Loc.source = Lex_env.source env; start; _end } in + Token (env, T_STRING (loc, Buffer.contents buf, Buffer.contents raw, octal)) + | '`' -> + let cooked = Buffer.create 127 in + let raw = Buffer.create 127 in + let literal = Buffer.create 127 in + lexeme_to_buffer lexbuf literal; + + let start = start_pos_of_lexbuf env lexbuf in + let (env, is_tail) = template_part env cooked raw literal lexbuf in + let _end = end_pos_of_lexbuf env lexbuf in + let loc = { Loc.source = Lex_env.source env; start; _end } in + Token + ( env, + T_TEMPLATE_PART + ( loc, + { + cooked = Buffer.contents cooked; + raw = Buffer.contents raw; + literal = Buffer.contents literal; + }, + is_tail + ) + ) + | (binbigint, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | binbigint -> Token (env, T_BIGINT { kind = BIG_BINARY; raw = lexeme lexbuf }) + | _ -> failwith "unreachable token bigint" + ) + | binbigint -> Token (env, T_BIGINT { kind = BIG_BINARY; raw = lexeme lexbuf }) + | (binnumber, (letter | '2' .. '9'), Star alphanumeric) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | binnumber -> Token (env, T_NUMBER { kind = BINARY; raw = lexeme lexbuf }) + | _ -> failwith "unreachable token bignumber" + ) + | binnumber -> Token (env, T_NUMBER { kind = BINARY; raw = lexeme lexbuf }) + | (octbigint, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | octbigint -> Token (env, T_BIGINT { kind = BIG_OCTAL; raw = lexeme lexbuf }) + | _ -> failwith "unreachable token octbigint" + ) + | octbigint -> Token (env, T_BIGINT { kind = BIG_OCTAL; raw = lexeme lexbuf }) + | (octnumber, (letter | '8' .. '9'), Star alphanumeric) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | octnumber -> Token (env, T_NUMBER { kind = OCTAL; raw = lexeme lexbuf }) + | _ -> failwith "unreachable token octnumber" + ) + | octnumber -> Token (env, T_NUMBER { kind = OCTAL; raw = lexeme lexbuf }) + | (legacynonoctnumber, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | legacynonoctnumber -> + Token (env, T_NUMBER { kind = LEGACY_NON_OCTAL; raw = lexeme lexbuf }) + | _ -> failwith "unreachable token legacynonoctnumber" + ) + | legacynonoctnumber -> Token (env, T_NUMBER { kind = LEGACY_NON_OCTAL; raw = lexeme lexbuf }) + | (legacyoctnumber, (letter | '8' .. '9'), Star alphanumeric) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | legacyoctnumber -> Token (env, T_NUMBER { kind = LEGACY_OCTAL; raw = lexeme lexbuf }) + | _ -> failwith "unreachable token legacyoctnumber" + ) + | legacyoctnumber -> Token (env, T_NUMBER { kind = LEGACY_OCTAL; raw = lexeme lexbuf }) + | (hexbigint, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | hexbigint -> Token (env, T_BIGINT { kind = BIG_NORMAL; raw = lexeme lexbuf }) + | _ -> failwith "unreachable token hexbigint" + ) + | hexbigint -> Token (env, T_BIGINT { kind = BIG_NORMAL; raw = lexeme lexbuf }) + | (hexnumber, non_hex_letter, Star alphanumeric) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | hexnumber -> Token (env, T_NUMBER { kind = NORMAL; raw = lexeme lexbuf }) + | _ -> failwith "unreachable token hexnumber" + ) + | hexnumber -> Token (env, T_NUMBER { kind = NORMAL; raw = lexeme lexbuf }) + | (scibigint, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | scibigint -> + let loc = loc_of_lexbuf env lexbuf in + let env = lex_error env loc Parse_error.InvalidSciBigInt in + Token (env, T_BIGINT { kind = BIG_NORMAL; raw = lexeme lexbuf }) + | _ -> failwith "unreachable token scibigint" + ) + | scibigint -> + let loc = loc_of_lexbuf env lexbuf in + let env = lex_error env loc Parse_error.InvalidSciBigInt in + Token (env, T_BIGINT { kind = BIG_NORMAL; raw = lexeme lexbuf }) + | (scinumber, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | scinumber -> Token (env, T_NUMBER { kind = NORMAL; raw = lexeme lexbuf }) + | _ -> failwith "unreachable token scinumber" + ) + | scinumber -> Token (env, T_NUMBER { kind = NORMAL; raw = lexeme lexbuf }) + | (floatbigint, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | floatbigint -> + let loc = loc_of_lexbuf env lexbuf in + let env = lex_error env loc Parse_error.InvalidFloatBigInt in + Token (env, T_BIGINT { kind = BIG_NORMAL; raw = lexeme lexbuf }) + | _ -> failwith "unreachable token floatbigint" + ) + | (wholebigint, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | wholebigint -> Token (env, T_BIGINT { kind = BIG_NORMAL; raw = lexeme lexbuf }) + | _ -> failwith "unreachable token wholebigint" + ) + | floatbigint -> + let loc = loc_of_lexbuf env lexbuf in + let env = lex_error env loc Parse_error.InvalidFloatBigInt in + Token (env, T_BIGINT { kind = BIG_NORMAL; raw = lexeme lexbuf }) + | wholebigint -> Token (env, T_BIGINT { kind = BIG_NORMAL; raw = lexeme lexbuf }) + | ((wholenumber | floatnumber), word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | wholenumber + | floatnumber -> + Token (env, T_NUMBER { kind = NORMAL; raw = lexeme lexbuf }) + | _ -> failwith "unreachable token wholenumber" + ) + | wholenumber + | floatnumber -> + Token (env, T_NUMBER { kind = NORMAL; raw = lexeme lexbuf }) + (* Keywords *) + | "async" -> Token (env, T_ASYNC) + | "await" -> Token (env, T_AWAIT) + | "break" -> Token (env, T_BREAK) + | "case" -> Token (env, T_CASE) + | "catch" -> Token (env, T_CATCH) + | "class" -> Token (env, T_CLASS) + | "const" -> Token (env, T_CONST) + | "continue" -> Token (env, T_CONTINUE) + | "debugger" -> Token (env, T_DEBUGGER) + | "declare" -> Token (env, T_DECLARE) + | "default" -> Token (env, T_DEFAULT) + | "delete" -> Token (env, T_DELETE) + | "do" -> Token (env, T_DO) + | "else" -> Token (env, T_ELSE) + | "enum" -> Token (env, T_ENUM) + | "export" -> Token (env, T_EXPORT) + | "extends" -> Token (env, T_EXTENDS) + | "false" -> Token (env, T_FALSE) + | "finally" -> Token (env, T_FINALLY) + | "for" -> Token (env, T_FOR) + | "function" -> Token (env, T_FUNCTION) + | "if" -> Token (env, T_IF) + | "implements" -> Token (env, T_IMPLEMENTS) + | "import" -> Token (env, T_IMPORT) + | "in" -> Token (env, T_IN) + | "instanceof" -> Token (env, T_INSTANCEOF) + | "interface" -> Token (env, T_INTERFACE) + | "let" -> Token (env, T_LET) + | "new" -> Token (env, T_NEW) + | "null" -> Token (env, T_NULL) + | "of" -> Token (env, T_OF) + | "opaque" -> Token (env, T_OPAQUE) + | "package" -> Token (env, T_PACKAGE) + | "private" -> Token (env, T_PRIVATE) + | "protected" -> Token (env, T_PROTECTED) + | "public" -> Token (env, T_PUBLIC) + | "return" -> Token (env, T_RETURN) + | "static" -> Token (env, T_STATIC) + | "super" -> Token (env, T_SUPER) + | "switch" -> Token (env, T_SWITCH) + | "this" -> Token (env, T_THIS) + | "throw" -> Token (env, T_THROW) + | "true" -> Token (env, T_TRUE) + | "try" -> Token (env, T_TRY) + | "type" -> Token (env, T_TYPE) + | "typeof" -> Token (env, T_TYPEOF) + | "var" -> Token (env, T_VAR) + | "void" -> Token (env, T_VOID) + | "while" -> Token (env, T_WHILE) + | "with" -> Token (env, T_WITH) + | "yield" -> Token (env, T_YIELD) + (* Identifiers *) + | (ascii_id_start, Star ascii_id_continue) -> + (* fast path *) + let loc = loc_of_lexbuf env lexbuf in + let raw = lexeme lexbuf in + Token (env, T_IDENTIFIER { loc; value = raw; raw }) + | (js_id_start, Star js_id_continue) -> + let loc = loc_of_lexbuf env lexbuf in + let raw = lexeme lexbuf in + let (env, value) = decode_identifier env (Sedlexing.lexeme lexbuf) in + Token (env, T_IDENTIFIER { loc; value; raw }) + (* TODO: Use [Symbol.iterator] instead of @@iterator. *) + | "@@iterator" + | "@@asyncIterator" -> + let loc = loc_of_lexbuf env lexbuf in + let raw = lexeme lexbuf in + Token (env, T_IDENTIFIER { loc; value = raw; raw }) + (* Syntax *) + | "{" -> Token (env, T_LCURLY) + | "}" -> Token (env, T_RCURLY) + | "(" -> Token (env, T_LPAREN) + | ")" -> Token (env, T_RPAREN) + | "[" -> Token (env, T_LBRACKET) + | "]" -> Token (env, T_RBRACKET) + | "..." -> Token (env, T_ELLIPSIS) + | "." -> Token (env, T_PERIOD) + | ";" -> Token (env, T_SEMICOLON) + | "," -> Token (env, T_COMMA) + | ":" -> Token (env, T_COLON) + | ("?.", digit) -> + Sedlexing.rollback lexbuf; + (match%sedlex lexbuf with + | "?" -> Token (env, T_PLING) + | _ -> failwith "expected ?") + | "?." -> Token (env, T_PLING_PERIOD) + | "??" -> Token (env, T_PLING_PLING) + | "?" -> Token (env, T_PLING) + | "&&" -> Token (env, T_AND) + | "||" -> Token (env, T_OR) + | "===" -> Token (env, T_STRICT_EQUAL) + | "!==" -> Token (env, T_STRICT_NOT_EQUAL) + | "<=" -> Token (env, T_LESS_THAN_EQUAL) + | ">=" -> Token (env, T_GREATER_THAN_EQUAL) + | "==" -> Token (env, T_EQUAL) + | "!=" -> Token (env, T_NOT_EQUAL) + | "++" -> Token (env, T_INCR) + | "--" -> Token (env, T_DECR) + | "<<=" -> Token (env, T_LSHIFT_ASSIGN) + | "<<" -> Token (env, T_LSHIFT) + | ">>=" -> Token (env, T_RSHIFT_ASSIGN) + | ">>>=" -> Token (env, T_RSHIFT3_ASSIGN) + | ">>>" -> Token (env, T_RSHIFT3) + | ">>" -> Token (env, T_RSHIFT) + | "+=" -> Token (env, T_PLUS_ASSIGN) + | "-=" -> Token (env, T_MINUS_ASSIGN) + | "*=" -> Token (env, T_MULT_ASSIGN) + | "**=" -> Token (env, T_EXP_ASSIGN) + | "%=" -> Token (env, T_MOD_ASSIGN) + | "&=" -> Token (env, T_BIT_AND_ASSIGN) + | "|=" -> Token (env, T_BIT_OR_ASSIGN) + | "^=" -> Token (env, T_BIT_XOR_ASSIGN) + | "<" -> Token (env, T_LESS_THAN) + | ">" -> Token (env, T_GREATER_THAN) + | "+" -> Token (env, T_PLUS) + | "-" -> Token (env, T_MINUS) + | "*" -> Token (env, T_MULT) + | "**" -> Token (env, T_EXP) + | "%" -> Token (env, T_MOD) + | "|" -> Token (env, T_BIT_OR) + | "&" -> Token (env, T_BIT_AND) + | "^" -> Token (env, T_BIT_XOR) + | "!" -> Token (env, T_NOT) + | "~" -> Token (env, T_BIT_NOT) + | "=" -> Token (env, T_ASSIGN) + | "=>" -> Token (env, T_ARROW) + | "/=" -> Token (env, T_DIV_ASSIGN) + | "/" -> Token (env, T_DIV) + | "@" -> Token (env, T_AT) + | "#" -> Token (env, T_POUND) + (* Others *) + | eof -> + let env = + if is_in_comment_syntax env then + let loc = loc_of_lexbuf env lexbuf in + lex_error env loc Parse_error.UnexpectedEOS + else + env + in + Token (env, T_EOF) + | any -> + let env = illegal env (loc_of_lexbuf env lexbuf) in + Token (env, T_ERROR (lexeme lexbuf)) + | _ -> failwith "unreachable token" + +let rec regexp_class env buf lexbuf = + match%sedlex lexbuf with + | eof -> env + | "\\\\" -> + Buffer.add_string buf "\\\\"; + regexp_class env buf lexbuf + | ('\\', ']') -> + Buffer.add_char buf '\\'; + Buffer.add_char buf ']'; + regexp_class env buf lexbuf + | ']' -> + Buffer.add_char buf ']'; + env + (* match multi-char substrings that don't contain the start chars of the above patterns *) + | Plus (Compl (eof | '\\' | ']')) + | any -> + let str = lexeme lexbuf in + Buffer.add_string buf str; + regexp_class env buf lexbuf + | _ -> failwith "unreachable regexp_class" + +let rec regexp_body env buf lexbuf = + match%sedlex lexbuf with + | eof -> + let loc = loc_of_lexbuf env lexbuf in + let env = lex_error env loc Parse_error.UnterminatedRegExp in + (env, "") + | ('\\', line_terminator_sequence) -> + let loc = loc_of_lexbuf env lexbuf in + let env = lex_error env loc Parse_error.UnterminatedRegExp in + let env = new_line env lexbuf in + (env, "") + | ('\\', any) -> + let s = lexeme lexbuf in + Buffer.add_string buf s; + regexp_body env buf lexbuf + | ('/', Plus id_letter) -> + let flags = + let str = lexeme lexbuf in + String.sub str 1 (String.length str - 1) + in + (env, flags) + | '/' -> (env, "") + | '[' -> + Buffer.add_char buf '['; + let env = regexp_class env buf lexbuf in + regexp_body env buf lexbuf + | line_terminator_sequence -> + let loc = loc_of_lexbuf env lexbuf in + let env = lex_error env loc Parse_error.UnterminatedRegExp in + let env = new_line env lexbuf in + (env, "") + (* match multi-char substrings that don't contain the start chars of the above patterns *) + | Plus (Compl (eof | '\\' | '/' | '[' | line_terminator_sequence_start)) + | any -> + let str = lexeme lexbuf in + Buffer.add_string buf str; + regexp_body env buf lexbuf + | _ -> failwith "unreachable regexp_body" + +let regexp env lexbuf = + match%sedlex lexbuf with + | eof -> Token (env, T_EOF) + | line_terminator_sequence -> + let env = new_line env lexbuf in + Continue env + | Plus whitespace -> Continue env + | "//" -> + let start_pos = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + let (env, end_pos) = line_comment env buf lexbuf in + Comment (env, mk_comment env start_pos end_pos buf false) + | "/*" -> + let start_pos = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + let (env, end_pos) = comment env buf lexbuf in + Comment (env, mk_comment env start_pos end_pos buf true) + | '/' -> + let start = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + let (env, flags) = regexp_body env buf lexbuf in + let _end = end_pos_of_lexbuf env lexbuf in + let loc = { Loc.source = Lex_env.source env; start; _end } in + Token (env, T_REGEXP (loc, Buffer.contents buf, flags)) + | any -> + let env = illegal env (loc_of_lexbuf env lexbuf) in + Token (env, T_ERROR (lexeme lexbuf)) + | _ -> failwith "unreachable regexp" + +let rec jsx_text env mode buf raw lexbuf = + match%sedlex lexbuf with + | "'" + | '"' + | '<' + | '>' + | '{' + | '}' -> + let c = lexeme lexbuf in + begin + match (mode, c) with + | (JSX_SINGLE_QUOTED_TEXT, "'") + | (JSX_DOUBLE_QUOTED_TEXT, "\"") -> + env + | (JSX_CHILD_TEXT, ("<" | "{")) -> + (* Don't actually want to consume these guys + * yet...they're not part of the JSX text *) + Sedlexing.rollback lexbuf; + env + | (JSX_CHILD_TEXT, ">") -> + unexpected_error_w_suggest env (loc_of_lexbuf env lexbuf) ">" "{'>'}" + | (JSX_CHILD_TEXT, "}") -> + unexpected_error_w_suggest env (loc_of_lexbuf env lexbuf) "}" "{'}'}" + | _ -> + Buffer.add_string raw c; + Buffer.add_string buf c; + jsx_text env mode buf raw lexbuf + end + | eof -> + let env = illegal env (loc_of_lexbuf env lexbuf) in + env + | line_terminator_sequence -> + let lt = lexeme lexbuf in + Buffer.add_string raw lt; + Buffer.add_string buf lt; + let env = new_line env lexbuf in + jsx_text env mode buf raw lexbuf + | ("&#x", Plus hex_digit, ';') -> + let s = lexeme lexbuf in + let n = String.sub s 3 (String.length s - 4) in + Buffer.add_string raw s; + let code = int_of_string ("0x" ^ n) in + Wtf8.add_wtf_8 buf code; + jsx_text env mode buf raw lexbuf + | ("&#", Plus digit, ';') -> + let s = lexeme lexbuf in + let n = String.sub s 2 (String.length s - 3) in + Buffer.add_string raw s; + let code = int_of_string n in + Wtf8.add_wtf_8 buf code; + jsx_text env mode buf raw lexbuf + | ("&", htmlentity, ';') -> + let s = lexeme lexbuf in + let entity = String.sub s 1 (String.length s - 2) in + Buffer.add_string raw s; + let code = + match entity with + | "quot" -> Some 0x0022 + | "amp" -> Some 0x0026 + | "apos" -> Some 0x0027 + | "lt" -> Some 0x003C + | "gt" -> Some 0x003E + | "nbsp" -> Some 0x00A0 + | "iexcl" -> Some 0x00A1 + | "cent" -> Some 0x00A2 + | "pound" -> Some 0x00A3 + | "curren" -> Some 0x00A4 + | "yen" -> Some 0x00A5 + | "brvbar" -> Some 0x00A6 + | "sect" -> Some 0x00A7 + | "uml" -> Some 0x00A8 + | "copy" -> Some 0x00A9 + | "ordf" -> Some 0x00AA + | "laquo" -> Some 0x00AB + | "not" -> Some 0x00AC + | "shy" -> Some 0x00AD + | "reg" -> Some 0x00AE + | "macr" -> Some 0x00AF + | "deg" -> Some 0x00B0 + | "plusmn" -> Some 0x00B1 + | "sup2" -> Some 0x00B2 + | "sup3" -> Some 0x00B3 + | "acute" -> Some 0x00B4 + | "micro" -> Some 0x00B5 + | "para" -> Some 0x00B6 + | "middot" -> Some 0x00B7 + | "cedil" -> Some 0x00B8 + | "sup1" -> Some 0x00B9 + | "ordm" -> Some 0x00BA + | "raquo" -> Some 0x00BB + | "frac14" -> Some 0x00BC + | "frac12" -> Some 0x00BD + | "frac34" -> Some 0x00BE + | "iquest" -> Some 0x00BF + | "Agrave" -> Some 0x00C0 + | "Aacute" -> Some 0x00C1 + | "Acirc" -> Some 0x00C2 + | "Atilde" -> Some 0x00C3 + | "Auml" -> Some 0x00C4 + | "Aring" -> Some 0x00C5 + | "AElig" -> Some 0x00C6 + | "Ccedil" -> Some 0x00C7 + | "Egrave" -> Some 0x00C8 + | "Eacute" -> Some 0x00C9 + | "Ecirc" -> Some 0x00CA + | "Euml" -> Some 0x00CB + | "Igrave" -> Some 0x00CC + | "Iacute" -> Some 0x00CD + | "Icirc" -> Some 0x00CE + | "Iuml" -> Some 0x00CF + | "ETH" -> Some 0x00D0 + | "Ntilde" -> Some 0x00D1 + | "Ograve" -> Some 0x00D2 + | "Oacute" -> Some 0x00D3 + | "Ocirc" -> Some 0x00D4 + | "Otilde" -> Some 0x00D5 + | "Ouml" -> Some 0x00D6 + | "times" -> Some 0x00D7 + | "Oslash" -> Some 0x00D8 + | "Ugrave" -> Some 0x00D9 + | "Uacute" -> Some 0x00DA + | "Ucirc" -> Some 0x00DB + | "Uuml" -> Some 0x00DC + | "Yacute" -> Some 0x00DD + | "THORN" -> Some 0x00DE + | "szlig" -> Some 0x00DF + | "agrave" -> Some 0x00E0 + | "aacute" -> Some 0x00E1 + | "acirc" -> Some 0x00E2 + | "atilde" -> Some 0x00E3 + | "auml" -> Some 0x00E4 + | "aring" -> Some 0x00E5 + | "aelig" -> Some 0x00E6 + | "ccedil" -> Some 0x00E7 + | "egrave" -> Some 0x00E8 + | "eacute" -> Some 0x00E9 + | "ecirc" -> Some 0x00EA + | "euml" -> Some 0x00EB + | "igrave" -> Some 0x00EC + | "iacute" -> Some 0x00ED + | "icirc" -> Some 0x00EE + | "iuml" -> Some 0x00EF + | "eth" -> Some 0x00F0 + | "ntilde" -> Some 0x00F1 + | "ograve" -> Some 0x00F2 + | "oacute" -> Some 0x00F3 + | "ocirc" -> Some 0x00F4 + | "otilde" -> Some 0x00F5 + | "ouml" -> Some 0x00F6 + | "divide" -> Some 0x00F7 + | "oslash" -> Some 0x00F8 + | "ugrave" -> Some 0x00F9 + | "uacute" -> Some 0x00FA + | "ucirc" -> Some 0x00FB + | "uuml" -> Some 0x00FC + | "yacute" -> Some 0x00FD + | "thorn" -> Some 0x00FE + | "yuml" -> Some 0x00FF + | "OElig" -> Some 0x0152 + | "oelig" -> Some 0x0153 + | "Scaron" -> Some 0x0160 + | "scaron" -> Some 0x0161 + | "Yuml" -> Some 0x0178 + | "fnof" -> Some 0x0192 + | "circ" -> Some 0x02C6 + | "tilde" -> Some 0x02DC + | "Alpha" -> Some 0x0391 + | "Beta" -> Some 0x0392 + | "Gamma" -> Some 0x0393 + | "Delta" -> Some 0x0394 + | "Epsilon" -> Some 0x0395 + | "Zeta" -> Some 0x0396 + | "Eta" -> Some 0x0397 + | "Theta" -> Some 0x0398 + | "Iota" -> Some 0x0399 + | "Kappa" -> Some 0x039A + | "Lambda" -> Some 0x039B + | "Mu" -> Some 0x039C + | "Nu" -> Some 0x039D + | "Xi" -> Some 0x039E + | "Omicron" -> Some 0x039F + | "Pi" -> Some 0x03A0 + | "Rho" -> Some 0x03A1 + | "Sigma" -> Some 0x03A3 + | "Tau" -> Some 0x03A4 + | "Upsilon" -> Some 0x03A5 + | "Phi" -> Some 0x03A6 + | "Chi" -> Some 0x03A7 + | "Psi" -> Some 0x03A8 + | "Omega" -> Some 0x03A9 + | "alpha" -> Some 0x03B1 + | "beta" -> Some 0x03B2 + | "gamma" -> Some 0x03B3 + | "delta" -> Some 0x03B4 + | "epsilon" -> Some 0x03B5 + | "zeta" -> Some 0x03B6 + | "eta" -> Some 0x03B7 + | "theta" -> Some 0x03B8 + | "iota" -> Some 0x03B9 + | "kappa" -> Some 0x03BA + | "lambda" -> Some 0x03BB + | "mu" -> Some 0x03BC + | "nu" -> Some 0x03BD + | "xi" -> Some 0x03BE + | "omicron" -> Some 0x03BF + | "pi" -> Some 0x03C0 + | "rho" -> Some 0x03C1 + | "sigmaf" -> Some 0x03C2 + | "sigma" -> Some 0x03C3 + | "tau" -> Some 0x03C4 + | "upsilon" -> Some 0x03C5 + | "phi" -> Some 0x03C6 + | "chi" -> Some 0x03C7 + | "psi" -> Some 0x03C8 + | "omega" -> Some 0x03C9 + | "thetasym" -> Some 0x03D1 + | "upsih" -> Some 0x03D2 + | "piv" -> Some 0x03D6 + | "ensp" -> Some 0x2002 + | "emsp" -> Some 0x2003 + | "thinsp" -> Some 0x2009 + | "zwnj" -> Some 0x200C + | "zwj" -> Some 0x200D + | "lrm" -> Some 0x200E + | "rlm" -> Some 0x200F + | "ndash" -> Some 0x2013 + | "mdash" -> Some 0x2014 + | "lsquo" -> Some 0x2018 + | "rsquo" -> Some 0x2019 + | "sbquo" -> Some 0x201A + | "ldquo" -> Some 0x201C + | "rdquo" -> Some 0x201D + | "bdquo" -> Some 0x201E + | "dagger" -> Some 0x2020 + | "Dagger" -> Some 0x2021 + | "bull" -> Some 0x2022 + | "hellip" -> Some 0x2026 + | "permil" -> Some 0x2030 + | "prime" -> Some 0x2032 + | "Prime" -> Some 0x2033 + | "lsaquo" -> Some 0x2039 + | "rsaquo" -> Some 0x203A + | "oline" -> Some 0x203E + | "frasl" -> Some 0x2044 + | "euro" -> Some 0x20AC + | "image" -> Some 0x2111 + | "weierp" -> Some 0x2118 + | "real" -> Some 0x211C + | "trade" -> Some 0x2122 + | "alefsym" -> Some 0x2135 + | "larr" -> Some 0x2190 + | "uarr" -> Some 0x2191 + | "rarr" -> Some 0x2192 + | "darr" -> Some 0x2193 + | "harr" -> Some 0x2194 + | "crarr" -> Some 0x21B5 + | "lArr" -> Some 0x21D0 + | "uArr" -> Some 0x21D1 + | "rArr" -> Some 0x21D2 + | "dArr" -> Some 0x21D3 + | "hArr" -> Some 0x21D4 + | "forall" -> Some 0x2200 + | "part" -> Some 0x2202 + | "exist" -> Some 0x2203 + | "empty" -> Some 0x2205 + | "nabla" -> Some 0x2207 + | "isin" -> Some 0x2208 + | "notin" -> Some 0x2209 + | "ni" -> Some 0x220B + | "prod" -> Some 0x220F + | "sum" -> Some 0x2211 + | "minus" -> Some 0x2212 + | "lowast" -> Some 0x2217 + | "radic" -> Some 0x221A + | "prop" -> Some 0x221D + | "infin" -> Some 0x221E + | "ang" -> Some 0x2220 + | "and" -> Some 0x2227 + | "or" -> Some 0x2228 + | "cap" -> Some 0x2229 + | "cup" -> Some 0x222A + | "'int'" -> Some 0x222B + | "there4" -> Some 0x2234 + | "sim" -> Some 0x223C + | "cong" -> Some 0x2245 + | "asymp" -> Some 0x2248 + | "ne" -> Some 0x2260 + | "equiv" -> Some 0x2261 + | "le" -> Some 0x2264 + | "ge" -> Some 0x2265 + | "sub" -> Some 0x2282 + | "sup" -> Some 0x2283 + | "nsub" -> Some 0x2284 + | "sube" -> Some 0x2286 + | "supe" -> Some 0x2287 + | "oplus" -> Some 0x2295 + | "otimes" -> Some 0x2297 + | "perp" -> Some 0x22A5 + | "sdot" -> Some 0x22C5 + | "lceil" -> Some 0x2308 + | "rceil" -> Some 0x2309 + | "lfloor" -> Some 0x230A + | "rfloor" -> Some 0x230B + | "lang" -> Some 0x27E8 (* 0x2329 in HTML4 *) + | "rang" -> Some 0x27E9 (* 0x232A in HTML4 *) + | "loz" -> Some 0x25CA + | "spades" -> Some 0x2660 + | "clubs" -> Some 0x2663 + | "hearts" -> Some 0x2665 + | "diams" -> Some 0x2666 + | _ -> None + in + (match code with + | Some code -> Wtf8.add_wtf_8 buf code + | None -> Buffer.add_string buf ("&" ^ entity ^ ";")); + jsx_text env mode buf raw lexbuf + (* match multi-char substrings that don't contain the start chars of the above patterns *) + | Plus (Compl ("'" | '"' | '<' | '{' | '&' | eof | line_terminator_sequence_start)) + | any -> + let c = lexeme lexbuf in + Buffer.add_string raw c; + Buffer.add_string buf c; + jsx_text env mode buf raw lexbuf + | _ -> failwith "unreachable jsxtext" + +let jsx_tag env lexbuf = + match%sedlex lexbuf with + | eof -> Token (env, T_EOF) + | line_terminator_sequence -> + let env = new_line env lexbuf in + Continue env + | Plus whitespace -> Continue env + | "//" -> + let start_pos = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + let (env, end_pos) = line_comment env buf lexbuf in + Comment (env, mk_comment env start_pos end_pos buf false) + | "/*" -> + let start_pos = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + let (env, end_pos) = comment env buf lexbuf in + Comment (env, mk_comment env start_pos end_pos buf true) + | '<' -> Token (env, T_LESS_THAN) + | '/' -> Token (env, T_DIV) + | '>' -> Token (env, T_GREATER_THAN) + | '{' -> Token (env, T_LCURLY) + | ':' -> Token (env, T_COLON) + | '.' -> Token (env, T_PERIOD) + | '=' -> Token (env, T_ASSIGN) + | (js_id_start, Star ('-' | js_id_continue)) -> + Token (env, T_JSX_IDENTIFIER { raw = lexeme lexbuf }) + | "'" + | '"' -> + let quote = lexeme lexbuf in + let start = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + let raw = Buffer.create 127 in + Buffer.add_string raw quote; + let mode = + if quote = "'" then + JSX_SINGLE_QUOTED_TEXT + else + JSX_DOUBLE_QUOTED_TEXT + in + let env = jsx_text env mode buf raw lexbuf in + let _end = end_pos_of_lexbuf env lexbuf in + Buffer.add_string raw quote; + let value = Buffer.contents buf in + let raw = Buffer.contents raw in + let loc = { Loc.source = Lex_env.source env; start; _end } in + Token (env, T_JSX_TEXT (loc, value, raw)) + | any -> Token (env, T_ERROR (lexeme lexbuf)) + | _ -> failwith "unreachable jsx_tag" + +let jsx_child env start buf raw lexbuf = + match%sedlex lexbuf with + | line_terminator_sequence -> + let lt = lexeme lexbuf in + Buffer.add_string raw lt; + Buffer.add_string buf lt; + let env = new_line env lexbuf in + let env = jsx_text env JSX_CHILD_TEXT buf raw lexbuf in + let _end = end_pos_of_lexbuf env lexbuf in + let value = Buffer.contents buf in + let raw = Buffer.contents raw in + let loc = { Loc.source = Lex_env.source env; start; _end } in + (env, T_JSX_TEXT (loc, value, raw)) + | eof -> (env, T_EOF) + | '<' -> (env, T_LESS_THAN) + | '{' -> (env, T_LCURLY) + | any -> + Sedlexing.rollback lexbuf; + + (* let jsx_text consume this char *) + let env = jsx_text env JSX_CHILD_TEXT buf raw lexbuf in + let _end = end_pos_of_lexbuf env lexbuf in + let value = Buffer.contents buf in + let raw = Buffer.contents raw in + let loc = { Loc.source = Lex_env.source env; start; _end } in + (env, T_JSX_TEXT (loc, value, raw)) + | _ -> failwith "unreachable jsx_child" + +let template_tail env lexbuf = + match%sedlex lexbuf with + | line_terminator_sequence -> + let env = new_line env lexbuf in + Continue env + | Plus whitespace -> Continue env + | "//" -> + let start_pos = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + let (env, end_pos) = line_comment env buf lexbuf in + Comment (env, mk_comment env start_pos end_pos buf false) + | "/*" -> + let start_pos = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + let (env, end_pos) = comment env buf lexbuf in + Comment (env, mk_comment env start_pos end_pos buf true) + | '}' -> + let start = start_pos_of_lexbuf env lexbuf in + let cooked = Buffer.create 127 in + let raw = Buffer.create 127 in + let literal = Buffer.create 127 in + Buffer.add_string literal "}"; + let (env, is_tail) = template_part env cooked raw literal lexbuf in + let _end = end_pos_of_lexbuf env lexbuf in + let loc = { Loc.source = Lex_env.source env; start; _end } in + Token + ( env, + T_TEMPLATE_PART + ( loc, + { + cooked = Buffer.contents cooked; + raw = Buffer.contents raw; + literal = Buffer.contents literal; + }, + is_tail + ) + ) + | any -> + let env = illegal env (loc_of_lexbuf env lexbuf) in + Token + ( env, + T_TEMPLATE_PART (loc_of_lexbuf env lexbuf, { cooked = ""; raw = ""; literal = "" }, true) + ) + | _ -> failwith "unreachable template_tail" + +(* There are some tokens that never show up in a type and which can cause + * ambiguity. For example, Foo> ends with two angle brackets, not + * with a right shift. + *) +let type_token env lexbuf = + match%sedlex lexbuf with + | line_terminator_sequence -> + let env = new_line env lexbuf in + Continue env + | Plus whitespace -> Continue env + | "/*" -> + let start_pos = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + let (env, end_pos) = comment env buf lexbuf in + Comment (env, mk_comment env start_pos end_pos buf true) + | ("/*", Star whitespace, (":" | "::" | "flow-include")) -> + let pattern = lexeme lexbuf in + if not (is_comment_syntax_enabled env) then ( + let start_pos = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + Buffer.add_string buf pattern; + let (env, end_pos) = comment env buf lexbuf in + Comment (env, mk_comment env start_pos end_pos buf true) + ) else + let env = + if is_in_comment_syntax env then + let loc = loc_of_lexbuf env lexbuf in + unexpected_error env loc pattern + else + env + in + let env = in_comment_syntax true env in + let len = Sedlexing.lexeme_length lexbuf in + if + Sedlexing.Utf8.sub_lexeme lexbuf (len - 1) 1 = ":" + && Sedlexing.Utf8.sub_lexeme lexbuf (len - 2) 1 <> ":" + then + Token (env, T_COLON) + else + Continue env + | "*/" -> + if is_in_comment_syntax env then + let env = in_comment_syntax false env in + Continue env + else ( + Sedlexing.rollback lexbuf; + match%sedlex lexbuf with + | "*" -> Token (env, T_MULT) + | _ -> failwith "expected *" + ) + | "//" -> + let start_pos = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + let (env, end_pos) = line_comment env buf lexbuf in + Comment (env, mk_comment env start_pos end_pos buf false) + | "'" + | '"' -> + let quote = lexeme lexbuf in + let start = start_pos_of_lexbuf env lexbuf in + let buf = Buffer.create 127 in + let raw = Buffer.create 127 in + Buffer.add_string raw quote; + let octal = false in + let (env, _end, octal) = string_quote env quote buf raw octal lexbuf in + let loc = { Loc.source = Lex_env.source env; start; _end } in + Token (env, T_STRING (loc, Buffer.contents buf, Buffer.contents raw, octal)) + (* + * Number literals + *) + | (Opt neg, binbigint, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | (Opt neg, binbigint) -> + let num = lexeme lexbuf in + Token (env, mk_bignum_singleton BIG_BINARY num) + | _ -> failwith "unreachable type_token bigbigint" + ) + | (Opt neg, binbigint) -> + let num = lexeme lexbuf in + Token (env, mk_bignum_singleton BIG_BINARY num) + | (Opt neg, binnumber, (letter | '2' .. '9'), Star alphanumeric) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | (Opt neg, binnumber) -> + let num = lexeme lexbuf in + Token (env, mk_num_singleton BINARY num) + | _ -> failwith "unreachable type_token binnumber" + ) + | (Opt neg, binnumber) -> + let num = lexeme lexbuf in + Token (env, mk_num_singleton BINARY num) + | (Opt neg, octbigint, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | (Opt neg, octbigint) -> + let num = lexeme lexbuf in + Token (env, mk_bignum_singleton BIG_OCTAL num) + | _ -> failwith "unreachable type_token octbigint" + ) + | (Opt neg, octbigint) -> + let num = lexeme lexbuf in + Token (env, mk_bignum_singleton BIG_OCTAL num) + | (Opt neg, octnumber, (letter | '8' .. '9'), Star alphanumeric) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | (Opt neg, octnumber) -> + let num = lexeme lexbuf in + Token (env, mk_num_singleton OCTAL num) + | _ -> failwith "unreachable type_token octnumber" + ) + | (Opt neg, octnumber) -> + let num = lexeme lexbuf in + Token (env, mk_num_singleton OCTAL num) + | (Opt neg, legacyoctnumber, (letter | '8' .. '9'), Star alphanumeric) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | (Opt neg, legacyoctnumber) -> + let num = lexeme lexbuf in + Token (env, mk_num_singleton LEGACY_OCTAL num) + | _ -> failwith "unreachable type_token legacyoctnumber" + ) + | (Opt neg, legacyoctnumber) -> + let num = lexeme lexbuf in + Token (env, mk_num_singleton LEGACY_OCTAL num) + | (Opt neg, hexbigint, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | (Opt neg, hexbigint) -> + let num = lexeme lexbuf in + Token (env, mk_bignum_singleton BIG_NORMAL num) + | _ -> failwith "unreachable type_token hexbigint" + ) + | (Opt neg, hexbigint) -> + let num = lexeme lexbuf in + Token (env, mk_bignum_singleton BIG_NORMAL num) + | (Opt neg, hexnumber, non_hex_letter, Star alphanumeric) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | (Opt neg, hexnumber) -> + let num = lexeme lexbuf in + Token (env, mk_num_singleton NORMAL num) + | _ -> failwith "unreachable type_token hexnumber" + ) + | (Opt neg, hexnumber) -> + let num = lexeme lexbuf in + Token (env, mk_num_singleton NORMAL num) + | (Opt neg, scibigint, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | (Opt neg, scibigint) -> + let num = lexeme lexbuf in + let loc = loc_of_lexbuf env lexbuf in + let env = lex_error env loc Parse_error.InvalidSciBigInt in + Token (env, mk_bignum_singleton BIG_NORMAL num) + | _ -> failwith "unreachable type_token scibigint" + ) + | (Opt neg, scibigint) -> + let num = lexeme lexbuf in + let loc = loc_of_lexbuf env lexbuf in + let env = lex_error env loc Parse_error.InvalidSciBigInt in + Token (env, mk_bignum_singleton BIG_NORMAL num) + | (Opt neg, scinumber, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | (Opt neg, scinumber) -> + let num = lexeme lexbuf in + Token (env, mk_num_singleton NORMAL num) + | _ -> failwith "unreachable type_token scinumber" + ) + | (Opt neg, scinumber) -> + let num = lexeme lexbuf in + Token (env, mk_num_singleton NORMAL num) + | (Opt neg, floatbigint, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | (Opt neg, floatbigint) -> + let num = lexeme lexbuf in + let loc = loc_of_lexbuf env lexbuf in + let env = lex_error env loc Parse_error.InvalidFloatBigInt in + Token (env, mk_bignum_singleton BIG_NORMAL num) + | _ -> failwith "unreachable type_token floatbigint" + ) + | (Opt neg, wholebigint, word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | (Opt neg, wholebigint) -> + let num = lexeme lexbuf in + Token (env, mk_bignum_singleton BIG_NORMAL num) + | _ -> failwith "unreachable type_token wholebigint" + ) + | (Opt neg, floatbigint) -> + let num = lexeme lexbuf in + let loc = loc_of_lexbuf env lexbuf in + let env = lex_error env loc Parse_error.InvalidFloatBigInt in + Token (env, mk_bignum_singleton BIG_NORMAL num) + | (Opt neg, wholebigint) -> + let num = lexeme lexbuf in + Token (env, mk_bignum_singleton BIG_NORMAL num) + | (Opt neg, (wholenumber | floatnumber), word) -> + (* Numbers cannot be immediately followed by words *) + recover env lexbuf ~f:(fun env lexbuf -> + match%sedlex lexbuf with + | (Opt neg, wholenumber) + | floatnumber -> + let num = lexeme lexbuf in + Token (env, mk_num_singleton NORMAL num) + | _ -> failwith "unreachable type_token wholenumber" + ) + | (Opt neg, (wholenumber | floatnumber)) -> + let num = lexeme lexbuf in + Token (env, mk_num_singleton NORMAL num) + (* Keywords *) + | "any" -> Token (env, T_ANY_TYPE) + | "bool" -> Token (env, T_BOOLEAN_TYPE BOOL) + | "boolean" -> Token (env, T_BOOLEAN_TYPE BOOLEAN) + | "empty" -> Token (env, T_EMPTY_TYPE) + | "extends" -> Token (env, T_EXTENDS) + | "false" -> Token (env, T_FALSE) + | "interface" -> Token (env, T_INTERFACE) + | "mixed" -> Token (env, T_MIXED_TYPE) + | "null" -> Token (env, T_NULL) + | "number" -> Token (env, T_NUMBER_TYPE) + | "bigint" -> Token (env, T_BIGINT_TYPE) + | "static" -> Token (env, T_STATIC) + | "string" -> Token (env, T_STRING_TYPE) + | "true" -> Token (env, T_TRUE) + | "typeof" -> Token (env, T_TYPEOF) + | "void" -> Token (env, T_VOID_TYPE) + | "symbol" -> Token (env, T_SYMBOL_TYPE) + (* Identifiers *) + | (ascii_id_start, Star ascii_id_continue) -> + (* fast path *) + let loc = loc_of_lexbuf env lexbuf in + let raw = lexeme lexbuf in + Token (env, T_IDENTIFIER { loc; value = raw; raw }) + | (js_id_start, Star js_id_continue) -> + let loc = loc_of_lexbuf env lexbuf in + let raw = lexeme lexbuf in + let (env, value) = decode_identifier env (Sedlexing.lexeme lexbuf) in + Token (env, T_IDENTIFIER { loc; value; raw }) + | "%checks" -> Token (env, T_CHECKS) + (* Syntax *) + | "[" -> Token (env, T_LBRACKET) + | "]" -> Token (env, T_RBRACKET) + | "{" -> Token (env, T_LCURLY) + | "}" -> Token (env, T_RCURLY) + | "{|" -> Token (env, T_LCURLYBAR) + | "|}" -> Token (env, T_RCURLYBAR) + | "(" -> Token (env, T_LPAREN) + | ")" -> Token (env, T_RPAREN) + | "..." -> Token (env, T_ELLIPSIS) + | "." -> Token (env, T_PERIOD) + | ";" -> Token (env, T_SEMICOLON) + | "," -> Token (env, T_COMMA) + | ":" -> Token (env, T_COLON) + | "?." -> Token (env, T_PLING_PERIOD) + | "?" -> Token (env, T_PLING) + | "[" -> Token (env, T_LBRACKET) + | "]" -> Token (env, T_RBRACKET) + (* Generics *) + | "<" -> Token (env, T_LESS_THAN) + | ">" -> Token (env, T_GREATER_THAN) + (* Generic default *) + | "=" -> Token (env, T_ASSIGN) + (* Optional or nullable *) + | "?" -> Token (env, T_PLING) + (* Existential *) + | "*" -> Token (env, T_MULT) + (* Annotation or bound *) + | ":" -> Token (env, T_COLON) + (* Union *) + | '|' -> Token (env, T_BIT_OR) + (* Intersection *) + | '&' -> Token (env, T_BIT_AND) + (* typeof *) + | "typeof" -> Token (env, T_TYPEOF) + (* Function type *) + | "=>" -> Token (env, T_ARROW) + (* Type alias *) + | '=' -> Token (env, T_ASSIGN) + (* Variance annotations *) + | '+' -> Token (env, T_PLUS) + | '-' -> Token (env, T_MINUS) + (* Others *) + | eof -> + let env = + if is_in_comment_syntax env then + let loc = loc_of_lexbuf env lexbuf in + lex_error env loc Parse_error.UnexpectedEOS + else + env + in + Token (env, T_EOF) + | any -> Token (env, T_ERROR (lexeme lexbuf)) + | _ -> failwith "unreachable type_token" + +(* Lexing JSX children requires a string buffer to keep track of whitespace + * *) +let jsx_child env = + (* yes, the _start_ of the child is the _end_pos_ of the lexbuf! *) + let start = end_pos_of_lexbuf env env.lex_lb in + let buf = Buffer.create 127 in + let raw = Buffer.create 127 in + let (env, child) = jsx_child env start buf raw env.lex_lb in + let loc = loc_of_token env child in + let lex_errors_acc = env.lex_state.lex_errors_acc in + if lex_errors_acc = [] then + (env, { Lex_result.lex_token = child; lex_loc = loc; lex_comments = []; lex_errors = [] }) + else + ( { env with lex_state = { lex_errors_acc = [] } }, + { + Lex_result.lex_token = child; + lex_loc = loc; + lex_comments = []; + lex_errors = List.rev lex_errors_acc; + } + ) + +let wrap f = + let rec helper comments env = + match f env env.lex_lb with + | Token (env, t) -> + let loc = loc_of_token env t in + let lex_comments = + if comments = [] then + [] + else + List.rev comments + in + let lex_token = t in + let lex_errors_acc = env.lex_state.lex_errors_acc in + if lex_errors_acc = [] then + ( { env with lex_last_loc = loc }, + { Lex_result.lex_token; lex_loc = loc; lex_comments; lex_errors = [] } + ) + else + ( { env with lex_last_loc = loc; lex_state = Lex_env.empty_lex_state }, + { + Lex_result.lex_token; + lex_loc = loc; + lex_comments; + lex_errors = List.rev lex_errors_acc; + } + ) + | Comment (env, ((loc, _) as comment)) -> + let env = { env with lex_last_loc = loc } in + helper (comment :: comments) env + | Continue env -> helper comments env + in + (fun env -> helper [] env) + +let regexp = wrap regexp + +let jsx_tag = wrap jsx_tag + +let template_tail = wrap template_tail + +let type_token = wrap type_token + +let token = wrap token + +let is_valid_identifier_name lexbuf = + match%sedlex lexbuf with + | (js_id_start, Star js_id_continue, eof) -> true + | _ -> false diff --git a/flow/parser/flow_map.ml b/flow/parser/flow_map.ml new file mode 100644 index 0000000000..8d15c7ce1e --- /dev/null +++ b/flow/parser/flow_map.ml @@ -0,0 +1,855 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file LICENSE. *) +(* *) +(***********************************************************************) + +(* This module has been inspired from the OCaml standard library. + * There are some modifications to make it run fast. + * - It adds a Leaf node to avoid excessive allocation for singleton map + * - In the hot [bal] function when we know it has to be [Node], we do + * an unsafe cast to avoid some unneeded tests + * - Functions not needing comparison functions are lifted outside functors + * - Leaf node is cast as a tuple to save some allocations + * - We add some utilities e.g, [adjust] and can add more relying on the + * internals in the future + *) + +type ('k, 'v) t0 = + | Empty + | Leaf of { + v: 'k; + d: 'v; + } + | Node of { + h: int; + v: 'k; + d: 'v; + l: ('k, 'v) t0; + r: ('k, 'v) t0; + } + +type ('k, 'v) partial_node = { + h: int; + v: 'k; + d: 'v; + l: ('k, 'v) t0; + r: ('k, 'v) t0; +} + +type ('k, 'v) leaf_tuple = 'k * 'v + +external ( ~!! ) : ('k, 'v) t0 -> ('k, 'v) leaf_tuple = "%identity" + +external ( ~! ) : ('k, 'v) t0 -> ('k, 'v) partial_node = "%identity" + +let[@inline] height = function + | Empty -> 0 + | Leaf _ -> 1 + | Node { h; _ } -> h + +let singleton x d = Leaf { v = x; d } + +let sorted_two_nodes_larger node v d = Node { l = node; v; d; r = Empty; h = 2 } + +let sorted_two_nodes_smaller v d node = Node { l = Empty; v; d; r = node; h = 2 } + +let create l x d r = + let hl = height l in + let hr = height r in + let h = + if hl >= hr then + hl + 1 + else + hr + 1 + in + if h = 1 then + singleton x d + else + Node { l; v = x; d; r; h } + +(* The result can not be leaf *) +let node l x d r = + let hl = height l in + let hr = height r in + let h = + if hl >= hr then + hl + 1 + else + hr + 1 + in + Node { l; v = x; d; r; h } + +let bal l x d r = + let hl = height l in + let hr = height r in + if hl > hr + 2 then + let { l = ll; v = lv; d = ld; r = lr; _ } = ~!l in + if height ll >= height lr then + node ll lv ld (create lr x d r) + else + let { l = lrl; v = lrv; d = lrd; r = lrr; _ } = ~!lr in + node (create ll lv ld lrl) lrv lrd (create lrr x d r) + else if hr > hl + 2 then + let { l = rl; v = rv; d = rd; r = rr; _ } = ~!r in + if height rr >= height rl then + node (create l x d rl) rv rd rr + else + let { l = rll; v = rlv; d = rld; r = rlr; _ } = ~!rl in + node (create l x d rll) rlv rld (create rlr rv rd rr) + else + create l x d r + +let empty = Empty + +let[@inline] is_empty = function + | Empty -> true + | _ -> false + +type ('key, 'a) enumeration = + | End + | More of 'key * 'a * ('key, 'a) t0 * ('key, 'a) enumeration + +let rec cons_enum m e = + match m with + | Empty -> e + | Leaf { v; d } -> More (v, d, empty, e) + | Node { l; v; d; r; _ } -> cons_enum l (More (v, d, r, e)) + +let rec min_binding tree = + match tree with + | Empty -> raise Not_found + | Leaf _ -> ~!!tree + | Node { l = Empty; v; d; _ } -> (v, d) + | Node { l; _ } -> min_binding l + +let rec min_binding_from_node_unsafe tree = + let { l; v; d; _ } = ~!tree in + match l with + | Empty -> (v, d) + | Leaf _ -> ~!!l + | Node _ -> min_binding_from_node_unsafe l + +let rec min_binding_opt tree = + match tree with + | Empty -> None + | Leaf { v; d } -> Some (v, d) + | Node { l = Empty; v; d; _ } -> Some (v, d) + | Node { l; _ } -> min_binding_opt l + +let rec max_binding tree = + match tree with + | Empty -> raise Not_found + | Leaf _ -> ~!!tree + | Node { v; d; r = Empty; _ } -> (v, d) + | Node { r; _ } -> max_binding r + +let rec max_binding_opt tree = + match tree with + | Empty -> None + | Leaf { v; d } -> Some (v, d) + | Node { v; d; r = Empty; _ } -> Some (v, d) + | Node { r; _ } -> max_binding_opt r + +let rec remove_min_binding_from_node_unsafe tree = + let { l; v; d; r; _ } = ~!tree in + match l with + | Empty -> r + | Leaf _ -> bal Empty v d r + | Node _ -> bal (remove_min_binding_from_node_unsafe l) v d r + +(* Beware: those two functions assume that the added k is *strictly* + smaller (or bigger) than all the present keys in the tree; it + does not test for equality with the current min (or max) key. + + Indeed, they are only used during the "join" operation which + respects this precondition. +*) + +let rec add_min_node node tree = + match tree with + | Empty -> node + | Leaf { v; d } -> sorted_two_nodes_larger node v d + | Node { l; v; d; r; _ } -> bal (add_min_node node l) v d r + +let rec add_min_binding k x tree = + match tree with + | Empty -> singleton k x + | Leaf _ -> sorted_two_nodes_smaller k x tree + | Node { l; v; d; r; _ } -> bal (add_min_binding k x l) v d r + +let rec add_max_node node tree = + match tree with + | Empty -> node + | Leaf { v; d; _ } -> sorted_two_nodes_smaller v d node + | Node { l; v; d; r; _ } -> bal l v d (add_max_node node r) + +let rec add_max_binding k x tree = + match tree with + | Empty -> singleton k x + | Leaf _ -> sorted_two_nodes_larger tree k x + | Node { l; v; d; r; _ } -> bal l v d (add_max_binding k x r) + +let internal_merge t1 t2 = + match (t1, t2) with + | (Empty, t) -> t + | (t, Empty) -> t + | (Leaf _, t) -> add_min_node t1 t + | (t, Leaf _) -> add_max_node t2 t + | (Node _, Node _) -> + let (x, d) = min_binding_from_node_unsafe t2 in + bal t1 x d (remove_min_binding_from_node_unsafe t2) + +(* Same as create and bal, but no assumptions are made on the + relative heights of l and r. *) + +let rec join l v d r = + match (l, r) with + | (Empty, _) -> add_min_binding v d r + | (_, Empty) -> add_max_binding v d l + | (Leaf _, Leaf _) -> Node { l; v; d; r; h = 2 } + | (Leaf _, Node { l = rl; v = rv; d = rd; r = rr; h = rh }) -> + if rh > 3 then + bal (join l v d rl) rv rd rr + else + create l v d r + | (Node { l = ll; v = lv; d = ld; r = lr; h = lh }, Leaf _) -> + if lh > 3 then + bal ll lv ld (join lr v d r) + else + create l v d r + | ( Node { l = ll; v = lv; d = ld; r = lr; h = lh }, + Node { l = rl; v = rv; d = rd; r = rr; h = rh } + ) -> + if lh > rh + 2 then + bal ll lv ld (join lr v d r) + else if rh > lh + 2 then + bal (join l v d rl) rv rd rr + else + create l v d r + +(* Merge two trees l and r into one. + All elements of l must precede the elements of r. + No assumption on the heights of l and r. *) + +let concat t1 t2 = + match (t1, t2) with + | (Empty, t) -> t + | (t, Empty) -> t + | (Leaf _, t) -> add_min_node t1 t + | (t, Leaf _) -> add_max_node t2 t + | (Node _, Node _) -> + let (x, d) = min_binding_from_node_unsafe t2 in + join t1 x d (remove_min_binding_from_node_unsafe t2) + +let concat_or_join t1 v d t2 = + match d with + | Some d -> join t1 v d t2 + | None -> concat t1 t2 + +let rec iter f = function + | Empty -> () + | Leaf { v; d } -> f v d + | Node { l; v; d; r; _ } -> + iter f l; + f v d; + iter f r + +let rec map f = function + | Empty -> Empty + | Leaf { v; d } -> + let d' = f d in + Leaf { v; d = d' } + | Node { l; v; d; r; h } -> + let l' = map f l in + let d' = f d in + let r' = map f r in + Node { l = l'; v; d = d'; r = r'; h } + +let rec mapi f = function + | Empty -> Empty + | Leaf { v; d } -> + let d' = f v d in + Leaf { v; d = d' } + | Node { l; v; d; r; h } -> + let l' = mapi f l in + let d' = f v d in + let r' = mapi f r in + Node { l = l'; v; d = d'; r = r'; h } + +let rec fold f m accu = + match m with + | Empty -> accu + | Leaf { v; d } -> f v d accu + | Node { l; v; d; r; _ } -> fold f r (f v d (fold f l accu)) + +let rec keys_aux accu tree = + match tree with + | Empty -> accu + | Leaf { v; _ } -> v :: accu + | Node { l; v; r; _ } -> keys_aux (v :: keys_aux accu r) l + +let keys s = keys_aux [] s + +let ordered_keys = keys + +let rec for_all p = function + | Empty -> true + | Leaf { v; d } -> p v d + | Node { l; v; d; r; _ } -> p v d && for_all p l && for_all p r + +let rec exists p = function + | Empty -> false + | Leaf { v; d } -> p v d + | Node { l; v; d; r; _ } -> p v d || exists p l || exists p r + +let rec filter p tree = + match tree with + | Empty -> Empty + | Leaf { v; d } -> + if p v d then + tree + else + empty + | Node { l; v; d; r; _ } as m -> + (* call [p] in the expected left-to-right order *) + let l' = filter p l in + let pvd = p v d in + let r' = filter p r in + if pvd then + if l == l' && r == r' then + m + else + join l' v d r' + else + concat l' r' + +let rec cardinal = function + | Empty -> 0 + | Leaf _ -> 1 + | Node { l; r; _ } -> cardinal l + 1 + cardinal r + +let rec bindings_aux accu tree = + match tree with + | Empty -> accu + | Leaf _ -> ~!!tree :: accu + | Node { l; v; d; r; _ } -> bindings_aux ((v, d) :: bindings_aux accu r) l + +let bindings s = bindings_aux [] s + +type ('k, 'v) t1 = ('k, 'v) t0 = + | Empty + | Leaf of { + v: 'k; + d: 'v; + } + | Node of { + h: int; + v: 'k; + d: 'v; + l: ('k, 'v) t0; + r: ('k, 'v) t0; + } + +module type OrderedType = sig + type t + + val compare : t -> t -> int + (* val equal : t -> t -> bool *) +end + +module type S = sig + type key + + type +'a t + + val empty : 'a t + + val is_empty : 'a t -> bool + + val mem : key -> 'a t -> bool + + val add : key -> 'a -> 'a t -> 'a t + + val update : key -> ('a option -> 'a option) -> 'a t -> 'a t + + val adjust : key -> ('a option -> 'a) -> 'a t -> 'a t + + val singleton : key -> 'a -> 'a t + + (* when [remove k map] failed to remove [k], the original [map] is returned *) + val remove : key -> 'a t -> 'a t + + val merge : (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t + + val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t + + val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int + + val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + + val iter : (key -> 'a -> unit) -> 'a t -> unit + + val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + + val for_all : (key -> 'a -> bool) -> 'a t -> bool + + val exists : (key -> 'a -> bool) -> 'a t -> bool + + val filter : (key -> 'a -> bool) -> 'a t -> 'a t + + val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t + + val cardinal : 'a t -> int + + val bindings : 'a t -> (key * 'a) list + + val min_binding : 'a t -> key * 'a + + val min_binding_opt : 'a t -> (key * 'a) option + + val max_binding : 'a t -> key * 'a + + val max_binding_opt : 'a t -> (key * 'a) option + + val keys : 'a t -> key list + + val ordered_keys : 'a t -> key list + + val ident_map_key : ?combine:('a -> 'a -> 'a) -> (key -> key) -> 'a t -> 'a t + + val choose : 'a t -> key * 'a + + val choose_opt : 'a t -> (key * 'a) option + + val split : key -> 'a t -> 'a t * 'a option * 'a t + + val find : key -> 'a t -> 'a + + val find_opt : key -> 'a t -> 'a option + + val map : ('a -> 'b) -> 'a t -> 'b t + + val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t +end + +module Make (Ord : OrderedType) : S with type key = Ord.t = struct + type key = Ord.t + + type 'a t = (key, 'a) t1 + + let rec add x data m = + match m with + | Empty -> singleton x data + | Leaf { v; d } -> + let c = Ord.compare x v in + if c = 0 then + if d == data then + m + else + Leaf { v; d = data } + else if c < 0 then + sorted_two_nodes_smaller x data m + else + sorted_two_nodes_larger m x data + | Node { l; v; d; r; h } as m -> + let c = Ord.compare x v in + if c = 0 then + if d == data then + m + else + Node { l; v = x; d = data; r; h } + else if c < 0 then + let ll = add x data l in + if l == ll then + m + else + bal ll v d r + else + let rr = add x data r in + if r == rr then + m + else + bal l v d rr + + let rec find x = function + | Empty -> raise Not_found + | Leaf { v; d } -> + let c = Ord.compare x v in + if c = 0 then + d + else + raise Not_found + | Node { l; v; d; r; _ } -> + let c = Ord.compare x v in + if c = 0 then + d + else + find + x + ( if c < 0 then + l + else + r + ) + + let rec find_opt x = function + | Empty -> None + | Leaf { v; d } -> + let c = Ord.compare x v in + if c = 0 then + Some d + else + None + | Node { l; v; d; r; _ } -> + let c = Ord.compare x v in + if c = 0 then + Some d + else + find_opt + x + ( if c < 0 then + l + else + r + ) + + let rec mem x = function + | Empty -> false + | Leaf { v; _ } -> Ord.compare x v = 0 + | Node { l; v; r; _ } -> + let c = Ord.compare x v in + c = 0 + || mem + x + ( if c < 0 then + l + else + r + ) + + let rec remove x tree = + match tree with + | Empty -> tree + | Leaf { v; _ } -> + let c = Ord.compare x v in + if c = 0 then + empty + else + tree + | Node { l; v; d; r; _ } as m -> + let c = Ord.compare x v in + if c = 0 then + internal_merge l r + else if c < 0 then + let ll = remove x l in + if l == ll then + m + else + bal ll v d r + else + let rr = remove x r in + if r == rr then + m + else + bal l v d rr + + let rec adjust x (f : 'a option -> 'a) tree = + match tree with + | Empty -> + let data = f None in + singleton x data + | Leaf { v; d } -> + (* check *) + let c = Ord.compare x v in + if c = 0 then + let data = f (Some d) in + if d == data then + tree + else + Leaf { v; d = data } + else + let data = f None in + if c < 0 then + sorted_two_nodes_smaller x data tree + else + sorted_two_nodes_larger tree x data + | Node { l; v; d; r; h } as m -> + let c = Ord.compare x v in + if c = 0 then + let data = f (Some d) in + if d == data then + m + else + Node { l; v = x; d = data; r; h } + else if c < 0 then + let ll = adjust x f l in + if l == ll then + m + else + bal ll v d r + else + let rr = adjust x f r in + if r == rr then + m + else + bal l v d rr + + let rec update x f tree = + match tree with + | Empty -> + begin + match f None with + | None -> Empty + | Some data -> singleton x data + end + | Leaf { v; d } -> + (* check *) + let c = Ord.compare x v in + if c = 0 then + match f (Some d) with + | None -> empty (* It exists, None means deletion *) + | Some data -> + if d == data then + tree + else + Leaf { v; d = data } + else begin + match f None with + | None -> tree + | Some data -> + if c < 0 then + sorted_two_nodes_smaller x data tree + else + sorted_two_nodes_larger tree x data + end + | Node { l; v; d; r; h } as m -> + let c = Ord.compare x v in + if c = 0 then + match f (Some d) with + | None -> internal_merge l r + | Some data -> + if d == data then + m + else + Node { l; v = x; d = data; r; h } + else if c < 0 then + let ll = update x f l in + if l == ll then + m + else + bal ll v d r + else + let rr = update x f r in + if r == rr then + m + else + bal l v d rr + + let rec split x tree = + match tree with + | Empty -> (Empty, None, Empty) + | Leaf { v; d } -> + let c = Ord.compare x v in + if c = 0 then + (empty, Some d, empty) + else if c < 0 then + (empty, None, tree) + else + (tree, None, empty) + | Node { l; v; d; r; _ } -> + let c = Ord.compare x v in + if c = 0 then + (l, Some d, r) + else if c < 0 then + let (ll, pres, rl) = split x l in + (ll, pres, join rl v d r) + else + let (lr, pres, rr) = split x r in + (join l v d lr, pres, rr) + + let rec merge f s1 s2 = + match (s1, s2) with + | (Empty, Empty) -> Empty + | (Leaf { v; d }, Empty) -> + begin + match f v (Some d) None with + | None -> empty + | Some data -> Leaf { v; d = data } + end + | (Empty, Leaf { v; d }) -> + begin + match f v None (Some d) with + | None -> empty + | Some data -> Leaf { v; d = data } + end + | (Leaf { v = v1; d = d1 }, Leaf _) -> + let (l2, d2, r2) = split v1 s2 in + concat_or_join (merge f empty l2) v1 (f v1 (Some d1) d2) (merge f empty r2) + | (Node { l = l1; v = v1; d = d1; r = r1; h = h1 }, _) when h1 >= height s2 -> + let (l2, d2, r2) = split v1 s2 in + concat_or_join (merge f l1 l2) v1 (f v1 (Some d1) d2) (merge f r1 r2) + | (_, Node { l = l2; v = v2; d = d2; r = r2; _ }) -> + let (l1, d1, r1) = split v2 s1 in + concat_or_join (merge f l1 l2) v2 (f v2 d1 (Some d2)) (merge f r1 r2) + | (Node _, (Empty | Leaf _)) -> assert false + + let rec union f s1 s2 = + match (s1, s2) with + | (Empty, s) + | (s, Empty) -> + s + | (s, Leaf { v; d }) -> + update + v + (fun d2 -> + match d2 with + | None -> Some d + | Some d2 -> f v d2 d) + s + | (Leaf { v; d }, s) -> + (* add v d s *) + update + v + (fun d2 -> + match d2 with + | None -> Some d + | Some d2 -> f v d d2) + s + | ( Node { l = l1; v = v1; d = d1; r = r1; h = h1 }, + Node { l = l2; v = v2; d = d2; r = r2; h = h2 } + ) -> + if h1 >= h2 then + let (l2, d2, r2) = split v1 s2 in + let l = union f l1 l2 and r = union f r1 r2 in + match d2 with + | None -> join l v1 d1 r + | Some d2 -> concat_or_join l v1 (f v1 d1 d2) r + else + let (l1, d1, r1) = split v2 s1 in + let l = union f l1 l2 and r = union f r1 r2 in + (match d1 with + | None -> join l v2 d2 r + | Some d1 -> concat_or_join l v2 (f v2 d1 d2) r) + + let rec partition p tree = + match tree with + | Empty -> (Empty, Empty) + | Leaf { v; d } -> + if p v d then + (tree, empty) + else + (empty, tree) + | Node { l; v; d; r; _ } -> + (* call [p] in the expected left-to-right order *) + let (lt, lf) = partition p l in + let pvd = p v d in + let (rt, rf) = partition p r in + if pvd then + (join lt v d rt, concat lf rf) + else + (concat lt rt, join lf v d rf) + + let compare cmp m1 m2 = + let rec compare_aux e1 e2 = + match (e1, e2) with + | (End, End) -> 0 + | (End, _) -> -1 + | (_, End) -> 1 + | (More (v1, d1, r1, e1), More (v2, d2, r2, e2)) -> + let c = Ord.compare v1 v2 in + if c <> 0 then + c + else + let c = cmp d1 d2 in + if c <> 0 then + c + else + compare_aux (cons_enum r1 e1) (cons_enum r2 e2) + in + compare_aux (cons_enum m1 End) (cons_enum m2 End) + + let equal cmp m1 m2 = + let rec equal_aux e1 e2 = + match (e1, e2) with + | (End, End) -> true + | (End, _) -> false + | (_, End) -> false + | (More (v1, d1, r1, e1), More (v2, d2, r2, e2)) -> + Ord.compare v1 v2 = 0 && cmp d1 d2 && equal_aux (cons_enum r1 e1) (cons_enum r2 e2) + in + equal_aux (cons_enum m1 End) (cons_enum m2 End) + + let cardinal = cardinal + + let bindings = bindings + + let keys = keys + + let choose = min_binding + + let choose_opt = min_binding_opt + + let empty = empty + + let singleton = singleton + + let is_empty = is_empty + + let min_binding = min_binding + + let min_binding_opt = min_binding_opt + + let max_binding = max_binding + + let max_binding_opt = max_binding_opt + + let fold = fold + + let iter = iter + + let for_all = for_all + + let exists = exists + + let mapi = mapi + + let map = map + + let filter = filter + + let ordered_keys = keys + + let ident_map_key ?combine f map = + let (map_, changed) = + fold + (fun key item (map_, changed) -> + let new_key = f key in + ( (* add ?combine new_key item map_ *) + (match combine with + | None -> add new_key item map_ + | Some combine -> + adjust + new_key + (fun opt -> + match opt with + | None -> item + | Some old_value -> combine old_value item) + map_), + changed || new_key != key + )) + map + (empty, false) + in + if changed then + map_ + else + map +end diff --git a/flow/parser/flow_parser.ml b/flow/parser/flow_parser.ml new file mode 100644 index 0000000000..d3af7f0da0 --- /dev/null +++ b/flow/parser/flow_parser.ml @@ -0,0 +1,22 @@ +module Ast = Flow_ast + +let options : Parser_env.parse_options = +{ + enums = false; + esproposal_decorators = false; + esproposal_export_star_as = false; + types = false; + use_strict = true +} + +let program f = + let ic = open_in_bin f in + let len = in_channel_length ic in + let content = really_input_string ic len in + close_in ic; + Parser_flow.parse_program true (Some (File_key.SourceFile f)) content + + +let expression content = + let env = Parser_env.init_env ?token_sink:None ?parse_options:None None content in + Parser_flow.parse_expression env true diff --git a/flow/parser/flow_sedlexing.ml b/flow/parser/flow_sedlexing.ml new file mode 100644 index 0000000000..113d82ccf1 --- /dev/null +++ b/flow/parser/flow_sedlexing.ml @@ -0,0 +1,264 @@ +(* The package sedlex is released under the terms of an MIT-like license. *) +(* See the attached LICENSE file. *) +(* Copyright 2005, 2013 by Alain Frisch and LexiFi. *) +external ( .!()<- ) : int array -> int -> int -> unit = "%array_unsafe_set" +external ( .!() ) : int array -> int -> int = "%array_unsafe_get" +external ( .![] ) : string -> int -> char = "%string_unsafe_get" +external ( .![]<- ) : bytes -> int -> char -> unit = "%bytes_unsafe_set" + +exception InvalidCodepoint of int + +exception MalFormed + +(* Absolute position from the beginning of the stream *) +type apos = int + +type lexbuf = { + mutable buf: int array; + (* Number of meaningful char in buffer *) + mutable len: int; + (* Position of the first char in buffer in the input stream *) + mutable offset: apos; + (* pos is the index in the buffer *) + mutable pos: int; + (* bol is the index in the input stream but not buffer *) + mutable curr_bol: int; + (* start from 1, if it is 0, we would not track postion info for you *) + mutable curr_line: int; + (* First char we need to keep visible *) + mutable start_pos: int; + mutable start_bol: int; + mutable start_line: int; + mutable marked_pos: int; + mutable marked_bol: int; + mutable marked_line: int; + mutable marked_val: int; +} + +let lexbuf_clone (x : lexbuf) : lexbuf = + { + buf = x.buf; + len = x.len; + offset = x.offset; + pos = x.pos; + curr_bol = x.curr_bol; + curr_line = x.curr_line; + start_pos = x.start_pos; + start_bol = x.start_bol; + start_line = x.start_line; + marked_pos = x.marked_pos; + marked_bol = x.marked_bol; + marked_line = x.marked_line; + marked_val = x.marked_val; + } + +let empty_lexbuf = + { + buf = [||]; + len = 0; + offset = 0; + pos = 0; + curr_bol = 0; + curr_line = 0; + start_pos = 0; + start_bol = 0; + start_line = 0; + marked_pos = 0; + marked_bol = 0; + marked_line = 0; + marked_val = 0; + } + +let from_int_array a = + let len = Array.length a in + { empty_lexbuf with buf = a; len } + +let from_int_sub_array a len = + { empty_lexbuf with buf = a; len } + +let new_line lexbuf = + if lexbuf.curr_line != 0 then lexbuf.curr_line <- lexbuf.curr_line + 1; + lexbuf.curr_bol <- lexbuf.pos + lexbuf.offset + +let next lexbuf : Stdlib.Uchar.t option = + if lexbuf.pos = lexbuf.len then + None + else + let ret = lexbuf.buf.!(lexbuf.pos) in + lexbuf.pos <- lexbuf.pos + 1; + if ret = 10 then new_line lexbuf; + Some (Stdlib.Uchar.unsafe_of_int ret) + +let __private__next_int lexbuf : int = + if lexbuf.pos = lexbuf.len then + -1 + else + let ret = lexbuf.buf.!(lexbuf.pos) in + lexbuf.pos <- lexbuf.pos + 1; + if ret = 10 then new_line lexbuf; + ret + +let mark lexbuf i = + lexbuf.marked_pos <- lexbuf.pos; + lexbuf.marked_bol <- lexbuf.curr_bol; + lexbuf.marked_line <- lexbuf.curr_line; + lexbuf.marked_val <- i + +let start lexbuf = + lexbuf.start_pos <- lexbuf.pos; + lexbuf.start_bol <- lexbuf.curr_bol; + lexbuf.start_line <- lexbuf.curr_line; + mark lexbuf (-1) + +let backtrack lexbuf = + lexbuf.pos <- lexbuf.marked_pos; + lexbuf.curr_bol <- lexbuf.marked_bol; + lexbuf.curr_line <- lexbuf.marked_line; + lexbuf.marked_val + +let rollback lexbuf = + lexbuf.pos <- lexbuf.start_pos; + lexbuf.curr_bol <- lexbuf.start_bol; + lexbuf.curr_line <- lexbuf.start_line + +let lexeme_start lexbuf = lexbuf.start_pos + lexbuf.offset + +let lexeme_end lexbuf = lexbuf.pos + lexbuf.offset + +let loc lexbuf = (lexbuf.start_pos + lexbuf.offset, lexbuf.pos + lexbuf.offset) + +let lexeme_length lexbuf = lexbuf.pos - lexbuf.start_pos + +let sub_lexeme lexbuf pos len = Array.sub lexbuf.buf (lexbuf.start_pos + pos) len + +let lexeme lexbuf = Array.sub lexbuf.buf lexbuf.start_pos (lexbuf.pos - lexbuf.start_pos) + + +(* Decode UTF-8 encoded [s] into codepoints in [a], returning the length of the + * decoded string. + * + * To call this function safely: + * - ensure that [slen] is not greater than the length of [s] + * - ensure that [a] has enough capacity to hold the decoded value + *) +let unsafe_utf8_of_string (s : string) slen (a : int array) : int = + let spos = ref 0 in + let apos = ref 0 in + while !spos < slen do + let spos_code = s.![!spos] in + (match spos_code with + | '\000' .. '\127' as c -> + a.!(!apos) <- Char.code c; + incr spos + | '\192' .. '\223' as c -> + let n1 = Char.code c in + let n2 = Char.code s.![!spos + 1] in + if n2 lsr 6 != 0b10 then raise MalFormed; + a.!(!apos) <- ((n1 land 0x1f) lsl 6) lor (n2 land 0x3f); + spos := !spos + 2 + | '\224' .. '\239' as c -> + let n1 = Char.code c in + let n2 = Char.code s.![!spos + 1] in + let n3 = Char.code s.![!spos + 2] in + let p = ((n1 land 0x0f) lsl 12) lor ((n2 land 0x3f) lsl 6) lor (n3 land 0x3f) in + if (n2 lsr 6 != 0b10 || n3 lsr 6 != 0b10) || (p >= 0xd800 && p <= 0xdf00) then raise MalFormed; + a.!(!apos) <- p; + spos := !spos + 3 + | '\240' .. '\247' as c -> + let n1 = Char.code c in + let n2 = Char.code s.![!spos + 1] in + let n3 = Char.code s.![!spos + 2] in + let n4 = Char.code s.![!spos + 3] in + if n2 lsr 6 != 0b10 || n3 lsr 6 != 0b10 || n4 lsr 6 != 0b10 then raise MalFormed; + a.!(!apos) <- + ((n1 land 0x07) lsl 18) + lor ((n2 land 0x3f) lsl 12) + lor ((n3 land 0x3f) lsl 6) + lor (n4 land 0x3f); + spos := !spos + 4 + | _ -> raise MalFormed); + incr apos + done; + !apos + +(* Encode the decoded codepoints in [a] as UTF-8 into [b], returning the length + * of the encoded string. + * + * To call this function safely: + * - ensure that [offset + len] is not greater than the length of [a] + * - ensure that [b] has sufficient capacity to hold the encoded value + *) +let unsafe_string_of_utf8 (a : int array) ~(offset : int) ~(len : int) (b : bytes) : int = + let apos = ref offset in + let len = ref len in + let i = ref 0 in + while !len > 0 do + let u = a.!(!apos) in + if u < 0 then + raise MalFormed + else if u <= 0x007F then begin + b.![!i] <- Char.unsafe_chr u; + incr i + end else if u <= 0x07FF then ( + b.![!i] <- Char.unsafe_chr (0xC0 lor (u lsr 6)); + b.![!i + 1] <- Char.unsafe_chr (0x80 lor (u land 0x3F)); + i := !i + 2 + ) else if u <= 0xFFFF then ( + b.![!i] <- Char.unsafe_chr (0xE0 lor (u lsr 12)); + b.![!i + 1] <- Char.unsafe_chr (0x80 lor ((u lsr 6) land 0x3F)); + b.![!i + 2] <- Char.unsafe_chr (0x80 lor (u land 0x3F)); + i := !i + 3 + ) else if u <= 0x10FFFF then ( + b.![!i] <- Char.unsafe_chr (0xF0 lor (u lsr 18)); + b.![!i + 1] <- Char.unsafe_chr (0x80 lor ((u lsr 12) land 0x3F)); + b.![!i + 2] <- Char.unsafe_chr (0x80 lor ((u lsr 6) land 0x3F)); + b.![!i + 3] <- Char.unsafe_chr (0x80 lor (u land 0x3F)); + i := !i + 4 + ) else + raise MalFormed; + incr apos; + decr len + done; + !i + +module Utf8 = struct + let from_string s = + let slen = String.length s in + let a = Array.make slen 0 in + let len = unsafe_utf8_of_string s slen a in + from_int_sub_array a len + + let sub_lexeme lexbuf pos len : string = + let offset = lexbuf.start_pos + pos in + let b = Bytes.create (len * 4) in + let buf = lexbuf.buf in + (* Assertion needed, since we make use of unsafe API below *) + assert (offset + len <= Array.length buf); + let i = unsafe_string_of_utf8 buf ~offset ~len b in + Bytes.sub_string b 0 i + + let lexeme lexbuf : string = + let offset = lexbuf.start_pos in + let len = lexbuf.pos - offset in + let b = Bytes.create (len * 4) in + let buf = lexbuf.buf in + let i = unsafe_string_of_utf8 buf ~offset ~len b in + Bytes.sub_string b 0 i + + let lexeme_to_buffer lexbuf buffer : unit = + let offset = lexbuf.start_pos in + let len = lexbuf.pos - offset in + let b = Bytes.create (len * 4) in + let buf = lexbuf.buf in + let i = unsafe_string_of_utf8 buf ~offset ~len b in + Buffer.add_subbytes buffer b 0 i + + let lexeme_to_buffer2 lexbuf buf1 buf2 : unit = + let offset = lexbuf.start_pos in + let len = lexbuf.pos - offset in + let b = Bytes.create (len * 4) in + let buf = lexbuf.buf in + let i = unsafe_string_of_utf8 buf ~offset ~len b in + Buffer.add_subbytes buf1 b 0 i; + Buffer.add_subbytes buf2 b 0 i +end diff --git a/flow/parser/flow_sedlexing.mli b/flow/parser/flow_sedlexing.mli new file mode 100644 index 0000000000..5f5c187ddb --- /dev/null +++ b/flow/parser/flow_sedlexing.mli @@ -0,0 +1,38 @@ + +(** This is a module provides the minimal Sedlexing suppport + It is mostly a subset of Sedlexing with two functions for performance reasons: + - Utf8.lexeme_to_buffer + - Utf8.lexeme_to_buffer2 +*) +exception InvalidCodepoint of int +exception MalFormed +type apos = int +type lexbuf +val lexbuf_clone : lexbuf -> lexbuf + +val from_int_array : int array -> lexbuf +val new_line : lexbuf -> unit +val next : lexbuf -> Uchar.t option + +(**/**) +val __private__next_int : lexbuf -> int +(**/**) + +val mark : lexbuf -> int -> unit +val start : lexbuf -> unit +val backtrack : lexbuf -> int +val rollback : lexbuf -> unit +val lexeme_start : lexbuf -> int +val lexeme_end : lexbuf -> int +val loc : lexbuf -> int * int +val lexeme_length : lexbuf -> int +val sub_lexeme : lexbuf -> int -> int -> int array +val lexeme : lexbuf -> int array +module Utf8 : sig + val from_string : string -> lexbuf + val sub_lexeme : lexbuf -> int -> int -> string + val lexeme : lexbuf -> string + (** This API avoids another allocation *) + val lexeme_to_buffer : lexbuf -> Buffer.t -> unit + val lexeme_to_buffer2 : lexbuf -> Buffer.t -> Buffer.t -> unit +end diff --git a/flow/parser/flow_set.ml b/flow/parser/flow_set.ml new file mode 100644 index 0000000000..59cc444d46 --- /dev/null +++ b/flow/parser/flow_set.ml @@ -0,0 +1,804 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file LICENSE. *) +(* *) +(***********************************************************************) + +(* This module has been inspired from the OCaml standard library. + * There are some modifications to make it run fast. + * - It adds a Leaf node to avoid excessive allocation for singleton set + * - In the hot [bal] function when we we know it has to be [Node], we do + * an unsafe cast to avoid some unneeded tests + * - Functions not need comparison functions are lifted outside functors + * - We can add more utilities relying on the internals in the future + *) + +module type OrderedType = sig + type t + + val compare : t -> t -> int +end + +module type S = sig + type elt + + type t + + val empty : t + + val is_empty : t -> bool + + val mem : elt -> t -> bool + + val add : elt -> t -> t + + val singleton : elt -> t + + val remove : elt -> t -> t + + val union : t -> t -> t + + val inter : t -> t -> t + + val disjoint : t -> t -> bool + + val diff : t -> t -> t + + val compare : t -> t -> int + + val equal : t -> t -> bool + + val subset : t -> t -> bool + + val iter : (elt -> unit) -> t -> unit + + val map : (elt -> elt) -> t -> t + + val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a + + val for_all : (elt -> bool) -> t -> bool + + val exists : (elt -> bool) -> t -> bool + + val filter : (elt -> bool) -> t -> t + + val partition : (elt -> bool) -> t -> t * t + + val cardinal : t -> int + + val elements : t -> elt list + + val min_elt : t -> elt + + val min_elt_opt : t -> elt option + + val max_elt : t -> elt + + val max_elt_opt : t -> elt option + + val choose : t -> elt + + val choose_opt : t -> elt option + + val find : elt -> t -> elt + + val find_opt : elt -> t -> elt option + + val to_seq : t -> elt Seq.t + + val of_list : elt list -> t + + val make_pp : (Format.formatter -> elt -> unit) -> Format.formatter -> t -> unit +end + +type 'elt t0 = + | Empty + | Leaf of 'elt + | Node of { + h: int; + v: 'elt; + l: 'elt t0; + r: 'elt t0; + } + +type 'elt partial_node = { + h: int; + v: 'elt; + l: 'elt t0; + r: 'elt t0; +} + +external ( ~! ) : 'elt t0 -> 'elt partial_node = "%identity" + +type ('elt, 't) enumeration0 = + | End + | More of 'elt * 't * ('elt, 't) enumeration0 + +let rec cons_enum s e = + match s with + | Empty -> e + | Leaf v -> More (v, Empty, e) + | Node { l; v; r; _ } -> cons_enum l (More (v, r, e)) + +let rec seq_of_enum_ c () = + match c with + | End -> Seq.Nil + | More (x, t, rest) -> Seq.Cons (x, seq_of_enum_ (cons_enum t rest)) + +let to_seq c = seq_of_enum_ (cons_enum c End) + +let[@inline] height = function + | Empty -> 0 + | Leaf _ -> 1 + | Node { h; _ } -> h + +let[@inline] singleton x = Leaf x + +(* FIXME: we should check to avoid creating unneeded Node + - node + - Node + This function produce Node of height at least [1] +*) +let unsafe_node ~l ~v ~r = + match (l, r) with + | (Empty, Empty) -> singleton v + | (Leaf _, Empty) + | (Leaf _, Leaf _) + | (Empty, Leaf _) -> + Node { l; v; r; h = 2 } + | (Node { h; _ }, (Leaf _ | Empty)) + | ((Leaf _ | Empty), Node { h; _ }) -> + Node { l; v; r; h = h + 1 } + | (Node { h = hl; _ }, Node { h = hr; _ }) -> + let h = + if hl >= hr then + hl + 1 + else + hr + 1 + in + Node { l; v; r; h } + +(* Creates a new node with left son l, value v and right son r. + We must have all elements of l < v < all elements of r. + l and r must be balanced and | height l - height r | <= 2. + Inline expansion of height for better speed. *) + +let create l v r = + let hl = height l in + let hr = height r in + Node + { + l; + v; + r; + h = + ( if hl >= hr then + hl + 1 + else + hr + 1 + ); + } + +(* Same as create, but performs one step of rebalancing if necessary. + Assumes l and r balanced and | height l - height r | <= 3. + Inline expansion of create for better speed in the most frequent case + where no rebalancing is required. *) + +let bal l v r = + let hl = height l in + let hr = height r in + if hl > hr + 2 then + (* hl is at least of height > 2 [3], so it should be [Node] + Note having in-efficient nodes like [Node (empty,v,empty)] won't affect + correctness here, since it will be even more likely to be [Node] + But we are stricter with height + *) + let { l = ll; v = lv; r = lr; _ } = ~!l in + if height ll >= height lr then + create ll lv (unsafe_node ~l:lr ~v ~r) + else + (* Int his path hlr > hll while hl = hlr + 1 so [hlr] > 1, so it should be [Node]*) + let { l = lrl; v = lrv; r = lrr; _ } = ~!lr in + create (unsafe_node ~l:ll ~v:lv ~r:lrl) lrv (unsafe_node ~l:lrr ~v ~r) + else if hr > hl + 2 then + (* hr is at least of height > 2 [3], so it should be [Node] *) + let { l = rl; v = rv; r = rr; _ } = ~!r in + if height rr >= height rl then + create (unsafe_node ~l ~v ~r:rl) rv rr + else + (* In this path hrl > hrr while hr = hrl + 1, so [hrl] > 1, so it should be [Node] *) + let { l = rll; v = rlv; r = rlr; _ } = ~!rl in + create (unsafe_node ~l ~v ~r:rll) rlv (unsafe_node ~l:rlr ~v:rv ~r:rr) + else + unsafe_node ~l ~v ~r + +(* Beware: those two functions assume that the added v is *strictly* + smaller (or bigger) than all the present elements in the tree; it + does not test for equality with the current min (or max) element. + Indeed, they are only used during the "join" operation which + respects this precondition. +*) + +let rec add_min_element x = function + | Empty -> singleton x + | Leaf v -> unsafe_node ~l:(singleton x) ~v ~r:Empty + | Node { l; v; r; _ } -> bal (add_min_element x l) v r + +let rec add_max_element x = function + | Empty -> singleton x + | Leaf v -> unsafe_node ~l:Empty ~v ~r:(singleton x) + | Node { l; v; r; _ } -> bal l v (add_max_element x r) + +(* Same as create and bal, but no assumptions are made on the + relative heights of l and r. *) + +let rec join l v r = + match (l, r) with + | (Empty, _) -> add_min_element v r + | (_, Empty) -> add_max_element v l + | (Leaf _, Leaf _) -> unsafe_node ~l ~v ~r + | (Leaf _, Node { l = rl; v = rv; r = rr; h = rh }) -> + if rh > 3 then + bal (join l v rl) rv rr + else + create l v r + | (Node { l = ll; v = lv; r = lr; h = lh }, Leaf _) -> + if lh > 3 then + bal ll lv (join lr v r) + else + create l v r + | (Node { l = ll; v = lv; r = lr; h = lh }, Node { l = rl; v = rv; r = rr; h = rh }) -> + if lh > rh + 2 then + bal ll lv (join lr v r) + else if rh > lh + 2 then + bal (join l v rl) rv rr + else + create l v r + +(* Smallest and greatest element of a set *) + +let rec min_elt = function + | Empty -> raise Not_found + | Leaf v -> v + | Node { l = Empty; v; _ } -> v + | Node { l; _ } -> min_elt l + +let rec min_elt_opt = function + | Empty -> None + | Leaf v -> Some v + | Node { l = Empty; v; _ } -> Some v + | Node { l; _ } -> min_elt_opt l + +let rec max_elt = function + | Empty -> raise Not_found + | Node { v; r = Empty; _ } -> v + | Leaf v -> v + | Node { r; _ } -> max_elt r + +let rec max_elt_opt = function + | Empty -> None + | Node { v; r = Empty; _ } -> Some v + | Leaf v -> Some v + | Node { r; _ } -> max_elt_opt r + +(* Remove the smallest element of the given set *) + +let rec remove_min_elt = function + | Empty -> invalid_arg "Set.remove_min_elt" + | Leaf _ -> Empty + | Node { l = Empty; r; _ } -> r + | Node { l; v; r; _ } -> bal (remove_min_elt l) v r + +(* Merge two trees l and r into one. + All elements of l must precede the elements of r. + Assume | height l - height r | <= 2. *) + +let merge t1 t2 = + match (t1, t2) with + | (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> bal t1 (min_elt t2) (remove_min_elt t2) + +(* Merge two trees l and r into one. + All elements of l must precede the elements of r. + No assumption on the heights of l and r. *) + +let concat t1 t2 = + match (t1, t2) with + | (Empty, t) -> t + | (t, Empty) -> t + | (_, _) -> join t1 (min_elt t2) (remove_min_elt t2) + +let rec cardinal = function + | Empty -> 0 + | Leaf _ -> 1 + | Node { l; r; _ } -> cardinal l + 1 + cardinal r + +let rec elements_aux accu = function + | Empty -> accu + | Leaf v -> v :: accu + | Node { l; v; r; _ } -> elements_aux (v :: elements_aux accu r) l + +let elements s = elements_aux [] s + +let empty = Empty + +let[@inline] is_empty = function + | Empty -> true + | _ -> false + +let of_sorted_list l = + let rec sub n l = + match (n, l) with + | (0, l) -> (Empty, l) + | (1, x0 :: l) -> (singleton x0, l) + | (2, x0 :: x1 :: l) -> (Node { l = singleton x0; v = x1; r = Empty; h = 2 }, l) + | (3, x0 :: x1 :: x2 :: l) -> (Node { l = singleton x0; v = x1; r = singleton x2; h = 2 }, l) + | (n, l) -> + let nl = n / 2 in + let (left, l) = sub nl l in + (match l with + | [] -> assert false + | mid :: l -> + let (right, l) = sub (n - nl - 1) l in + (create left mid right, l)) + in + fst (sub (List.length l) l) + +type 'a t1 = 'a t0 = private + | Empty + | Leaf of 'a + | Node of { + h: int; + v: 'a; + l: 'a t0; + r: 'a t0; + } + +module Make (Ord : OrderedType) : S with type elt = Ord.t = struct + type elt = Ord.t + + type t = elt t1 + + let singleton = singleton + + (* Insertion of one element *) + let min_elt_opt = min_elt_opt + + let max_elt_opt = max_elt_opt + + let min_elt = min_elt + + let max_elt = max_elt + + let elements = elements + + let cardinal = cardinal + + let is_empty = is_empty + + let empty = empty + + let choose = min_elt + + let choose_opt = min_elt_opt + + let rec add x t = + match t with + | Empty -> singleton x + | Leaf v -> + let c = Ord.compare x v in + if c = 0 then + t + else if c < 0 then + unsafe_node ~l:(singleton x) ~v ~r:empty + else + unsafe_node ~l:t ~v:x ~r:empty + | Node { l; v; r; _ } as t -> + let c = Ord.compare x v in + if c = 0 then + t + else if c < 0 then + let ll = add x l in + if l == ll then + t + else + bal ll v r + else + let rr = add x r in + if r == rr then + t + else + bal l v rr + + let ( @> ) = add + (* Splitting. split x s returns a triple (l, present, r) where + - l is the set of elements of s that are < x + - r is the set of elements of s that are > x + - present is false if s contains no element equal to x, + or true if s contains an element equal to x. *) + + let rec split x tree = + match tree with + | Empty -> (empty, false, empty) + | Leaf v -> + let c = Ord.compare x v in + if c = 0 then + (empty, true, empty) + else if c < 0 then + (empty, false, tree) + else + (tree, false, empty) + | Node { l; v; r; _ } -> + let c = Ord.compare x v in + if c = 0 then + (l, true, r) + else if c < 0 then + let (ll, pres, rl) = split x l in + (ll, pres, join rl v r) + else + let (lr, pres, rr) = split x r in + (join l v lr, pres, rr) + + (* Implementation of the set operations *) + + let rec mem x = function + | Empty -> false + | Leaf v -> + let c = Ord.compare x v in + c = 0 + | Node { l; v; r; _ } -> + let c = Ord.compare x v in + c = 0 + || mem + x + ( if c < 0 then + l + else + r + ) + + let rec remove x tree = + match tree with + | Empty -> empty + | Leaf v -> + let c = Ord.compare x v in + if c = 0 then + empty + else + tree + | Node { l; v; r; _ } as t -> + let c = Ord.compare x v in + if c = 0 then + merge l r + else if c < 0 then + let ll = remove x l in + if l == ll then + t + else + bal ll v r + else + let rr = remove x r in + if r == rr then + t + else + bal l v rr + + let rec union s1 s2 = + match (s1, s2) with + | (Empty, t2) -> t2 + | (t1, Empty) -> t1 + | (Leaf v, s2) -> add v s2 + | (s1, Leaf v) -> add v s1 + | (Node { l = l1; v = v1; r = r1; h = h1 }, Node { l = l2; v = v2; r = r2; h = h2 }) -> + if h1 >= h2 then + if h2 = 1 then + add v2 s1 + else + let (l2, _, r2) = split v1 s2 in + join (union l1 l2) v1 (union r1 r2) + else if h1 = 1 then + add v1 s2 + else + let (l1, _, r1) = split v2 s1 in + join (union l1 l2) v2 (union r1 r2) + + let rec inter s1 s2 = + match (s1, s2) with + | (Empty, _) -> empty + | (_, Empty) -> empty + | (Leaf v, _) -> + if mem v s2 then + s1 + else + empty + | (Node { l = l1; v = v1; r = r1; _ }, t2) -> + (match split v1 t2 with + | (l2, false, r2) -> concat (inter l1 l2) (inter r1 r2) + | (l2, true, r2) -> join (inter l1 l2) v1 (inter r1 r2)) + + (* Same as split, but compute the left and right subtrees + only if the pivot element is not in the set. The right subtree + is computed on demand. *) + + type split_bis = + | Found + | NotFound of t * (unit -> t) + + let rec split_bis x = function + | Empty -> NotFound (empty, (fun () -> empty)) + | Leaf v -> + let c = Ord.compare x v in + if c = 0 then + Found + else + NotFound (empty, (fun () -> empty)) + | Node { l; v; r; _ } -> + let c = Ord.compare x v in + if c = 0 then + Found + else if c < 0 then + match split_bis x l with + | Found -> Found + | NotFound (ll, rl) -> NotFound (ll, (fun () -> join (rl ()) v r)) + else ( + match split_bis x r with + | Found -> Found + | NotFound (lr, rr) -> NotFound (join l v lr, rr) + ) + + let rec disjoint s1 s2 = + match (s1, s2) with + | (Empty, _) + | (_, Empty) -> + true + | (Leaf v, s) + | (s, Leaf v) -> + not (mem v s) + | (Node { l = l1; v = v1; r = r1; _ }, t2) -> + if s1 == s2 then + false + else ( + match split_bis v1 t2 with + | NotFound (l2, r2) -> disjoint l1 l2 && disjoint r1 (r2 ()) + | Found -> false + ) + + let rec diff s1 s2 = + match (s1, s2) with + | (Empty, _) -> empty + | (t1, Empty) -> t1 + | (Leaf v, _) -> + if mem v s2 then + empty + else + s1 + | (Node { l = l1; v = v1; r = r1; _ }, t2) -> + (match split v1 t2 with + | (l2, false, r2) -> join (diff l1 l2) v1 (diff r1 r2) + | (l2, true, r2) -> concat (diff l1 l2) (diff r1 r2)) + + let rec compare_aux e1 e2 = + match (e1, e2) with + | (End, End) -> 0 + | (End, _) -> -1 + | (_, End) -> 1 + | (More (v1, r1, e1), More (v2, r2, e2)) -> + let c = Ord.compare v1 v2 in + if c <> 0 then + c + else + compare_aux (cons_enum r1 e1) (cons_enum r2 e2) + + let compare s1 s2 = compare_aux (cons_enum s1 End) (cons_enum s2 End) + + let equal s1 s2 = compare s1 s2 = 0 + + let rec subset s1 s2 = + match (s1, s2) with + | (Empty, _) -> true + | (_, Empty) -> false + | (Leaf v1, Leaf v2) -> + let c = Ord.compare v1 v2 in + if c = 0 then + true + else + false + | (Node { v = v1; h; _ }, Leaf v2) -> + h = 1 + && (* conservative here *) + Ord.compare v1 v2 = 0 + | (Leaf v1, Node { l = l2; v = v2; r = r2; _ }) -> + let c = Ord.compare v1 v2 in + if c = 0 then + true + else if c < 0 then + subset s1 l2 + else + subset s1 r2 + | (Node { l = l1; v = v1; r = r1; _ }, (Node { l = l2; v = v2; r = r2; _ } as t2)) -> + let c = Ord.compare v1 v2 in + if c = 0 then + subset l1 l2 && subset r1 r2 + else if c < 0 then + (* Better to keep invariant here, since our unsafe code relies on such invariant + *) + subset (unsafe_node ~l:l1 ~v:v1 ~r:empty) l2 && subset r1 t2 + else + subset (unsafe_node ~l:empty ~v:v1 ~r:r1) r2 && subset l1 t2 + + let rec iter f = function + | Empty -> () + | Leaf v -> f v + | Node { l; v; r; _ } -> + iter f l; + f v; + iter f r + + let rec fold f s accu = + match s with + | Empty -> accu + | Leaf v -> f v accu + | Node { l; v; r; _ } -> fold f r (f v (fold f l accu)) + + let rec for_all p = function + | Empty -> true + | Leaf v -> p v + | Node { l; v; r; _ } -> p v && for_all p l && for_all p r + + let rec exists p = function + | Empty -> false + | Leaf v -> p v + | Node { l; v; r; _ } -> p v || exists p l || exists p r + + let rec filter p tree = + match tree with + | Empty -> empty + | Leaf v -> + let pv = p v in + if pv then + tree + else + empty + | Node { l; v; r; _ } as t -> + (* call [p] in the expected left-to-right order *) + let l' = filter p l in + let pv = p v in + let r' = filter p r in + if pv then + if l == l' && r == r' then + t + else + join l' v r' + else + concat l' r' + + let rec partition p tree = + match tree with + | Empty -> (empty, empty) + | Leaf v -> + let pv = p v in + if pv then + (tree, empty) + else + (empty, tree) + | Node { l; v; r; _ } -> + (* call [p] in the expected left-to-right order *) + let (lt, lf) = partition p l in + let pv = p v in + let (rt, rf) = partition p r in + if pv then + (join lt v rt, concat lf rf) + else + (concat lt rt, join lf v rf) + + let rec find x = function + | Empty -> raise Not_found + | Leaf v -> + let c = Ord.compare x v in + if c = 0 then + v + else + raise Not_found + | Node { l; v; r; _ } -> + let c = Ord.compare x v in + if c = 0 then + v + else + find + x + ( if c < 0 then + l + else + r + ) + + let rec find_opt x = function + | Empty -> None + | Leaf v -> + let c = Ord.compare x v in + if c = 0 then + Some v + else + None + | Node { l; v; r; _ } -> + let c = Ord.compare x v in + if c = 0 then + Some v + else + find_opt + x + ( if c < 0 then + l + else + r + ) + + let try_join l v r = + (* [join l v r] can only be called when (elements of l < v < + elements of r); use [try_join l v r] when this property may + not hold, but you hope it does hold in the common case *) + if (is_empty l || Ord.compare (max_elt l) v < 0) && (is_empty r || Ord.compare v (min_elt r) < 0) + then + join l v r + else + union l (add v r) + + let rec map f tree = + match tree with + | Empty -> empty + | Leaf v -> + let v' = f v in + if v == v' then + tree + else + singleton v' + | Node { l; v; r; _ } as t -> + (* enforce left-to-right evaluation order *) + let l' = map f l in + let v' = f v in + let r' = map f r in + if l == l' && v == v' && r == r' then + t + else + try_join l' v' r' + + let of_list l = + match l with + | [] -> empty + | [x0] -> singleton x0 + | [x0; x1] -> x1 @> singleton x0 + | [x0; x1; x2] -> x2 @> x1 @> singleton x0 + | [x0; x1; x2; x3] -> x3 @> x2 @> x1 @> singleton x0 + | [x0; x1; x2; x3; x4] -> x4 @> x3 @> x2 @> x1 @> singleton x0 + | _ -> of_sorted_list (List.sort_uniq Ord.compare l) + + let to_seq = to_seq + + let make_pp pp_key fmt iset = + Format.fprintf fmt "@[<2>{"; + let elements = elements iset in + (match elements with + | [] -> () + | _ -> Format.fprintf fmt " "); + ignore + (List.fold_left + (fun sep s -> + if sep then Format.fprintf fmt ";@ "; + pp_key fmt s; + true) + false + elements + ); + (match elements with + | [] -> () + | _ -> Format.fprintf fmt " "); + Format.fprintf fmt "@,}@]" +end diff --git a/flow/parser/jsx_parser.ml b/flow/parser/jsx_parser.ml new file mode 100644 index 0000000000..1b73518fd8 --- /dev/null +++ b/flow/parser/jsx_parser.ml @@ -0,0 +1,459 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +module Ast = Flow_ast +open Token +open Parser_common +open Parser_env +open Flow_ast + +module JSX (Parse : Parser_common.PARSER) = struct + (* Consumes and returns the trailing comments after the end of a JSX tag name, + attribute, or spread attribute. + + If the component is followed by the end of the JSX tag, then all trailing + comments are returned. If the component is instead followed by another tag + component on another line, only trailing comments on the same line are + returned. If the component is followed by another tag component on the same + line, all trailing comments will instead be leading the next component. *) + let tag_component_trailing_comments env = + match Peek.token env with + | T_EOF + | T_DIV + | T_GREATER_THAN -> + Eat.trailing_comments env + | _ when Peek.is_line_terminator env -> Eat.comments_until_next_line env + | _ -> [] + + let spread_attribute env = + let leading = Peek.comments env in + Eat.push_lex_mode env Lex_mode.NORMAL; + let (loc, argument) = + with_loc + (fun env -> + Expect.token env T_LCURLY; + Expect.token env T_ELLIPSIS; + let argument = Parse.assignment env in + Expect.token env T_RCURLY; + argument) + env + in + Eat.pop_lex_mode env; + let trailing = tag_component_trailing_comments env in + ( loc, + { + JSX.SpreadAttribute.argument; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + + let expression_container_contents env = + if Peek.token env = T_RCURLY then + JSX.ExpressionContainer.EmptyExpression + else + JSX.ExpressionContainer.Expression (Parse.expression env) + + let expression_container env = + let leading = Peek.comments env in + Eat.push_lex_mode env Lex_mode.NORMAL; + let (loc, expression) = + with_loc + (fun env -> + Expect.token env T_LCURLY; + let expression = expression_container_contents env in + Expect.token env T_RCURLY; + expression) + env + in + Eat.pop_lex_mode env; + let trailing = tag_component_trailing_comments env in + ( loc, + { + JSX.ExpressionContainer.expression; + comments = Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal:[] (); + } + ) + + let expression_container_or_spread_child env = + Eat.push_lex_mode env Lex_mode.NORMAL; + let (loc, result) = + with_loc + (fun env -> + Expect.token env T_LCURLY; + let result = + match Peek.token env with + | T_ELLIPSIS -> + let leading = Peek.comments env in + Expect.token env T_ELLIPSIS; + let expression = Parse.assignment env in + JSX.SpreadChild + { + JSX.SpreadChild.expression; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + | _ -> + let expression = expression_container_contents env in + let internal = + match expression with + | JSX.ExpressionContainer.EmptyExpression -> Peek.comments env + | _ -> [] + in + JSX.ExpressionContainer + { + JSX.ExpressionContainer.expression; + comments = Flow_ast_utils.mk_comments_with_internal_opt ~internal (); + } + in + Expect.token env T_RCURLY; + result) + env + in + Eat.pop_lex_mode env; + (loc, result) + + let identifier env = + let loc = Peek.loc env in + let name = + match Peek.token env with + | T_JSX_IDENTIFIER { raw } -> raw + | _ -> + error_unexpected ~expected:"an identifier" env; + "" + in + let leading = Peek.comments env in + Eat.token env; + (* Unless this identifier is the first part of a namespaced name, member + expression, or attribute name, it is the end of a tag component. *) + let trailing = + match Peek.token env with + (* Namespaced name *) + | T_COLON + (* Member expression *) + | T_PERIOD + (* Attribute name *) + | T_ASSIGN -> + Eat.trailing_comments env + | _ -> tag_component_trailing_comments env + in + (loc, JSX.Identifier.{ name; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () }) + + let name = + let rec member_expression env member = + match Peek.token env with + | T_PERIOD -> + let (start_loc, _) = member in + let member = + with_loc + ~start_loc + (fun env -> + Expect.token env T_PERIOD; + let property = identifier env in + { + JSX.MemberExpression._object = JSX.MemberExpression.MemberExpression member; + property; + }) + env + in + member_expression env member + | _ -> member + in + fun env -> + match Peek.ith_token ~i:1 env with + | T_COLON -> + let namespaced_name = + with_loc + (fun env -> + let namespace = identifier env in + Expect.token env T_COLON; + let name = identifier env in + { JSX.NamespacedName.namespace; name }) + env + in + JSX.NamespacedName namespaced_name + | T_PERIOD -> + let member = + with_loc + (fun env -> + let _object = JSX.MemberExpression.Identifier (identifier env) in + Expect.token env T_PERIOD; + let property = identifier env in + { JSX.MemberExpression._object; property }) + env + in + JSX.MemberExpression (member_expression env member) + | _ -> + let name = identifier env in + JSX.Identifier name + + let attribute env = + with_loc + (fun env -> + let name = + match Peek.ith_token ~i:1 env with + | T_COLON -> + let namespaced_name = + with_loc + (fun env -> + let namespace = identifier env in + Expect.token env T_COLON; + let name = identifier env in + { JSX.NamespacedName.namespace; name }) + env + in + JSX.Attribute.NamespacedName namespaced_name + | _ -> + let name = identifier env in + JSX.Attribute.Identifier name + in + let value = + match Peek.token env with + | T_ASSIGN -> + Expect.token env T_ASSIGN; + let leading = Peek.comments env in + let tkn = Peek.token env in + begin + match tkn with + | T_LCURLY -> + let (loc, expression_container) = expression_container env in + JSX.ExpressionContainer.( + match expression_container.expression with + | EmptyExpression -> + error_at env (loc, Parse_error.JSXAttributeValueEmptyExpression) + | _ -> () + ); + Some (JSX.Attribute.ExpressionContainer (loc, expression_container)) + | T_JSX_TEXT (loc, value, raw) as token -> + Expect.token env token; + let value = Ast.Literal.String value in + let trailing = tag_component_trailing_comments env in + Some + (JSX.Attribute.Literal + ( loc, + { + Ast.Literal.value; + raw; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + ) + | _ -> + error env Parse_error.InvalidJSXAttributeValue; + let loc = Peek.loc env in + let raw = "" in + let value = Ast.Literal.String "" in + Some (JSX.Attribute.Literal (loc, { Ast.Literal.value; raw; comments = None })) + end + | _ -> None + in + { JSX.Attribute.name; value }) + env + + let opening_element = + let rec attributes env acc = + match Peek.token env with + | T_JSX_IDENTIFIER _ -> + let attribute = JSX.Opening.Attribute (attribute env) in + attributes env (attribute :: acc) + | T_LCURLY -> + let attribute = JSX.Opening.SpreadAttribute (spread_attribute env) in + attributes env (attribute :: acc) + | _ -> List.rev acc + in + fun env -> + with_loc + (fun env -> + Expect.token env T_LESS_THAN; + match Peek.token env with + | T_GREATER_THAN -> + Eat.token env; + Ok `Fragment + | T_JSX_IDENTIFIER _ -> + let name = name env in + let attributes = attributes env [] in + let self_closing = Eat.maybe env T_DIV in + let element = `Element { JSX.Opening.name; self_closing; attributes } in + if Eat.maybe env T_GREATER_THAN then + Ok element + else ( + Expect.error env T_GREATER_THAN; + Error element + ) + | _ -> + (* TODO: also say that we could expect an identifier, or if we're in a JSX child + then suggest escaping the < as `{'<'}` *) + Expect.error env T_GREATER_THAN; + Error `Fragment) + env + + let closing_element env = + with_loc + (fun env -> + Expect.token env T_LESS_THAN; + Expect.token env T_DIV; + match Peek.token env with + | T_GREATER_THAN -> + Eat.token env; + `Fragment + | T_JSX_IDENTIFIER _ -> + let name = name env in + Expect.token_opt env T_GREATER_THAN; + `Element { JSX.Closing.name } + | _ -> + Expect.error env T_GREATER_THAN; + `Fragment) + env + + let rec child env = + match Peek.token env with + | T_LCURLY -> expression_container_or_spread_child env + | T_JSX_TEXT (loc, value, raw) as token -> + Expect.token env token; + (loc, JSX.Text { JSX.Text.value; raw }) + | _ -> + (match element_or_fragment env with + | (loc, `Element element) -> (loc, JSX.Element element) + | (loc, `Fragment fragment) -> (loc, JSX.Fragment fragment)) + + and element = + let children_and_closing = + let rec children_and_closing env acc = + let previous_loc = last_loc env in + match Peek.token env with + | T_LESS_THAN -> + Eat.push_lex_mode env Lex_mode.JSX_TAG; + begin + match (Peek.token env, Peek.ith_token ~i:1 env) with + | (T_LESS_THAN, T_EOF) + | (T_LESS_THAN, T_DIV) -> + let closing = + match closing_element env with + | (loc, `Element ec) -> `Element (loc, ec) + | (loc, `Fragment) -> `Fragment loc + in + (* We double pop to avoid going back to childmode and re-lexing the + * lookahead *) + Eat.double_pop_lex_mode env; + (List.rev acc, previous_loc, closing) + | _ -> + let child = + match element env with + | (loc, `Element e) -> (loc, JSX.Element e) + | (loc, `Fragment f) -> (loc, JSX.Fragment f) + in + children_and_closing env (child :: acc) + end + | T_EOF -> + error_unexpected env; + (List.rev acc, previous_loc, `None) + | _ -> children_and_closing env (child env :: acc) + in + fun env -> + let start_loc = Peek.loc env in + let (children, last_child_loc, closing) = children_and_closing env [] in + let last_child_loc = + match last_child_loc with + | Some x -> x + | None -> start_loc + in + (* It's a little bit tricky to untangle the parsing of the child elements from the parsing + * of the closing element, so we can't easily use `with_loc` here. Instead, we'll use the + * same logic that `with_loc` uses, but manipulate the locations explicitly. *) + let children_loc = Loc.btwn start_loc last_child_loc in + ((children_loc, children), closing) + in + let rec normalize name = + JSX.( + match name with + | Identifier (_, { Identifier.name; comments = _ }) -> name + | NamespacedName (_, { NamespacedName.namespace; name }) -> + (snd namespace).Identifier.name ^ ":" ^ (snd name).Identifier.name + | MemberExpression (_, { MemberExpression._object; property }) -> + let _object = + match _object with + | MemberExpression.Identifier (_, { Identifier.name = id; _ }) -> id + | MemberExpression.MemberExpression e -> normalize (JSX.MemberExpression e) + in + _object ^ "." ^ (snd property).Identifier.name + ) + in + let is_self_closing = function + | (_, Ok (`Element e)) -> e.JSX.Opening.self_closing + | (_, Ok `Fragment) -> false + | (_, Error _) -> true + in + fun env -> + let leading = Peek.comments env in + let opening_element = opening_element env in + Eat.pop_lex_mode env; + let (children, closing_element) = + if is_self_closing opening_element then + (with_loc (fun _ -> []) env, `None) + else ( + Eat.push_lex_mode env Lex_mode.JSX_CHILD; + children_and_closing env + ) + in + let trailing = Eat.trailing_comments env in + let end_loc = + match closing_element with + | `Element (loc, { JSX.Closing.name }) -> + (match snd opening_element with + | Ok (`Element { JSX.Opening.name = opening_name; _ }) -> + let opening_name = normalize opening_name in + if normalize name <> opening_name then + error env (Parse_error.ExpectedJSXClosingTag opening_name) + | Ok `Fragment -> error env (Parse_error.ExpectedJSXClosingTag "JSX fragment") + | Error _ -> ()); + loc + | `Fragment loc -> + (match snd opening_element with + | Ok (`Element { JSX.Opening.name = opening_name; _ }) -> + error env (Parse_error.ExpectedJSXClosingTag (normalize opening_name)) + | Ok `Fragment -> () + | Error _ -> ()); + loc + | _ -> fst opening_element + in + let result = + match opening_element with + | (start_loc, Ok (`Element e)) + | (start_loc, Error (`Element e)) -> + `Element + JSX. + { + opening_element = (start_loc, e); + closing_element = + (match closing_element with + | `Element e -> Some e + | _ -> None); + children; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + | (start_loc, Ok `Fragment) + | (start_loc, Error `Fragment) -> + `Fragment + JSX. + { + frag_opening_element = start_loc; + frag_closing_element = + (match closing_element with + | `Fragment loc -> loc + (* the following are parse erros *) + | `Element (loc, _) -> loc + | _ -> end_loc); + frag_children = children; + frag_comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + + in + + (Loc.btwn (fst opening_element) end_loc, result) + + and element_or_fragment env = + Eat.push_lex_mode env Lex_mode.JSX_TAG; + element env +end diff --git a/flow/parser/lex_env.ml b/flow/parser/lex_env.ml new file mode 100644 index 0000000000..00c36c4284 --- /dev/null +++ b/flow/parser/lex_env.ml @@ -0,0 +1,87 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +module Sedlexing = Flow_sedlexing + +(* bol = Beginning Of Line *) +type bol = { + line: int; + offset: int; +} + +type lex_state = { lex_errors_acc: (Loc.t * Parse_error.t) list } [@@ocaml.unboxed] + +type t = { + lex_source: File_key.t option; + lex_lb: Sedlexing.lexbuf; + lex_bol: bol; + lex_in_comment_syntax: bool; + lex_enable_comment_syntax: bool; + lex_state: lex_state; + lex_last_loc: Loc.t; +} + +let empty_lex_state = { lex_errors_acc = [] } + +(* The lex_last_loc should initially be set to the beginning of the first line, so that + comments on the first line are reported as not being on a new line. *) +let initial_last_loc = + { Loc.source = None; start = { Loc.line = 1; column = 0 }; _end = { Loc.line = 1; column = 0 } } + +let new_lex_env lex_source lex_lb ~enable_types_in_comments = + { + lex_source; + lex_lb; + lex_bol = { line = 1; offset = 0 }; + lex_in_comment_syntax = false; + lex_enable_comment_syntax = enable_types_in_comments; + lex_state = empty_lex_state; + lex_last_loc = initial_last_loc; + } + +(* copy all the mutable things so that we have a distinct lexing environment + that does not interfere with ordinary lexer operations *) +let clone env = + let lex_lb = Sedlexing.lexbuf_clone env.lex_lb in + { env with lex_lb } + +let lexbuf env = env.lex_lb + +let source env = env.lex_source + +let state env = env.lex_state + +let line env = env.lex_bol.line + +let bol_offset env = env.lex_bol.offset + +let is_in_comment_syntax env = env.lex_in_comment_syntax + +let is_comment_syntax_enabled env = env.lex_enable_comment_syntax + +let in_comment_syntax is_in env = + if is_in <> env.lex_in_comment_syntax then + { env with lex_in_comment_syntax = is_in } + else + env + +(* TODO *) +let debug_string_of_lexbuf _lb = "" + +let debug_string_of_lex_env (env : t) = + let source = + match source env with + | None -> "None" + | Some x -> Printf.sprintf "Some %S" (File_key.to_string x) + in + Printf.sprintf + "{\n lex_source = %s\n lex_lb = %s\n lex_in_comment_syntax = %b\n lex_enable_comment_syntax = %b\n lex_state = {errors = (count = %d)}\n}" + source + (debug_string_of_lexbuf env.lex_lb) + (is_in_comment_syntax env) + (is_comment_syntax_enabled env) + (List.length (state env).lex_errors_acc) diff --git a/flow/parser/lex_result.ml b/flow/parser/lex_result.ml new file mode 100644 index 0000000000..06ca899845 --- /dev/null +++ b/flow/parser/lex_result.ml @@ -0,0 +1,29 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +type t = { + lex_token: Token.t; + lex_loc: Loc.t; + lex_errors: (Loc.t * Parse_error.t) list; + lex_comments: Loc.t Flow_ast.Comment.t list; +} + +let token result = result.lex_token + +let loc result = result.lex_loc + +let comments result = result.lex_comments + +let errors result = result.lex_errors + +let debug_string_of_lex_result lex_result = + Printf.sprintf + "{\n lex_token = %s\n lex_value = %S\n lex_errors = (length = %d)\n lex_comments = (length = %d)\n}" + (Token.token_to_string lex_result.lex_token) + (Token.value_of_token lex_result.lex_token) + (List.length lex_result.lex_errors) + (List.length lex_result.lex_comments) diff --git a/flow/parser/loc.ml b/flow/parser/loc.ml new file mode 100644 index 0000000000..55fde52669 --- /dev/null +++ b/flow/parser/loc.ml @@ -0,0 +1,171 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +(* line numbers are 1-indexed; column numbers are 0-indexed *) +type position = { + line: int; + column: int; +} +[@@deriving eq, show] + +let equal_position a b = a = b + +(* start is inclusive; end is exclusive *) +(* If you are modifying this record, go look at ALoc.ml and make sure you understand the + * representation there. *) +type t = { + source: File_key.t option; + start: position; + _end: position; +} +[@@deriving show] + +let none = { source = None; start = { line = 0; column = 0 }; _end = { line = 0; column = 0 } } + +let is_none (x : t) = + x == none + || + match x with + | { source = None; start = { line = 0; column = 0 }; _end = { line = 0; column = 0 } } -> true + | _ -> false + +let btwn loc1 loc2 = { source = loc1.source; start = loc1.start; _end = loc2._end } + +(* Returns the position immediately before the start of the given loc. If the + given loc is at the beginning of a line, return the position of the first + char on the same line. *) +let char_before loc = + let start = + let { line; column } = loc.start in + let column = + if column > 0 then + column - 1 + else + column + in + { line; column } + in + let _end = loc.start in + { loc with start; _end } + +(* Returns the location of the first character in the given loc. Not accurate if the + * first line is a newline character, but is still consistent with loc orderings. *) +let first_char loc = + let start = loc.start in + let _end = { start with column = start.column + 1 } in + { loc with _end } + +let pos_cmp a b = + let k = a.line - b.line in + if k = 0 then + a.column - b.column + else + k + +(** + * If `a` spans (completely contains) `b`, then returns 0. + * If `b` starts before `a` (even if it ends inside), returns < 0. + * If `b` ends after `a` (even if it starts inside), returns > 0. + *) +let span_compare a b = + let k = File_key.compare_opt a.source b.source in + if k = 0 then + let k = pos_cmp a.start b.start in + if k <= 0 then + let k = pos_cmp a._end b._end in + if k >= 0 then + 0 + else + -1 + else + 1 + else + k + +(** [contains loc1 loc2] returns true if [loc1] entirely overlaps [loc2] *) +let contains loc1 loc2 = span_compare loc1 loc2 = 0 + +(** [intersects loc1 loc2] returns true if [loc1] intersects [loc2] at all *) +let intersects loc1 loc2 = + File_key.compare_opt loc1.source loc2.source = 0 + && not (pos_cmp loc1._end loc2.start < 0 || pos_cmp loc1.start loc2._end > 0) + +(** [lines_intersect loc1 loc2] returns true if [loc1] and [loc2] cover any part of + the same line, even if they don't actually intersect. + + For example, if [loc1] ends and then [loc2] begins later on the same line, + [intersects loc1 loc2] is false, but [lines_intersect loc1 loc2] is true. *) +let lines_intersect loc1 loc2 = + File_key.compare_opt loc1.source loc2.source = 0 + && not (loc1._end.line < loc2.start.line || loc1.start.line > loc2._end.line) + +let compare loc1 loc2 = + let k = File_key.compare_opt loc1.source loc2.source in + if k = 0 then + let k = pos_cmp loc1.start loc2.start in + if k = 0 then + pos_cmp loc1._end loc2._end + else + k + else + k + +let equal loc1 loc2 = compare loc1 loc2 = 0 + +(** + * This is mostly useful for debugging purposes. + * Please don't dead-code delete this! + *) +let debug_to_string ?(include_source = false) loc = + let source = + if include_source then + Printf.sprintf + "%S: " + (match loc.source with + | Some src -> File_key.to_string src + | None -> "") + else + "" + in + let pos = + Printf.sprintf + "(%d, %d) to (%d, %d)" + loc.start.line + loc.start.column + loc._end.line + loc._end.column + in + source ^ pos + +let to_string_no_source loc = + let line = loc.start.line in + let start = loc.start.column + 1 in + let end_ = loc._end.column in + if line <= 0 then + "0:0" + else if line = loc._end.line && start = end_ then + Printf.sprintf "%d:%d" line start + else if line != loc._end.line then + Printf.sprintf "%d:%d,%d:%d" line start loc._end.line end_ + else + Printf.sprintf "%d:%d-%d" line start end_ + +let mk_loc ?source (start_line, start_column) (end_line, end_column) = + { + source; + start = { line = start_line; column = start_column }; + _end = { line = end_line; column = end_column }; + } + +let source loc = loc.source + +(** Produces a zero-width Loc.t, where start = end *) +let cursor source line column = { source; start = { line; column }; _end = { line; column } } + +let start_loc loc = { loc with _end = loc.start } + +let end_loc loc = { loc with start = loc._end } diff --git a/flow/parser/loc.mli b/flow/parser/loc.mli new file mode 100644 index 0000000000..76a819fce0 --- /dev/null +++ b/flow/parser/loc.mli @@ -0,0 +1,70 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +type position = { + line: int; + column: int; +} +[@@deriving eq, show] + +val equal_position : position -> position -> bool + +type t = { + source: File_key.t option; + start: position; + _end: position; +} +[@@deriving show] + +val none : t + +val is_none : t -> bool + +val btwn : t -> t -> t + +val char_before : t -> t + +val first_char : t -> t + +(** [contains loc1 loc2] returns true if [loc1] entirely overlaps [loc2] *) +val contains : t -> t -> bool + +(** [intersects loc1 loc2] returns true if [loc1] intersects [loc2] at all *) +val intersects : t -> t -> bool + +(** [lines_intersect loc1 loc2] returns true if [loc1] and [loc2] cover any part of + the same line, even if they don't actually intersect. + + For example, if [loc1] ends and then [loc2] begins later on the same line, + [intersects loc1 loc2] is false, but [lines_intersect loc1 loc2] is true. *) +val lines_intersect : t -> t -> bool + +val pos_cmp : position -> position -> int + +val span_compare : t -> t -> int + +val compare : t -> t -> int + +val equal : t -> t -> bool + +val debug_to_string : ?include_source:bool -> t -> string + +(* Relatively compact; suitable for use as a unique string identifier *) +val to_string_no_source : t -> string + +val mk_loc : ?source:File_key.t -> int * int -> int * int -> t + +val source : t -> File_key.t option + +(** Produces a zero-width Loc.t, where start = end *) +val cursor : File_key.t option -> int -> int -> t + +(* Produces a location at the start of the input location *) +val start_loc : t -> t + +(* Produces a location at the end of the input location *) +val end_loc : t -> t diff --git a/flow/parser/object_parser.ml b/flow/parser/object_parser.ml new file mode 100644 index 0000000000..5b1953be31 --- /dev/null +++ b/flow/parser/object_parser.ml @@ -0,0 +1,1060 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +module Ast = Flow_ast +open Token +open Parser_env +open Flow_ast +module SMap = Flow_map.Make (String) +open Parser_common +open Comment_attachment + +(* A module for parsing various object related things, like object literals + * and classes *) + +module type OBJECT = sig + val key : ?class_body:bool -> env -> Loc.t * (Loc.t, Loc.t) Ast.Expression.Object.Property.key + + val _initializer : env -> Loc.t * (Loc.t, Loc.t) Ast.Expression.Object.t * pattern_errors + + val class_declaration : + env -> (Loc.t, Loc.t) Ast.Class.Decorator.t list -> (Loc.t, Loc.t) Ast.Statement.t + + val class_expression : env -> (Loc.t, Loc.t) Ast.Expression.t + + val class_implements : env -> attach_leading:bool -> (Loc.t, Loc.t) Ast.Class.Implements.t + + val decorator_list : env -> (Loc.t, Loc.t) Ast.Class.Decorator.t list +end + +module Object + (Parse : Parser_common.PARSER) + (Type : Type_parser.TYPE) + (Declaration : Declaration_parser.DECLARATION) + (Expression : Expression_parser.EXPRESSION) + (Pattern_cover : Pattern_cover.COVER) : OBJECT = struct + let decorator_list = + let expression env = + let expression = Expression.left_hand_side env in + let { remove_trailing; _ } = + if Peek.is_line_terminator env then + trailing_and_remover_after_last_line env + else + trailing_and_remover_after_last_loc env + in + remove_trailing expression (fun remover expression -> remover#expression expression) + in + let decorator env = + let leading = Peek.comments env in + Eat.token env; + { + Ast.Class.Decorator.expression = expression env; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + in + let rec decorator_list_helper env decorators = + match Peek.token env with + | T_AT -> decorator_list_helper env (with_loc decorator env :: decorators) + | _ -> decorators + in + fun env -> + if (parse_options env).esproposal_decorators then + List.rev (decorator_list_helper env []) + else + [] + + let key ?(class_body = false) env = + let open Ast.Expression.Object.Property in + let leading = Peek.comments env in + let tkn = Peek.token env in + match tkn with + | T_STRING (loc, value, raw, octal) -> + if octal then strict_error env Parse_error.StrictOctalLiteral; + Expect.token env (T_STRING (loc, value, raw, octal)); + let value = Literal.String value in + let trailing = Eat.trailing_comments env in + ( loc, + Literal + ( loc, + { Literal.value; raw; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + ) + | T_NUMBER { kind; raw } -> + let loc = Peek.loc env in + let value = Expression.number env kind raw in + let value = Literal.Number value in + let trailing = Eat.trailing_comments env in + ( loc, + Literal + ( loc, + { Literal.value; raw; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + ) + | T_LBRACKET -> + let (loc, key) = + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_LBRACKET; + let expr = Parse.assignment (env |> with_no_in false) in + Expect.token env T_RBRACKET; + let trailing = Eat.trailing_comments env in + { + ComputedKey.expression = expr; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + }) + env + in + (loc, Ast.Expression.Object.Property.Computed (loc, key)) + | T_POUND when class_body -> + let ((loc, { PrivateName.name; _ }) as id) = private_identifier env in + add_declared_private env name; + (loc, PrivateName id) + | T_POUND -> + let (loc, id) = + with_loc + (fun env -> + Eat.token env; + Identifier (identifier_name env)) + env + in + error_at env (loc, Parse_error.PrivateNotInClass); + (loc, id) + | _ -> + let ((loc, _) as id) = identifier_name env in + (loc, Identifier id) + + let getter_or_setter env ~in_class_body is_getter = + (* this is a getter or setter, it cannot be async *) + let async = false in + let (generator, leading) = Declaration.generator env in + let (key_loc, key) = key ~class_body:in_class_body env in + let key = object_key_remove_trailing env key in + let value = + with_loc + (fun env -> + (* #sec-function-definitions-static-semantics-early-errors *) + let env = env |> with_allow_super Super_prop in + let (sig_loc, (tparams, params, return)) = + with_loc + (fun env -> + (* It's not clear how type params on getters & setters would make sense + * in Flow's type system. Since this is a Flow syntax extension, we might + * as well disallow it until we need it *) + let tparams = None in + let params = + let params = Declaration.function_params ~await:false ~yield:false env in + if Peek.token env = T_COLON then + params + else + function_params_remove_trailing env params + in + begin + match (is_getter, params) with + | (true, (_, { Ast.Function.Params.this_ = Some _; _ })) -> + error_at env (key_loc, Parse_error.GetterMayNotHaveThisParam) + | (false, (_, { Ast.Function.Params.this_ = Some _; _ })) -> + error_at env (key_loc, Parse_error.SetterMayNotHaveThisParam) + | ( true, + ( _, + { Ast.Function.Params.params = []; rest = None; this_ = None; comments = _ } + ) + ) -> + () + | (false, (_, { Ast.Function.Params.rest = Some _; _ })) -> + (* rest params don't make sense on a setter *) + error_at env (key_loc, Parse_error.SetterArity) + | ( false, + ( _, + { + Ast.Function.Params.params = [_]; + rest = None; + this_ = None; + comments = _; + } + ) + ) -> + () + | (true, _) -> error_at env (key_loc, Parse_error.GetterArity) + | (false, _) -> error_at env (key_loc, Parse_error.SetterArity) + end; + let return = type_annotation_hint_remove_trailing env (Type.annotation_opt env) in + (tparams, params, return)) + env + in + let (body, strict) = Declaration.function_body env ~async ~generator ~expression:false in + let simple = Declaration.is_simple_function_params params in + Declaration.strict_post_check env ~strict ~simple None params; + { + Function.id = None; + params; + body; + generator; + async; + predicate = None; + (* setters/getter are not predicates *) + return; + tparams; + sig_loc; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + }) + env + in + (key, value) + + let _initializer = + let parse_assignment_cover env = + match Expression.assignment_cover env with + | Cover_expr expr -> (expr, Pattern_cover.empty_errors) + | Cover_patt (expr, errs) -> (expr, errs) + in + let get env start_loc leading = + let (loc, (key, value)) = + with_loc ~start_loc (fun env -> getter_or_setter env ~in_class_body:false true) env + in + let open Ast.Expression.Object in + Property + (loc, Property.Get { key; value; comments = Flow_ast_utils.mk_comments_opt ~leading () }) + in + let set env start_loc leading = + let (loc, (key, value)) = + with_loc ~start_loc (fun env -> getter_or_setter env ~in_class_body:false false) env + in + let open Ast.Expression.Object in + Property + (loc, Property.Set { key; value; comments = Flow_ast_utils.mk_comments_opt ~leading () }) + in + (* #prod-PropertyDefinition *) + let init = + let open Ast.Expression.Object.Property in + (* #prod-IdentifierReference *) + let parse_shorthand env key = + match key with + | Literal (loc, lit) -> + error_at env (loc, Parse_error.LiteralShorthandProperty); + (loc, Ast.Expression.Literal lit) + | Identifier ((loc, { Identifier.name; comments = _ }) as id) -> + (* #sec-identifiers-static-semantics-early-errors *) + if is_reserved name && name <> "yield" && name <> "await" then + (* it is a syntax error if `name` is a reserved word other than await or yield *) + error_at env (loc, Parse_error.UnexpectedReserved) + else if is_strict_reserved name then + (* it is a syntax error if `name` is a strict reserved word, in strict mode *) + strict_error_at env (loc, Parse_error.StrictReservedWord); + (loc, Ast.Expression.Identifier id) + | PrivateName _ -> failwith "Internal Error: private name found in object props" + | Computed (_, { ComputedKey.expression = expr; comments = _ }) -> + error_at env (fst expr, Parse_error.ComputedShorthandProperty); + expr + in + (* #prod-MethodDefinition *) + let parse_method ~async ~generator ~leading = + with_loc (fun env -> + (* #sec-function-definitions-static-semantics-early-errors *) + let env = env |> with_allow_super Super_prop in + let (sig_loc, (tparams, params, return)) = + with_loc + (fun env -> + let tparams = type_params_remove_trailing env (Type.type_params env) in + let params = + let (yield, await) = + match (async, generator) with + | (true, true) -> + (true, true) (* proposal-async-iteration/#prod-AsyncGeneratorMethod *) + | (true, false) -> (false, allow_await env) (* #prod-AsyncMethod *) + | (false, true) -> (true, false) (* #prod-GeneratorMethod *) + | (false, false) -> (false, false) + (* #prod-MethodDefinition *) + in + let params = Declaration.function_params ~await ~yield env in + if Peek.token env = T_COLON then + params + else + function_params_remove_trailing env params + in + let return = type_annotation_hint_remove_trailing env (Type.annotation_opt env) in + (tparams, params, return)) + env + in + let (body, strict) = + Declaration.function_body env ~async ~generator ~expression:false + in + let simple = Declaration.is_simple_function_params params in + Declaration.strict_post_check env ~strict ~simple None params; + { + Function.id = None; + params; + body; + generator; + async; + (* TODO: add support for object method predicates *) + predicate = None; + return; + tparams; + sig_loc; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + in + (* PropertyName `:` AssignmentExpression *) + let parse_value env = + Expect.token env T_COLON; + parse_assignment_cover env + in + (* #prod-CoverInitializedName *) + let parse_assignment_pattern ~key env = + let open Ast.Expression.Object in + match key with + | Property.Identifier id -> + let assignment_loc = Peek.loc env in + let ast = + with_loc + ~start_loc:(fst id) + (fun env -> + let leading = Peek.comments env in + Expect.token env T_ASSIGN; + let trailing = Eat.trailing_comments env in + let left = Parse.pattern_from_expr env (fst id, Ast.Expression.Identifier id) in + let right = Parse.assignment env in + let comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () in + Ast.Expression.Assignment + { Ast.Expression.Assignment.operator = None; left; right; comments }) + env + in + let errs = + { + if_expr = [(assignment_loc, Parse_error.Unexpected (Token.quote_token_value "="))]; + if_patt = []; + } + in + (ast, errs) + | Property.Literal _ + | Property.PrivateName _ + | Property.Computed _ -> + parse_value env + in + let parse_init ~key ~async ~generator ~leading env = + if async || generator then + let key = object_key_remove_trailing env key in + (* the `async` and `*` modifiers are only valid on methods *) + let value = parse_method env ~async ~generator ~leading in + let prop = Method { key; value } in + (prop, Pattern_cover.empty_errors) + else + match Peek.token env with + | T_RCURLY + | T_COMMA -> + let value = parse_shorthand env key in + let prop = Init { key; value; shorthand = true } in + (prop, Pattern_cover.empty_errors) + | T_LESS_THAN + | T_LPAREN -> + let key = object_key_remove_trailing env key in + let value = parse_method env ~async ~generator ~leading in + let prop = Method { key; value } in + (prop, Pattern_cover.empty_errors) + | T_ASSIGN -> + let (value, errs) = parse_assignment_pattern ~key env in + let prop = Init { key; value; shorthand = true } in + (prop, errs) + | _ -> + let (value, errs) = parse_value env in + let prop = Init { key; value; shorthand = false } in + (prop, errs) + in + fun env start_loc key async generator leading -> + let (loc, (prop, errs)) = + with_loc ~start_loc (parse_init ~key ~async ~generator ~leading) env + in + (Ast.Expression.Object.Property (loc, prop), errs) + in + let property env = + let open Ast.Expression.Object in + if Peek.token env = T_ELLIPSIS then + (* Spread property *) + let leading = Peek.comments env in + let (loc, (argument, errs)) = + with_loc + (fun env -> + Expect.token env T_ELLIPSIS; + parse_assignment_cover env) + env + in + ( SpreadProperty + (loc, { SpreadProperty.argument; comments = Flow_ast_utils.mk_comments_opt ~leading () }), + errs + ) + else + let start_loc = Peek.loc env in + let (async, leading_async) = + match Peek.ith_token ~i:1 env with + | T_ASSIGN + (* { async = true } (destructuring) *) + | T_COLON + (* { async: true } *) + | T_LESS_THAN + (* { async() {} } *) + | T_LPAREN + (* { async() {} } *) + | T_COMMA + (* { async, other, shorthand } *) + | T_RCURLY (* { async } *) -> + (false, []) + | _ -> Declaration.async env + in + let (generator, leading_generator) = Declaration.generator env in + let leading = leading_async @ leading_generator in + match (async, generator, Peek.token env) with + | (false, false, T_IDENTIFIER { raw = "get"; _ }) -> + let leading = Peek.comments env in + let (_, key) = key env in + begin + match Peek.token env with + | T_ASSIGN + | T_COLON + | T_LESS_THAN + | T_LPAREN + | T_COMMA + | T_RCURLY -> + init env start_loc key false false [] + | _ -> + ignore (Comment_attachment.object_key_remove_trailing env key); + (get env start_loc leading, Pattern_cover.empty_errors) + end + | (false, false, T_IDENTIFIER { raw = "set"; _ }) -> + let leading = Peek.comments env in + let (_, key) = key env in + begin + match Peek.token env with + | T_ASSIGN + | T_COLON + | T_LESS_THAN + | T_LPAREN + | T_COMMA + | T_RCURLY -> + init env start_loc key false false [] + | _ -> + ignore (Comment_attachment.object_key_remove_trailing env key); + (set env start_loc leading, Pattern_cover.empty_errors) + end + | (async, generator, _) -> + let (_, key) = key env in + init env start_loc key async generator leading + in + let rec properties env ~rest_trailing_comma (props, errs) = + match Peek.token env with + | T_EOF + | T_RCURLY -> + let errs = + match rest_trailing_comma with + | Some loc -> + { errs with if_patt = (loc, Parse_error.TrailingCommaAfterRestElement) :: errs.if_patt } + | None -> errs + in + (List.rev props, Pattern_cover.rev_errors errs) + | _ -> + let (prop, new_errs) = property env in + let rest_trailing_comma = + match prop with + | Ast.Expression.Object.SpreadProperty _ when Peek.token env = T_COMMA -> + Some (Peek.loc env) + | _ -> None + in + (match Peek.token env with + | T_RCURLY + | T_EOF -> + () + | _ -> Expect.token env T_COMMA); + let errs = Pattern_cover.rev_append_errors new_errs errs in + properties env ~rest_trailing_comma (prop :: props, errs) + in + fun env -> + let (loc, (expr, errs)) = + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_LCURLY; + let (props, errs) = + properties env ~rest_trailing_comma:None ([], Pattern_cover.empty_errors) + in + let internal = Peek.comments env in + Expect.token env T_RCURLY; + let trailing = Eat.trailing_comments env in + ( { + Ast.Expression.Object.properties = props; + comments = + Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal (); + }, + errs + )) + env + in + (loc, expr, errs) + + let check_property_name env loc name static = + if String.equal name "constructor" || (String.equal name "prototype" && static) then + error_at + env + (loc, Parse_error.InvalidClassMemberName { name; static; method_ = false; private_ = false }) + + let check_private_names + env seen_names private_name (kind : [ `Method | `Field | `Getter | `Setter ]) = + let (loc, { PrivateName.name; comments = _ }) = private_name in + if String.equal name "constructor" then + let () = + error_at + env + ( loc, + Parse_error.InvalidClassMemberName + { name; static = false; method_ = kind = `Method; private_ = true } + ) + in + seen_names + else + match SMap.find_opt name seen_names with + | Some seen -> + begin + match (kind, seen) with + | (`Getter, `Setter) + | (`Setter, `Getter) -> + (* one getter and one setter are allowed as long as it's not used as a field *) + () + | _ -> error_at env (loc, Parse_error.DuplicatePrivateFields name) + end; + SMap.add name `Field seen_names + | None -> SMap.add name kind seen_names + + let class_implements env ~attach_leading = + let rec interfaces env acc = + let interface = + with_loc + (fun env -> + let id = + let id = Type.type_identifier env in + if Peek.token env <> T_LESS_THAN then + id + else + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing id (fun remover id -> remover#identifier id) + in + let targs = Type.type_args env in + { Ast.Class.Implements.Interface.id; targs }) + env + in + let acc = interface :: acc in + match Peek.token env with + | T_COMMA -> + Expect.token env T_COMMA; + interfaces env acc + | _ -> List.rev acc + in + with_loc + (fun env -> + let leading = + if attach_leading then + Peek.comments env + else + [] + in + Expect.token env T_IMPLEMENTS; + let interfaces = interfaces env [] in + { Ast.Class.Implements.interfaces; comments = Flow_ast_utils.mk_comments_opt ~leading () }) + env + + let class_extends ~leading = + with_loc (fun env -> + let expr = + let expr = Expression.left_hand_side (env |> with_allow_yield false) in + if Peek.token env <> T_LESS_THAN then + expr + else + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing expr (fun remover expr -> remover#expression expr) + in + let targs = Type.type_args env in + { Class.Extends.expr; targs; comments = Flow_ast_utils.mk_comments_opt ~leading () } + ) + + (* https://tc39.es/ecma262/#prod-ClassHeritage *) + let class_heritage env = + let extends = + let leading = Peek.comments env in + if Eat.maybe env T_EXTENDS then + let (loc, extends) = class_extends ~leading env in + let { remove_trailing; _ } = trailing_and_remover env in + Some + (loc, remove_trailing extends (fun remover extends -> remover#class_extends loc extends)) + else + None + in + let implements = + if Peek.token env = T_IMPLEMENTS then ( + if not (should_parse_types env) then error env Parse_error.UnexpectedTypeInterface; + Some (class_implements_remove_trailing env (class_implements env ~attach_leading:true)) + ) else + None + in + (extends, implements) + + (* In the ES6 draft, all elements are methods. No properties (though there + * are getter and setters allowed *) + let class_element = + let get env start_loc decorators static leading = + let (loc, (key, value)) = + with_loc ~start_loc (fun env -> getter_or_setter env ~in_class_body:true true) env + in + let open Ast.Class in + Body.Method + ( loc, + { + Method.key; + value; + kind = Method.Get; + static; + decorators; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + in + let set env start_loc decorators static leading = + let (loc, (key, value)) = + with_loc ~start_loc (fun env -> getter_or_setter env ~in_class_body:true false) env + in + let open Ast.Class in + Body.Method + ( loc, + { + Method.key; + value; + kind = Method.Set; + static; + decorators; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + in + let error_unsupported_variance env = function + | Some (loc, _) -> error_at env (loc, Parse_error.UnexpectedVariance) + | None -> () + (* Class property with annotation *) + in + let error_unsupported_declare env = function + | Some loc -> error_at env (loc, Parse_error.DeclareClassElement) + | None -> () + in + let property_end_and_semicolon env key annot value = + match Peek.token env with + | T_LBRACKET + | T_LPAREN -> + error_unexpected env; + (key, annot, value, []) + | T_SEMICOLON -> + Eat.token env; + let trailing = + match Peek.token env with + | T_EOF + | T_RCURLY -> + Eat.trailing_comments env + | _ when Peek.is_line_terminator env -> Eat.comments_until_next_line env + | _ -> [] + in + (key, annot, value, trailing) + | _ -> + let remover = + match Peek.token env with + | T_EOF + | T_RCURLY -> + { trailing = []; remove_trailing = (fun x _ -> x) } + | _ when Peek.is_line_terminator env -> + Comment_attachment.trailing_and_remover_after_last_line env + | _ -> Comment_attachment.trailing_and_remover_after_last_loc env + in + (* Remove trailing comments from the last node in this property *) + let (key, annot, value) = + match (annot, value) with + (* prop = init *) + | (_, Class.Property.Initialized expr) -> + ( key, + annot, + Class.Property.Initialized + (remover.remove_trailing expr (fun remover expr -> remover#expression expr)) + ) + (* prop: annot *) + | (Ast.Type.Available annot, _) -> + ( key, + Ast.Type.Available + (remover.remove_trailing annot (fun remover annot -> remover#type_annotation annot)), + value + ) + (* prop *) + | _ -> + (remover.remove_trailing key (fun remover key -> remover#object_key key), annot, value) + in + (key, annot, value, []) + in + let property env start_loc key static declare variance leading = + let (loc, (key, annot, value, comments)) = + with_loc + ~start_loc + (fun env -> + let annot = Type.annotation_opt env in + let value = + match (declare, Peek.token env) with + | (None, T_ASSIGN) -> + Eat.token env; + Ast.Class.Property.Initialized + (Parse.expression (env |> with_allow_super Super_prop)) + | (Some _, T_ASSIGN) -> + error env Parse_error.DeclareClassFieldInitializer; + Eat.token env; + Ast.Class.Property.Declared + | (None, _) -> Ast.Class.Property.Uninitialized + | (Some _, _) -> Ast.Class.Property.Declared + in + let (key, annot, value, trailing) = property_end_and_semicolon env key annot value in + (key, annot, value, Flow_ast_utils.mk_comments_opt ~leading ~trailing ())) + env + in + match key with + | Ast.Expression.Object.Property.PrivateName private_name -> + let open Ast.Class in + Body.PrivateField + (loc, { PrivateField.key = private_name; value; annot; static; variance; comments }) + | _ -> + Ast.Class.(Body.Property (loc, { Property.key; value; annot; static; variance; comments })) + in + let is_asi env = + match Peek.token env with + | T_LESS_THAN -> false + | T_LPAREN -> false + | _ when Peek.is_implicit_semicolon env -> true + | _ -> false + in + let rec init env start_loc decorators key ~async ~generator ~static ~declare variance leading = + match Peek.token env with + | T_COLON + | T_ASSIGN + | T_SEMICOLON + | T_RCURLY + when (not async) && not generator -> + property env start_loc key static declare variance leading + | T_PLING -> + (* TODO: add support for optional class properties *) + error_unexpected env; + Eat.token env; + init env start_loc decorators key ~async ~generator ~static ~declare variance leading + | _ when is_asi env -> + (* an uninitialized, unannotated property *) + property env start_loc key static declare variance leading + | _ -> + error_unsupported_declare env declare; + error_unsupported_variance env variance; + let (kind, env) = + match (static, key) with + | ( false, + Ast.Expression.Object.Property.Identifier + (_, { Identifier.name = "constructor"; comments = _ }) + ) + | ( false, + Ast.Expression.Object.Property.Literal + (_, { Literal.value = Literal.String "constructor"; _ }) + ) -> + (Ast.Class.Method.Constructor, env |> with_allow_super Super_prop_or_call) + | _ -> (Ast.Class.Method.Method, env |> with_allow_super Super_prop) + in + let key = object_key_remove_trailing env key in + let value = + with_loc + (fun env -> + let (sig_loc, (tparams, params, return)) = + with_loc + (fun env -> + let tparams = type_params_remove_trailing env (Type.type_params env) in + let params = + let (yield, await) = + match (async, generator) with + | (true, true) -> + (true, true) (* proposal-async-iteration/#prod-AsyncGeneratorMethod *) + | (true, false) -> (false, allow_await env) (* #prod-AsyncMethod *) + | (false, true) -> (true, false) (* #prod-GeneratorMethod *) + | (false, false) -> (false, false) + (* #prod-MethodDefinition *) + in + let params = Declaration.function_params ~await ~yield env in + let params = + if Peek.token env = T_COLON then + params + else + function_params_remove_trailing env params + in + Ast.Function.Params.( + match params with + | (loc, ({ this_ = Some (this_loc, _); _ } as params)) + when kind = Ast.Class.Method.Constructor -> + (* Disallow this param annotations for constructors *) + error_at env (this_loc, Parse_error.ThisParamBannedInConstructor); + (loc, { params with this_ = None }) + | params -> params + ) + in + let return = + type_annotation_hint_remove_trailing env (Type.annotation_opt env) + in + (tparams, params, return)) + env + in + let (body, strict) = + Declaration.function_body env ~async ~generator ~expression:false + in + let simple = Declaration.is_simple_function_params params in + Declaration.strict_post_check env ~strict ~simple None params; + { + Function.id = None; + params; + body; + generator; + async; + (* TODO: add support for method predicates *) + predicate = None; + return; + tparams; + sig_loc; + comments = None; + }) + env + in + let open Ast.Class in + Body.Method + ( Loc.btwn start_loc (fst value), + { + Method.key; + value; + kind; + static; + decorators; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + in + let ith_implies_identifier ~i env = + match Peek.ith_token ~i env with + | T_LESS_THAN + | T_COLON + | T_ASSIGN + | T_SEMICOLON + | T_LPAREN + | T_RCURLY -> + true + | _ -> false + in + let implies_identifier = ith_implies_identifier ~i:0 in + fun env -> + let start_loc = Peek.loc env in + let decorators = decorator_list env in + let (declare, leading_declare) = + match Peek.token env with + | T_DECLARE when not (ith_implies_identifier ~i:1 env) -> + let ret = Some (Peek.loc env) in + let leading = Peek.comments env in + Eat.token env; + (ret, leading) + | _ -> (None, []) + in + let static = + Peek.ith_token ~i:1 env <> T_LPAREN + && Peek.ith_token ~i:1 env <> T_LESS_THAN + && Peek.token env = T_STATIC + in + let leading_static = + if static then ( + let leading = Peek.comments env in + Eat.token env; + leading + ) else + [] + in + let async = + Peek.token env = T_ASYNC + && (not (ith_implies_identifier ~i:1 env)) + && not (Peek.ith_is_line_terminator ~i:1 env) + in + (* consume `async` *) + let leading_async = + if async then ( + let leading = Peek.comments env in + Eat.token env; + leading + ) else + [] + in + let (generator, leading_generator) = Declaration.generator env in + let variance = Declaration.variance env async generator in + let (generator, leading_generator) = + match (generator, variance) with + | (false, Some _) -> Declaration.generator env + | _ -> (generator, leading_generator) + in + let leading = + List.concat [leading_declare; leading_static; leading_async; leading_generator] + in + match (async, generator, Peek.token env) with + | (false, false, T_IDENTIFIER { raw = "get"; _ }) -> + let leading_get = Peek.comments env in + let (_, key) = key ~class_body:true env in + if implies_identifier env then + init env start_loc decorators key ~async ~generator ~static ~declare variance leading + else ( + error_unsupported_declare env declare; + error_unsupported_variance env variance; + ignore (object_key_remove_trailing env key); + get env start_loc decorators static (leading @ leading_get) + ) + | (false, false, T_IDENTIFIER { raw = "set"; _ }) -> + let leading_set = Peek.comments env in + let (_, key) = key ~class_body:true env in + if implies_identifier env then + init env start_loc decorators key ~async ~generator ~static ~declare variance leading + else ( + error_unsupported_declare env declare; + error_unsupported_variance env variance; + ignore (object_key_remove_trailing env key); + set env start_loc decorators static (leading @ leading_set) + ) + | (_, _, _) -> + let (_, key) = key ~class_body:true env in + init env start_loc decorators key ~async ~generator ~static ~declare variance leading + + let class_body = + let rec elements env seen_constructor private_names acc = + match Peek.token env with + | T_EOF + | T_RCURLY -> + List.rev acc + | T_SEMICOLON -> + (* Skip empty elements *) + Expect.token env T_SEMICOLON; + elements env seen_constructor private_names acc + | _ -> + let element = class_element env in + let (seen_constructor', private_names') = + match element with + | Ast.Class.Body.Method (loc, m) -> + let open Ast.Class.Method in + (match m.kind with + | Constructor -> + if m.static then + (seen_constructor, private_names) + else ( + if seen_constructor then error_at env (loc, Parse_error.DuplicateConstructor); + (true, private_names) + ) + | Method -> + let private_names = + match m.key with + | Ast.Expression.Object.Property.PrivateName name -> + check_private_names env private_names name `Method + | _ -> private_names + in + (seen_constructor, private_names) + | Get -> + let open Ast.Expression.Object.Property in + let private_names = + match m.key with + | PrivateName name -> check_private_names env private_names name `Getter + | _ -> private_names + in + (seen_constructor, private_names) + | Set -> + let open Ast.Expression.Object.Property in + let private_names = + match m.key with + | PrivateName name -> check_private_names env private_names name `Setter + | _ -> private_names + in + (seen_constructor, private_names)) + | Ast.Class.Body.Property (_, { Ast.Class.Property.key; static; _ }) -> + let open Ast.Expression.Object.Property in + begin + match key with + | Identifier (loc, { Identifier.name; comments = _ }) + | Literal (loc, { Literal.value = Literal.String name; _ }) -> + check_property_name env loc name static + | Literal _ + | Computed _ -> + () + | PrivateName _ -> + failwith "unexpected PrivateName in Property, expected a PrivateField" + end; + (seen_constructor, private_names) + | Ast.Class.Body.PrivateField (_, { Ast.Class.PrivateField.key; _ }) -> + let private_names = check_private_names env private_names key `Field in + (seen_constructor, private_names) + in + elements env seen_constructor' private_names' (element :: acc) + in + fun ~expression env -> + with_loc + (fun env -> + let leading = Peek.comments env in + if Eat.maybe env T_LCURLY then ( + enter_class env; + let body = elements env false SMap.empty [] in + exit_class env; + Expect.token env T_RCURLY; + let trailing = + match (expression, Peek.token env) with + | (true, _) + | (_, (T_RCURLY | T_EOF)) -> + Eat.trailing_comments env + | _ when Peek.is_line_terminator env -> Eat.comments_until_next_line env + | _ -> [] + in + { Ast.Class.Body.body; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) else ( + Expect.error env T_LCURLY; + { Ast.Class.Body.body = []; comments = None } + )) + env + + let _class ?(decorators = []) env ~optional_id ~expression = + (* 10.2.1 says all parts of a class definition are strict *) + let env = env |> with_strict true in + let decorators = decorators @ decorator_list env in + let leading = Peek.comments env in + Expect.token env T_CLASS; + let id = + let tmp_env = env |> with_no_let true in + match (optional_id, Peek.token tmp_env) with + | (true, (T_EXTENDS | T_IMPLEMENTS | T_LESS_THAN | T_LCURLY)) -> None + | _ -> + let id = Parse.identifier tmp_env in + let { remove_trailing; _ } = trailing_and_remover env in + let id = remove_trailing id (fun remover id -> remover#identifier id) in + Some id + in + let tparams = + match Type.type_params env with + | None -> None + | Some tparams -> + let { remove_trailing; _ } = trailing_and_remover env in + Some (remove_trailing tparams (fun remover tparams -> remover#type_params tparams)) + in + let (extends, implements) = class_heritage env in + let body = class_body env ~expression in + let comments = Flow_ast_utils.mk_comments_opt ~leading () in + { Class.id; body; tparams; extends; implements; class_decorators = decorators; comments } + + let class_declaration env decorators = + with_loc + (fun env -> + let optional_id = in_export env in + Ast.Statement.ClassDeclaration (_class env ~decorators ~optional_id ~expression:false)) + env + + let class_expression = + with_loc (fun env -> Ast.Expression.Class (_class env ~optional_id:true ~expression:true)) +end diff --git a/flow/parser/parse_error.ml b/flow/parser/parse_error.ml new file mode 100644 index 0000000000..bf9a3b9d2c --- /dev/null +++ b/flow/parser/parse_error.ml @@ -0,0 +1,454 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +type t = + | Assertion of string + | EnumBooleanMemberNotInitialized of { + enum_name: string; + member_name: string; + } + | EnumDuplicateMemberName of { + enum_name: string; + member_name: string; + } + | EnumInconsistentMemberValues of { enum_name: string } + | EnumInvalidExplicitType of { + enum_name: string; + supplied_type: string option; + } + | EnumInvalidExport + | EnumInvalidInitializerSeparator of { member_name: string } + | EnumInvalidMemberInitializer of { + enum_name: string; + explicit_type: Enum_common.explicit_type option; + member_name: string; + } + | EnumInvalidMemberName of { + enum_name: string; + member_name: string; + } + | EnumInvalidMemberSeparator + | EnumInvalidEllipsis of { trailing_comma: bool } + | EnumNumberMemberNotInitialized of { + enum_name: string; + member_name: string; + } + | EnumStringMemberInconsistentlyInitailized of { enum_name: string } + | Unexpected of string + | UnexpectedWithExpected of string * string + | UnexpectedTokenWithSuggestion of string * string + | UnexpectedReserved + | UnexpectedReservedType + | UnexpectedSuper + | UnexpectedSuperCall + | UnexpectedEOS + | UnexpectedVariance + | UnexpectedStatic + | UnexpectedProto + | UnexpectedTypeAlias + | UnexpectedOpaqueTypeAlias + | UnexpectedTypeAnnotation + | UnexpectedTypeDeclaration + | UnexpectedTypeImport + | UnexpectedTypeExport + | UnexpectedTypeInterface + | UnexpectedSpreadType + | UnexpectedExplicitInexactInObject + | InexactInsideExact + | InexactInsideNonObject + | NewlineAfterThrow + | InvalidFloatBigInt + | InvalidSciBigInt + | InvalidRegExp + | InvalidRegExpFlags of string + | UnterminatedRegExp + | InvalidLHSInAssignment + | InvalidLHSInExponentiation + | InvalidLHSInForIn + | InvalidLHSInForOf + | InvalidIndexedAccess of { has_bracket: bool } + | InvalidOptionalIndexedAccess + | ExpectedPatternFoundExpression + | MultipleDefaultsInSwitch + | NoCatchOrFinally + | UnknownLabel of string + | Redeclaration of string * string + | IllegalContinue + | IllegalBreak + | IllegalReturn + | IllegalUnicodeEscape + | StrictModeWith + | StrictCatchVariable + | StrictVarName + | StrictParamName + | StrictParamDupe + | StrictFunctionName + | StrictOctalLiteral + | StrictNonOctalLiteral + | StrictDelete + | StrictDuplicateProperty + | AccessorDataProperty + | AccessorGetSet + | InvalidTypeof + | StrictLHSAssignment + | StrictLHSPostfix + | StrictLHSPrefix + | StrictReservedWord + | JSXAttributeValueEmptyExpression + | InvalidJSXAttributeValue + | ExpectedJSXClosingTag of string + | NoUninitializedConst + | NoUninitializedDestructuring + | NewlineBeforeArrow + | FunctionAsStatement of { in_strict_mode: bool } + | AsyncFunctionAsStatement + | GeneratorFunctionAsStatement + | AdjacentJSXElements + | ParameterAfterRestParameter + | ElementAfterRestElement + | PropertyAfterRestElement + | DeclareAsync + | DeclareClassElement + | DeclareClassFieldInitializer + | DeclareOpaqueTypeInitializer + | DeclareExportLet + | DeclareExportConst + | DeclareExportType + | DeclareExportInterface + | UnexpectedExportStarAs + | DuplicateExport of string + | ExportNamelessClass + | ExportNamelessFunction + | UnsupportedDecorator + | MissingTypeParamDefault + | DuplicateDeclareModuleExports + | AmbiguousDeclareModuleKind + | GetterArity + | SetterArity + | InvalidNonTypeImportInDeclareModule + | ImportTypeShorthandOnlyInPureImport + | ImportSpecifierMissingComma + | ExportSpecifierMissingComma + | MalformedUnicode + | DuplicateConstructor + | DuplicatePrivateFields of string + | InvalidClassMemberName of { + name: string; + static: bool; + method_: bool; + private_: bool; + } + | PrivateDelete + | UnboundPrivate of string + | PrivateNotInClass + | SuperPrivate + | YieldInFormalParameters + | AwaitAsIdentifierReference + | YieldAsIdentifierReference + | AmbiguousLetBracket + | LiteralShorthandProperty + | ComputedShorthandProperty + | MethodInDestructuring + | TrailingCommaAfterRestElement + | OptionalChainNew + | OptionalChainTemplate + | NullishCoalescingUnexpectedLogical of string + | WhitespaceInPrivateName + | ThisParamAnnotationRequired + | ThisParamMustBeFirst + | ThisParamMayNotBeOptional + | GetterMayNotHaveThisParam + | SetterMayNotHaveThisParam + | ThisParamBannedInArrowFunctions + | ThisParamBannedInConstructor +[@@deriving ord] + +let compare a b = compare a b + +exception Error of (Loc.t * t) * (Loc.t * t) list + +let error loc e = raise (Error ((loc, e), [])) + +module PP = struct + let error = function + | Assertion str -> "Unexpected parser state: " ^ str + | EnumBooleanMemberNotInitialized { enum_name; member_name } -> + Printf.sprintf + "Boolean enum members need to be initialized. Use either `%s = true,` or `%s = false,` in enum `%s`." + member_name + member_name + enum_name + | EnumDuplicateMemberName { enum_name; member_name } -> + Printf.sprintf + "Enum member names need to be unique, but the name `%s` has already been used before in enum `%s`." + member_name + enum_name + | EnumInconsistentMemberValues { enum_name } -> + Printf.sprintf + "Enum `%s` has inconsistent member initializers. Either use no initializers, or consistently use literals (either booleans, numbers, or strings) for all member initializers." + enum_name + | EnumInvalidExplicitType { enum_name; supplied_type } -> + let suggestion = + Printf.sprintf + "Use one of `boolean`, `number`, `string`, or `symbol` in enum `%s`." + enum_name + in + begin + match supplied_type with + | Some supplied_type -> + Printf.sprintf "Enum type `%s` is not valid. %s" supplied_type suggestion + | None -> Printf.sprintf "Supplied enum type is not valid. %s" suggestion + end + | EnumInvalidExport -> + "Cannot export an enum with `export type`, try `export enum E {}` or `module.exports = E;` instead." + | EnumInvalidInitializerSeparator { member_name } -> + Printf.sprintf + "Enum member names and initializers are separated with `=`. Replace `%s:` with `%s =`." + member_name + member_name + | EnumInvalidMemberInitializer { enum_name; explicit_type; member_name } -> + begin + match explicit_type with + | Some (Enum_common.Boolean as explicit_type) + | Some (Enum_common.Number as explicit_type) + | Some (Enum_common.String as explicit_type) -> + let explicit_type_str = Enum_common.string_of_explicit_type explicit_type in + Printf.sprintf + "Enum `%s` has type `%s`, so the initializer of `%s` needs to be a %s literal." + enum_name + explicit_type_str + member_name + explicit_type_str + | Some Enum_common.Symbol -> + Printf.sprintf + "Symbol enum members cannot be initialized. Use `%s,` in enum `%s`." + member_name + enum_name + | None -> + Printf.sprintf + "The enum member initializer for `%s` needs to be a literal (either a boolean, number, or string) in enum `%s`." + member_name + enum_name + end + | EnumInvalidMemberName { enum_name; member_name } -> + (* Based on the error condition, we will only receive member names starting with [a-z] *) + let suggestion = String.capitalize_ascii member_name in + Printf.sprintf + "Enum member names cannot start with lowercase 'a' through 'z'. Instead of using `%s`, consider using `%s`, in enum `%s`." + member_name + suggestion + enum_name + | EnumInvalidMemberSeparator -> "Enum members are separated with `,`. Replace `;` with `,`." + | EnumInvalidEllipsis { trailing_comma } -> + if trailing_comma then + "The `...` must come at the end of the enum body. Remove the trailing comma." + else + "The `...` must come after all enum members. Move it to the end of the enum body." + | EnumNumberMemberNotInitialized { enum_name; member_name } -> + Printf.sprintf + "Number enum members need to be initialized, e.g. `%s = 1,` in enum `%s`." + member_name + enum_name + | EnumStringMemberInconsistentlyInitailized { enum_name } -> + Printf.sprintf + "String enum members need to consistently either all use initializers, or use no initializers, in enum %s." + enum_name + | Unexpected unexpected -> Printf.sprintf "Unexpected %s" unexpected + | UnexpectedWithExpected (unexpected, expected) -> + Printf.sprintf "Unexpected %s, expected %s" unexpected expected + | UnexpectedTokenWithSuggestion (token, suggestion) -> + Printf.sprintf "Unexpected token `%s`. Did you mean `%s`?" token suggestion + | UnexpectedReserved -> "Unexpected reserved word" + | UnexpectedReservedType -> "Unexpected reserved type" + | UnexpectedSuper -> "Unexpected `super` outside of a class method" + | UnexpectedSuperCall -> "`super()` is only valid in a class constructor" + | UnexpectedEOS -> "Unexpected end of input" + | UnexpectedVariance -> "Unexpected variance sigil" + | UnexpectedStatic -> "Unexpected static modifier" + | UnexpectedProto -> "Unexpected proto modifier" + | UnexpectedTypeAlias -> "Type aliases are not allowed in untyped mode" + | UnexpectedOpaqueTypeAlias -> "Opaque type aliases are not allowed in untyped mode" + | UnexpectedTypeAnnotation -> "Type annotations are not allowed in untyped mode" + | UnexpectedTypeDeclaration -> "Type declarations are not allowed in untyped mode" + | UnexpectedTypeImport -> "Type imports are not allowed in untyped mode" + | UnexpectedTypeExport -> "Type exports are not allowed in untyped mode" + | UnexpectedTypeInterface -> "Interfaces are not allowed in untyped mode" + | UnexpectedSpreadType -> "Spreading a type is only allowed inside an object type" + | UnexpectedExplicitInexactInObject -> + "Explicit inexact syntax must come at the end of an object type" + | InexactInsideExact -> + "Explicit inexact syntax cannot appear inside an explicit exact object type" + | InexactInsideNonObject -> "Explicit inexact syntax can only appear inside an object type" + | NewlineAfterThrow -> "Illegal newline after throw" + | InvalidFloatBigInt -> "A bigint literal must be an integer" + | InvalidSciBigInt -> "A bigint literal cannot use exponential notation" + | InvalidRegExp -> "Invalid regular expression" + | InvalidRegExpFlags flags -> "Invalid flags supplied to RegExp constructor '" ^ flags ^ "'" + | UnterminatedRegExp -> "Invalid regular expression: missing /" + | InvalidLHSInAssignment -> "Invalid left-hand side in assignment" + | InvalidLHSInExponentiation -> "Invalid left-hand side in exponentiation expression" + | InvalidLHSInForIn -> "Invalid left-hand side in for-in" + | InvalidLHSInForOf -> "Invalid left-hand side in for-of" + | InvalidIndexedAccess { has_bracket } -> + let msg = + if has_bracket then + "Remove the period." + else + "Indexed access uses bracket notation." + in + Printf.sprintf "Invalid indexed access. %s Use the format `T[K]`." msg + | InvalidOptionalIndexedAccess -> + "Invalid optional indexed access. Indexed access uses bracket notation. Use the format `T?.[K]`." + | ExpectedPatternFoundExpression -> + "Expected an object pattern, array pattern, or an identifier but " + ^ "found an expression instead" + | MultipleDefaultsInSwitch -> "More than one default clause in switch statement" + | NoCatchOrFinally -> "Missing catch or finally after try" + | UnknownLabel label -> "Undefined label '" ^ label ^ "'" + | Redeclaration (what, name) -> what ^ " '" ^ name ^ "' has already been declared" + | IllegalContinue -> "Illegal continue statement" + | IllegalBreak -> "Illegal break statement" + | IllegalReturn -> "Illegal return statement" + | IllegalUnicodeEscape -> "Illegal Unicode escape" + | StrictModeWith -> "Strict mode code may not include a with statement" + | StrictCatchVariable -> "Catch variable may not be eval or arguments in strict mode" + | StrictVarName -> "Variable name may not be eval or arguments in strict mode" + | StrictParamName -> "Parameter name eval or arguments is not allowed in strict mode" + | StrictParamDupe -> "Strict mode function may not have duplicate parameter names" + | StrictFunctionName -> "Function name may not be eval or arguments in strict mode" + | StrictOctalLiteral -> "Octal literals are not allowed in strict mode." + | StrictNonOctalLiteral -> "Number literals with leading zeros are not allowed in strict mode." + | StrictDelete -> "Delete of an unqualified identifier in strict mode." + | StrictDuplicateProperty -> + "Duplicate data property in object literal not allowed in strict mode" + | AccessorDataProperty -> + "Object literal may not have data and accessor property with the same name" + | AccessorGetSet -> "Object literal may not have multiple get/set accessors with the same name" + | StrictLHSAssignment -> "Assignment to eval or arguments is not allowed in strict mode" + | StrictLHSPostfix -> + "Postfix increment/decrement may not have eval or arguments operand in strict mode" + | StrictLHSPrefix -> + "Prefix increment/decrement may not have eval or arguments operand in strict mode" + | StrictReservedWord -> "Use of future reserved word in strict mode" + | JSXAttributeValueEmptyExpression -> + "JSX attributes must only be assigned a non-empty expression" + | InvalidJSXAttributeValue -> "JSX value should be either an expression or a quoted JSX text" + | ExpectedJSXClosingTag name -> "Expected corresponding JSX closing tag for " ^ name + | NoUninitializedConst -> "Const must be initialized" + | NoUninitializedDestructuring -> "Destructuring assignment must be initialized" + | NewlineBeforeArrow -> "Illegal newline before arrow" + | FunctionAsStatement { in_strict_mode } -> + if in_strict_mode then + "In strict mode code, functions can only be declared at top level or " + ^ "immediately within another function." + else + "In non-strict mode code, functions can only be declared at top level, " + ^ "inside a block, or as the body of an if statement." + | AsyncFunctionAsStatement -> + "Async functions can only be declared at top level or " + ^ "immediately within another function." + | GeneratorFunctionAsStatement -> + "Generators can only be declared at top level or " ^ "immediately within another function." + | AdjacentJSXElements -> + "Unexpected token <. Remember, adjacent JSX " + ^ "elements must be wrapped in an enclosing parent tag" + | ParameterAfterRestParameter -> "Rest parameter must be final parameter of an argument list" + | ElementAfterRestElement -> "Rest element must be final element of an array pattern" + | PropertyAfterRestElement -> "Rest property must be final property of an object pattern" + | DeclareAsync -> + "async is an implementation detail and isn't necessary for your declare function statement. It is sufficient for your declare function to just have a Promise return type." + | DeclareClassElement -> "`declare` modifier can only appear on class fields." + | DeclareClassFieldInitializer -> + "Unexpected token `=`. Initializers are not allowed in a `declare`." + | DeclareOpaqueTypeInitializer -> + "Unexpected token `=`. Initializers are not allowed in a `declare opaque type`." + | DeclareExportLet -> "`declare export let` is not supported. Use `declare export var` instead." + | DeclareExportConst -> + "`declare export const` is not supported. Use `declare export var` instead." + | DeclareExportType -> "`declare export type` is not supported. Use `export type` instead." + | DeclareExportInterface -> + "`declare export interface` is not supported. Use `export interface` instead." + | UnexpectedExportStarAs -> + "`export * as` is an early-stage proposal and is not enabled by default. To enable support in the parser, use the `esproposal_export_star_as` option" + | DuplicateExport export -> Printf.sprintf "Duplicate export for `%s`" export + | ExportNamelessClass -> + "When exporting a class as a named export, you must specify a class name. Did you mean `export default class ...`?" + | ExportNamelessFunction -> + "When exporting a function as a named export, you must specify a function name. Did you mean `export default function ...`?" + | UnsupportedDecorator -> "Found a decorator in an unsupported position." + | MissingTypeParamDefault -> + "Type parameter declaration needs a default, since a preceding type parameter declaration has a default." + | DuplicateDeclareModuleExports -> "Duplicate `declare module.exports` statement!" + | AmbiguousDeclareModuleKind -> + "Found both `declare module.exports` and `declare export` in the same module. Modules can only have 1 since they are either an ES module xor they are a CommonJS module." + | GetterArity -> "Getter should have zero parameters" + | SetterArity -> "Setter should have exactly one parameter" + | InvalidNonTypeImportInDeclareModule -> + "Imports within a `declare module` body must always be " ^ "`import type` or `import typeof`!" + | ImportTypeShorthandOnlyInPureImport -> + "The `type` and `typeof` keywords on named imports can only be used on regular `import` statements. It cannot be used with `import type` or `import typeof` statements" + | ImportSpecifierMissingComma -> "Missing comma between import specifiers" + | ExportSpecifierMissingComma -> "Missing comma between export specifiers" + | MalformedUnicode -> "Malformed unicode" + | DuplicateConstructor -> "Classes may only have one constructor" + | DuplicatePrivateFields name -> + "Private fields may only be declared once. `#" ^ name ^ "` is declared more than once." + | InvalidClassMemberName { name; static; method_; private_ } -> + let static_modifier = + if static then + "static " + else + "" + in + let name = + if private_ then + "#" ^ name + else + name + in + let category = + if method_ then + "methods" + else + "fields" + in + "Classes may not have " ^ static_modifier ^ category ^ " named `" ^ name ^ "`." + | PrivateDelete -> "Private fields may not be deleted." + | UnboundPrivate name -> + "Private fields must be declared before they can be referenced. `#" + ^ name + ^ "` has not been declared." + | PrivateNotInClass -> "Private fields can only be referenced from within a class." + | SuperPrivate -> "You may not access a private field through the `super` keyword." + | YieldInFormalParameters -> "Yield expression not allowed in formal parameter" + | AwaitAsIdentifierReference -> "`await` is an invalid identifier in async functions" + | YieldAsIdentifierReference -> "`yield` is an invalid identifier in generators" + | AmbiguousLetBracket -> + "`let [` is ambiguous in this position because it is " + ^ "either a `let` binding pattern, or a member expression." + | LiteralShorthandProperty -> "Literals cannot be used as shorthand properties." + | ComputedShorthandProperty -> "Computed properties must have a value." + | MethodInDestructuring -> "Object pattern can't contain methods" + | TrailingCommaAfterRestElement -> "A trailing comma is not permitted after the rest element" + | OptionalChainNew -> "An optional chain may not be used in a `new` expression." + | OptionalChainTemplate -> "Template literals may not be used in an optional chain." + | NullishCoalescingUnexpectedLogical operator -> + Printf.sprintf + "Unexpected token `%s`. Parentheses are required to combine `??` with `&&` or `||` expressions." + operator + | WhitespaceInPrivateName -> "Unexpected whitespace between `#` and identifier" + | ThisParamAnnotationRequired -> "A type annotation is required for the `this` parameter." + | ThisParamMustBeFirst -> "The `this` parameter must be the first function parameter." + | ThisParamMayNotBeOptional -> "The `this` parameter cannot be optional." + | GetterMayNotHaveThisParam -> "A getter cannot have a `this` parameter." + | SetterMayNotHaveThisParam -> "A setter cannot have a `this` parameter." + | ThisParamBannedInArrowFunctions -> + "Arrow functions cannot have a `this` parameter; arrow functions automatically bind `this` when declared." + | ThisParamBannedInConstructor -> + "Constructors cannot have a `this` parameter; constructors don't bind `this` like other functions." + | InvalidTypeof -> "`typeof` can only be used to get the type of variables." +end diff --git a/flow/parser/parser_common.ml b/flow/parser/parser_common.ml new file mode 100644 index 0000000000..ae56ece39d --- /dev/null +++ b/flow/parser/parser_common.ml @@ -0,0 +1,216 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open Parser_env +open Flow_ast + +type pattern_errors = { + if_expr: (Loc.t * Parse_error.t) list; + if_patt: (Loc.t * Parse_error.t) list; +} + +type pattern_cover = + | Cover_expr of (Loc.t, Loc.t) Expression.t + | Cover_patt of (Loc.t, Loc.t) Expression.t * pattern_errors + +module type PARSER = sig + val program : env -> (Loc.t, Loc.t) Program.t + + val statement : env -> (Loc.t, Loc.t) Statement.t + + val statement_list_item : + ?decorators:(Loc.t, Loc.t) Class.Decorator.t list -> env -> (Loc.t, Loc.t) Statement.t + + val statement_list : term_fn:(Token.t -> bool) -> env -> (Loc.t, Loc.t) Statement.t list + + val statement_list_with_directives : + term_fn:(Token.t -> bool) -> env -> (Loc.t, Loc.t) Statement.t list * bool + + val module_body : term_fn:(Token.t -> bool) -> env -> (Loc.t, Loc.t) Statement.t list + + val expression : env -> (Loc.t, Loc.t) Expression.t + + val expression_or_pattern : env -> pattern_cover + + val conditional : env -> (Loc.t, Loc.t) Expression.t + + val assignment : env -> (Loc.t, Loc.t) Expression.t + + val left_hand_side : env -> (Loc.t, Loc.t) Expression.t + + val object_initializer : env -> Loc.t * (Loc.t, Loc.t) Expression.Object.t * pattern_errors + + val identifier : ?restricted_error:Parse_error.t -> env -> (Loc.t, Loc.t) Identifier.t + + val identifier_with_type : + env -> ?no_optional:bool -> Parse_error.t -> Loc.t * (Loc.t, Loc.t) Pattern.Identifier.t + + val block_body : env -> Loc.t * (Loc.t, Loc.t) Statement.Block.t + + val function_block_body : + expression:bool -> env -> Loc.t * (Loc.t, Loc.t) Statement.Block.t * bool + + val jsx_element_or_fragment : + env -> + Loc.t * [ `Element of (Loc.t, Loc.t) JSX.element | `Fragment of (Loc.t, Loc.t) JSX.fragment ] + + val pattern : env -> Parse_error.t -> (Loc.t, Loc.t) Pattern.t + + val pattern_from_expr : env -> (Loc.t, Loc.t) Expression.t -> (Loc.t, Loc.t) Pattern.t + + val object_key : ?class_body:bool -> env -> Loc.t * (Loc.t, Loc.t) Expression.Object.Property.key + + val class_declaration : env -> (Loc.t, Loc.t) Class.Decorator.t list -> (Loc.t, Loc.t) Statement.t + + val class_expression : env -> (Loc.t, Loc.t) Expression.t + + val is_assignable_lhs : (Loc.t, Loc.t) Expression.t -> bool + + val number : env -> Token.number_type -> string -> float +end + +let identifier_name_raw env = + let open Token in + let name = + match Peek.token env with + (* obviously, Identifier is a valid IdentifierName *) + | T_IDENTIFIER { value; _ } -> value + (* keywords are also IdentifierNames *) + | T_AWAIT -> "await" + | T_BREAK -> "break" + | T_CASE -> "case" + | T_CATCH -> "catch" + | T_CLASS -> "class" + | T_CONST -> "const" + | T_CONTINUE -> "continue" + | T_DEBUGGER -> "debugger" + | T_DEFAULT -> "default" + | T_DELETE -> "delete" + | T_DO -> "do" + | T_ELSE -> "else" + | T_EXPORT -> "export" + | T_EXTENDS -> "extends" + | T_FINALLY -> "finally" + | T_FOR -> "for" + | T_FUNCTION -> "function" + | T_IF -> "if" + | T_IMPORT -> "import" + | T_IN -> "in" + | T_INSTANCEOF -> "instanceof" + | T_NEW -> "new" + | T_RETURN -> "return" + | T_SUPER -> "super" + | T_SWITCH -> "switch" + | T_THIS -> "this" + | T_THROW -> "throw" + | T_TRY -> "try" + | T_TYPEOF -> "typeof" + | T_VAR -> "var" + | T_VOID -> "void" + | T_WHILE -> "while" + | T_WITH -> "with" + | T_YIELD -> "yield" + (* FutureReservedWord *) + | T_ENUM -> "enum" + | T_LET -> "let" + | T_STATIC -> "static" + | T_INTERFACE -> "interface" + | T_IMPLEMENTS -> "implements" + | T_PACKAGE -> "package" + | T_PRIVATE -> "private" + | T_PROTECTED -> "protected" + | T_PUBLIC -> "public" + (* NullLiteral *) + | T_NULL -> "null" + (* BooleanLiteral *) + | T_TRUE -> "true" + | T_FALSE -> "false" + (* Flow-specific stuff *) + | T_DECLARE -> "declare" + | T_TYPE -> "type" + | T_OPAQUE -> "opaque" + | T_ANY_TYPE -> "any" + | T_MIXED_TYPE -> "mixed" + | T_EMPTY_TYPE -> "empty" + | T_BOOLEAN_TYPE BOOL -> "bool" + | T_BOOLEAN_TYPE BOOLEAN -> "boolean" + | T_NUMBER_TYPE -> "number" + | T_BIGINT_TYPE -> "bigint" + | T_STRING_TYPE -> "string" + | T_VOID_TYPE -> "void" + | T_SYMBOL_TYPE -> "symbol" + (* Contextual stuff *) + | T_OF -> "of" + | T_ASYNC -> "async" + (* punctuators, types, literals, etc are not identifiers *) + | _ -> + error_unexpected ~expected:"an identifier" env; + "" + in + Eat.token env; + name + +(* IdentifierName - https://tc39.github.io/ecma262/#prod-IdentifierName *) +let identifier_name env = + let loc = Peek.loc env in + let leading = Peek.comments env in + let name = identifier_name_raw env in + let trailing = Eat.trailing_comments env in + let comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () in + (loc, { Identifier.name; comments }) + +(** PrivateIdentifier - https://tc39.es/ecma262/#prod-PrivateIdentifier + + N.B.: whitespace, line terminators, and comments are not allowed + between the # and IdentifierName because PrivateIdentifier is a + CommonToken which is considered a single token. See also + https://tc39.es/ecma262/#prod-InputElementDiv *) +let private_identifier env = + let start_loc = Peek.loc env in + let leading = Peek.comments env in + Expect.token env Token.T_POUND; + let name_loc = Peek.loc env in + let name = identifier_name_raw env in + let trailing = Eat.trailing_comments env in + let comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () in + let loc = Loc.btwn start_loc name_loc in + if not (Loc.equal_position start_loc.Loc._end name_loc.Loc.start) then + error_at env (loc, Parse_error.WhitespaceInPrivateName); + (loc, { PrivateName.name; comments }) + +(** + * The abstract operation IsLabelledFunction + * + * https://tc39.github.io/ecma262/#sec-islabelledfunction + *) +let rec is_labelled_function = function + | (_, Flow_ast.Statement.Labeled { Flow_ast.Statement.Labeled.body; _ }) -> + begin + match body with + | (_, Flow_ast.Statement.FunctionDeclaration _) -> true + | _ -> is_labelled_function body + end + | _ -> false + +let with_loc ?start_loc fn env = + let start_loc = + match start_loc with + | Some x -> x + | None -> Peek.loc env + in + let result = fn env in + let loc = + match last_loc env with + | Some end_loc -> Loc.btwn start_loc end_loc + | None -> start_loc + in + (loc, result) + +let with_loc_opt ?start_loc fn env = + match with_loc ?start_loc fn env with + | (loc, Some x) -> Some (loc, x) + | (_, None) -> None diff --git a/flow/parser/parser_env.ml b/flow/parser/parser_env.ml new file mode 100644 index 0000000000..06ea42c55c --- /dev/null +++ b/flow/parser/parser_env.ml @@ -0,0 +1,1205 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +module Sedlexing = Flow_sedlexing +open Flow_ast +module SSet = Flow_set.Make (String) + +module Lex_mode = struct + type t = + | NORMAL + | TYPE + | JSX_TAG + | JSX_CHILD + | TEMPLATE + | REGEXP + + let debug_string_of_lex_mode (mode : t) = + match mode with + | NORMAL -> "NORMAL" + | TYPE -> "TYPE" + | JSX_TAG -> "JSX_TAG" + | JSX_CHILD -> "JSX_CHILD" + | TEMPLATE -> "TEMPLATE" + | REGEXP -> "REGEXP" +end + +(* READ THIS BEFORE YOU MODIFY: + * + * The current implementation for lookahead beyond a single token is + * inefficient. If you believe you need to increase this constant, do one of the + * following: + * - Find another way + * - Benchmark your change and provide convincing evidence that it doesn't + * actually have a significant perf impact. + * - Refactor this to memoize all requested lookahead, so we aren't lexing the + * same token multiple times. + *) + +module Lookahead : sig + type t + + val create : Lex_env.t -> Lex_mode.t -> t + + val peek_0 : t -> Lex_result.t + + val peek_1 : t -> Lex_result.t + + val lex_env_0 : t -> Lex_env.t + + val junk : t -> unit +end = struct + type la_result = (Lex_env.t * Lex_result.t) option + + type t = { + mutable la_results_0: la_result; + mutable la_results_1: la_result; + la_lex_mode: Lex_mode.t; + mutable la_lex_env: Lex_env.t; + } + + let create lex_env mode = + let lex_env = Lex_env.clone lex_env in + { la_results_0 = None; la_results_1 = None; la_lex_mode = mode; la_lex_env = lex_env } + + (* precondition: there is enough room in t.la_results for the result *) + let lex t = + let lex_env = t.la_lex_env in + let (lex_env, lex_result) = + match t.la_lex_mode with + | Lex_mode.NORMAL -> Flow_lexer.token lex_env + | Lex_mode.TYPE -> Flow_lexer.type_token lex_env + | Lex_mode.JSX_TAG -> Flow_lexer.jsx_tag lex_env + | Lex_mode.JSX_CHILD -> Flow_lexer.jsx_child lex_env + | Lex_mode.TEMPLATE -> Flow_lexer.template_tail lex_env + | Lex_mode.REGEXP -> Flow_lexer.regexp lex_env + in + let cloned_env = Lex_env.clone lex_env in + let result = (cloned_env, lex_result) in + t.la_lex_env <- lex_env; + begin + match t.la_results_0 with + | None -> t.la_results_0 <- Some result + | Some _ -> t.la_results_1 <- Some result + end; + result + + let peek_0 t = + match t.la_results_0 with + | Some (_, result) -> result + | None -> snd (lex t) + + let peek_1 t = + (match t.la_results_0 with + | None -> ignore (lex t) + | Some _ -> ()); + match t.la_results_1 with + | None -> snd (lex t) + | Some (_, result) -> result + + let lex_env_0 t = + match t.la_results_0 with + | Some (lex_env, _) -> lex_env + | None -> fst (lex t) + + (* Throws away the first peeked-at token, shifting any subsequent tokens up *) + let junk t = + match t.la_results_1 with + | None -> + ignore (peek_0 t); + t.la_results_0 <- None + | Some _ -> + t.la_results_0 <- t.la_results_1; + t.la_results_1 <- None +end + +type token_sink_result = { + token_loc: Loc.t; + token: Token.t; + token_context: Lex_mode.t; +} + +type parse_options = { + enums: bool; (** enable parsing of Flow enums *) + esproposal_decorators: bool; (** enable parsing of decorators *) + esproposal_export_star_as: bool; (** enable parsing of `export * as` syntax *) + types: bool; (** enable parsing of Flow types *) + use_strict: bool; (** treat the file as strict, without needing a "use strict" directive *) +} + +let default_parse_options = + { + enums = false; + esproposal_decorators = false; + esproposal_export_star_as = false; + types = true; + use_strict = false; + } + +type allowed_super = + | No_super + | Super_prop + | Super_prop_or_call + +type env = { + errors: (Loc.t * Parse_error.t) list ref; + comments: Loc.t Comment.t list ref; + labels: SSet.t; + exports: SSet.t ref; + last_lex_result: Lex_result.t option ref; + in_strict_mode: bool; + in_export: bool; + in_loop: bool; + in_switch: bool; + in_formal_parameters: bool; + in_function: bool; + no_in: bool; + no_call: bool; + no_let: bool; + no_anon_function_type: bool; + no_new: bool; + allow_yield: bool; + allow_await: bool; + allow_directive: bool; + allow_super: allowed_super; + error_callback: (env -> Parse_error.t -> unit) option; + lex_mode_stack: Lex_mode.t list ref; + (* lex_env is the lex_env after the single lookahead has been lexed *) + lex_env: Lex_env.t ref; + (* This needs to be cleared whenever we advance. *) + lookahead: Lookahead.t ref; + token_sink: (token_sink_result -> unit) option ref; + parse_options: parse_options; + source: File_key.t option; + (* It is a syntax error to reference private fields not in scope. In order to enforce this, + * we keep track of the privates we've seen declared and used. *) + privates: (SSet.t * (string * Loc.t) list) list ref; + (* The position up to which comments have been consumed, exclusive. *) + consumed_comments_pos: Loc.position ref; +} + +(* constructor *) +let init_env ?(token_sink = None) ?(parse_options = None) source content = + (* let lb = Sedlexing.Utf16.from_string + content (Some Sedlexing.Utf16.Little_endian) in *) + let (lb, errors) = + try (Sedlexing.Utf8.from_string content, []) with + | Sedlexing.MalFormed -> + (Sedlexing.Utf8.from_string "", [({ Loc.none with Loc.source }, Parse_error.MalformedUnicode)]) + in + let parse_options = + match parse_options with + | Some opts -> opts + | None -> default_parse_options + in + let enable_types_in_comments = parse_options.types in + let lex_env = Lex_env.new_lex_env source lb ~enable_types_in_comments in + { + errors = ref errors; + comments = ref []; + labels = SSet.empty; + exports = ref SSet.empty; + last_lex_result = ref None; + in_strict_mode = parse_options.use_strict; + in_export = false; + in_loop = false; + in_switch = false; + in_formal_parameters = false; + in_function = false; + no_in = false; + no_call = false; + no_let = false; + no_anon_function_type = false; + no_new = false; + allow_yield = false; + allow_await = false; + allow_directive = false; + allow_super = No_super; + error_callback = None; + lex_mode_stack = ref [Lex_mode.NORMAL]; + lex_env = ref lex_env; + lookahead = ref (Lookahead.create lex_env Lex_mode.NORMAL); + token_sink = ref token_sink; + parse_options; + source; + privates = ref []; + consumed_comments_pos = ref { Loc.line = 0; column = 0 }; + } + +(* getters: *) +let in_strict_mode env = env.in_strict_mode + +let lex_mode env = List.hd !(env.lex_mode_stack) + +let in_export env = env.in_export + +let comments env = !(env.comments) + +let labels env = env.labels + +let in_loop env = env.in_loop + +let in_switch env = env.in_switch + +let in_formal_parameters env = env.in_formal_parameters + +let in_function env = env.in_function + +let allow_yield env = env.allow_yield + +let allow_await env = env.allow_await + +let allow_directive env = env.allow_directive + +let allow_super env = env.allow_super + +let no_in env = env.no_in + +let no_call env = env.no_call + +let no_let env = env.no_let + +let no_anon_function_type env = env.no_anon_function_type + +let no_new env = env.no_new + +let errors env = !(env.errors) + +let parse_options env = env.parse_options + +let source env = env.source + +let should_parse_types env = env.parse_options.types + +(* mutators: *) +let error_at env (loc, e) = + env.errors := (loc, e) :: !(env.errors); + match env.error_callback with + | None -> () + | Some callback -> callback env e + +let record_export env (loc, { Identifier.name = export_name; comments = _ }) = + if export_name = "" then + () + else + (* empty identifiers signify an error, don't export it *) + let exports = !(env.exports) in + if SSet.mem export_name exports then + error_at env (loc, Parse_error.DuplicateExport export_name) + else + env.exports := SSet.add export_name !(env.exports) + +(* Since private fields out of scope are a parse error, we keep track of the declared and used + * private fields. + * + * Whenever we enter a class, we push new empty lists of declared and used privates. + * When we encounter a new declared private, we add it to the top of the declared_privates list + * via add_declared_private. We do the same with used_privates via add_used_private. + * + * When we exit a class, we look for all the unbound private variables. Since class fields + * are hoisted to the scope of the class, we may need to look further before we conclude that + * a field is out of scope. To do that, we add all of the unbound private fields to the + * next used_private list. Once we run out of declared private lists, any leftover used_privates + * are unbound private variables. *) +let enter_class env = env.privates := (SSet.empty, []) :: !(env.privates) + +let exit_class env = + let get_unbound_privates declared_privates used_privates = + List.filter (fun x -> not (SSet.mem (fst x) declared_privates)) used_privates + in + match !(env.privates) with + | [(declared_privates, used_privates)] -> + let unbound_privates = get_unbound_privates declared_privates used_privates in + List.iter + (fun (name, loc) -> error_at env (loc, Parse_error.UnboundPrivate name)) + unbound_privates; + env.privates := [] + | (loc_declared_privates, loc_used_privates) :: privates -> + let unbound_privates = get_unbound_privates loc_declared_privates loc_used_privates in + let (decl_head, used_head) = List.hd privates in + env.privates := (decl_head, used_head @ unbound_privates) :: List.tl privates + | _ -> failwith "Internal Error: `exit_class` called before a matching `enter_class`" + +let add_declared_private env name = + match !(env.privates) with + | [] -> failwith "Internal Error: Tried to add_declared_private with outside of class scope." + | (declared, used) :: xs -> env.privates := (SSet.add name declared, used) :: xs + +let add_used_private env name loc = + match !(env.privates) with + | [] -> error_at env (loc, Parse_error.PrivateNotInClass) + | (declared, used) :: xs -> env.privates := (declared, (name, loc) :: used) :: xs + +let consume_comments_until env pos = env.consumed_comments_pos := pos + +(* lookahead: *) +let lookahead_0 env = Lookahead.peek_0 !(env.lookahead) + +let lookahead_1 env = Lookahead.peek_1 !(env.lookahead) + +let lookahead ~i env = + match i with + | 0 -> lookahead_0 env + | 1 -> lookahead_1 env + | _ -> assert false + +(* functional operations: *) +let with_strict in_strict_mode env = + if in_strict_mode = env.in_strict_mode then + env + else + { env with in_strict_mode } + +let with_in_formal_parameters in_formal_parameters env = + if in_formal_parameters = env.in_formal_parameters then + env + else + { env with in_formal_parameters } + +let with_in_function in_function env = + if in_function = env.in_function then + env + else + { env with in_function } + +let with_allow_yield allow_yield env = + if allow_yield = env.allow_yield then + env + else + { env with allow_yield } + +let with_allow_await allow_await env = + if allow_await = env.allow_await then + env + else + { env with allow_await } + +let with_allow_directive allow_directive env = + if allow_directive = env.allow_directive then + env + else + { env with allow_directive } + +let with_allow_super allow_super env = + if allow_super = env.allow_super then + env + else + { env with allow_super } + +let with_no_let no_let env = + if no_let = env.no_let then + env + else + { env with no_let } + +let with_in_loop in_loop env = + if in_loop = env.in_loop then + env + else + { env with in_loop } + +let with_no_in no_in env = + if no_in = env.no_in then + env + else + { env with no_in } + +let with_no_anon_function_type no_anon_function_type env = + if no_anon_function_type = env.no_anon_function_type then + env + else + { env with no_anon_function_type } + +let with_no_new no_new env = + if no_new = env.no_new then + env + else + { env with no_new } + +let with_in_switch in_switch env = + if in_switch = env.in_switch then + env + else + { env with in_switch } + +let with_in_export in_export env = + if in_export = env.in_export then + env + else + { env with in_export } + +let with_no_call no_call env = + if no_call = env.no_call then + env + else + { env with no_call } + +let with_error_callback error_callback env = { env with error_callback = Some error_callback } + +(* other helper functions: *) +let error_list env = List.iter (error_at env) + +let last_loc env = + match !(env.last_lex_result) with + | Some lex_result -> Some (Lex_result.loc lex_result) + | None -> None + +let last_token env = + match !(env.last_lex_result) with + | Some lex_result -> Some (Lex_result.token lex_result) + | None -> None + +let without_error_callback env = { env with error_callback = None } + +let add_label env label = { env with labels = SSet.add label env.labels } + +let enter_function env ~async ~generator = + { + env with + in_formal_parameters = false; + in_function = true; + in_loop = false; + in_switch = false; + in_export = false; + labels = SSet.empty; + allow_await = async; + allow_yield = generator; + } + +(* #sec-keywords *) +let is_keyword = function + | "await" + | "break" + | "case" + | "catch" + | "class" + | "const" + | "continue" + | "debugger" + | "default" + | "delete" + | "do" + | "else" + | "export" + | "extends" + | "finally" + | "for" + | "function" + | "if" + | "import" + | "in" + | "instanceof" + | "new" + | "return" + | "super" + | "switch" + | "this" + | "throw" + | "try" + | "typeof" + | "var" + | "void" + | "while" + | "with" + | "yield" -> + true + | _ -> false + +let token_is_keyword = + Token.( + function + | T_IDENTIFIER { raw; _ } when is_keyword raw -> true + | T_AWAIT + | T_BREAK + | T_CASE + | T_CATCH + | T_CLASS + | T_CONST + | T_CONTINUE + | T_DEBUGGER + | T_DEFAULT + | T_DELETE + | T_DO + | T_ELSE + | T_EXPORT + | T_EXTENDS + | T_FINALLY + | T_FOR + | T_FUNCTION + | T_IF + | T_IMPORT + | T_IN + | T_INSTANCEOF + | T_NEW + | T_RETURN + | T_SUPER + | T_SWITCH + | T_THIS + | T_THROW + | T_TRY + | T_TYPEOF + | T_VAR + | T_VOID + | T_WHILE + | T_WITH + | T_YIELD -> + true + | _ -> false + ) + +(* #sec-future-reserved-words *) +let is_future_reserved = function + | "enum" -> true + | _ -> false + +let token_is_future_reserved = + Token.( + function + | T_IDENTIFIER { raw; _ } when is_future_reserved raw -> true + | T_ENUM -> true + | _ -> false + ) + +(* #sec-strict-mode-of-ecmascript *) +let is_strict_reserved = function + | "interface" + | "implements" + | "package" + | "private" + | "protected" + | "public" + | "static" + | "yield" -> + true + | _ -> false + +let token_is_strict_reserved = + Token.( + function + | T_IDENTIFIER { raw; _ } when is_strict_reserved raw -> true + | T_INTERFACE + | T_IMPLEMENTS + | T_PACKAGE + | T_PRIVATE + | T_PROTECTED + | T_PUBLIC + | T_STATIC + | T_YIELD -> + true + | _ -> false + ) + +(* #sec-strict-mode-of-ecmascript *) +let is_restricted = function + | "eval" + | "arguments" -> + true + | _ -> false + +let token_is_restricted = + Token.( + function + | T_IDENTIFIER { raw; _ } when is_restricted raw -> true + | _ -> false + ) + +(* #sec-reserved-words *) +let is_reserved str_val = + is_keyword str_val + || is_future_reserved str_val + || + match str_val with + | "null" + | "true" + | "false" -> + true + | _ -> false + +let token_is_reserved t = + token_is_keyword t + || token_is_future_reserved t + || + match t with + | Token.T_IDENTIFIER { raw = "null" | "true" | "false"; _ } + | Token.T_NULL + | Token.T_TRUE + | Token.T_FALSE -> + true + | _ -> false + +let is_reserved_type str_val = + match str_val with + | "any" + | "bool" + | "boolean" + | "empty" + | "false" + | "mixed" + | "null" + | "number" + | "bigint" + | "static" + | "string" + | "true" + | "typeof" + | "void" + | "interface" + | "extends" + | "_" -> + true + | _ -> false + +(* Answer questions about what comes next *) +module Peek = struct + open Loc + open Token + + let ith_token ~i env = Lex_result.token (lookahead ~i env) + + let ith_loc ~i env = Lex_result.loc (lookahead ~i env) + + let ith_errors ~i env = Lex_result.errors (lookahead ~i env) + + let ith_comments ~i env = + let comments = Lex_result.comments (lookahead ~i env) in + match comments with + | [] -> [] + | _ -> + List.filter + (fun ({ Loc.start; _ }, _) -> Loc.pos_cmp !(env.consumed_comments_pos) start <= 0) + comments + + let token env = ith_token ~i:0 env + + let loc env = ith_loc ~i:0 env + + (* loc_skip_lookahead is used to give a loc hint to optional tokens such as type annotations *) + let loc_skip_lookahead env = + let loc = + match last_loc env with + | Some loc -> loc + | None -> failwith "Peeking current location when not available" + in + Loc.{ loc with start = loc._end } + + let errors env = ith_errors ~i:0 env + + let comments env = ith_comments ~i:0 env + + let has_eaten_comments env = + let comments = Lex_result.comments (lookahead ~i:0 env) in + List.exists + (fun ({ Loc.start; _ }, _) -> Loc.pos_cmp start !(env.consumed_comments_pos) < 0) + comments + + let lex_env env = Lookahead.lex_env_0 !(env.lookahead) + + (* True if there is a line terminator before the next token *) + let ith_is_line_terminator ~i env = + let loc = + if i > 0 then + Some (ith_loc ~i:(i - 1) env) + else + last_loc env + in + match loc with + | None -> false + | Some loc' -> (ith_loc ~i env).start.line > loc'.start.line + + let is_line_terminator env = ith_is_line_terminator ~i:0 env + + let ith_is_implicit_semicolon ~i env = + match ith_token ~i env with + | T_EOF + | T_RCURLY -> + true + | T_SEMICOLON -> false + | _ -> ith_is_line_terminator ~i env + + let is_implicit_semicolon env = ith_is_implicit_semicolon ~i:0 env + + let ith_is_identifier ~i env = + match ith_token ~i env with + | t when token_is_strict_reserved t -> true + | t when token_is_future_reserved t -> true + | t when token_is_restricted t -> true + | T_LET + | T_TYPE + | T_OPAQUE + | T_OF + | T_DECLARE + | T_ASYNC + | T_AWAIT + | T_POUND + | T_IDENTIFIER _ -> + true + | _ -> false + + let ith_is_type_identifier ~i env = + match lex_mode env with + | Lex_mode.TYPE -> + begin + match ith_token ~i env with + | T_IDENTIFIER _ -> true + | _ -> false + end + | Lex_mode.NORMAL -> + (* Sometimes we peek at type identifiers while in normal lex mode. For + example, when deciding whether a `type` token is an identifier or the + start of a type declaration, based on whether the following token + `is_type_identifier`. *) + begin + match ith_token ~i env with + | T_IDENTIFIER { raw; _ } when is_reserved_type raw -> false + (* reserved type identifiers, but these don't appear in NORMAL mode *) + | T_ANY_TYPE + | T_MIXED_TYPE + | T_EMPTY_TYPE + | T_NUMBER_TYPE + | T_BIGINT_TYPE + | T_STRING_TYPE + | T_VOID_TYPE + | T_SYMBOL_TYPE + | T_BOOLEAN_TYPE _ + | T_NUMBER_SINGLETON_TYPE _ + | T_BIGINT_SINGLETON_TYPE _ + (* identifier-ish *) + | T_ASYNC + | T_AWAIT + | T_BREAK + | T_CASE + | T_CATCH + | T_CLASS + | T_CONST + | T_CONTINUE + | T_DEBUGGER + | T_DECLARE + | T_DEFAULT + | T_DELETE + | T_DO + | T_ELSE + | T_ENUM + | T_EXPORT + | T_EXTENDS + | T_FALSE + | T_FINALLY + | T_FOR + | T_FUNCTION + | T_IDENTIFIER _ + | T_IF + | T_IMPLEMENTS + | T_IMPORT + | T_IN + | T_INSTANCEOF + | T_INTERFACE + | T_LET + | T_NEW + | T_NULL + | T_OF + | T_OPAQUE + | T_PACKAGE + | T_PRIVATE + | T_PROTECTED + | T_PUBLIC + | T_RETURN + | T_SUPER + | T_SWITCH + | T_THIS + | T_THROW + | T_TRUE + | T_TRY + | T_TYPE + | T_VAR + | T_WHILE + | T_WITH + | T_YIELD -> + true + (* identifier-ish, but not valid types *) + | T_STATIC + | T_TYPEOF + | T_VOID -> + false + (* syntax *) + | T_LCURLY + | T_RCURLY + | T_LCURLYBAR + | T_RCURLYBAR + | T_LPAREN + | T_RPAREN + | T_LBRACKET + | T_RBRACKET + | T_SEMICOLON + | T_COMMA + | T_PERIOD + | T_ARROW + | T_ELLIPSIS + | T_AT + | T_POUND + | T_CHECKS + | T_RSHIFT3_ASSIGN + | T_RSHIFT_ASSIGN + | T_LSHIFT_ASSIGN + | T_BIT_XOR_ASSIGN + | T_BIT_OR_ASSIGN + | T_BIT_AND_ASSIGN + | T_MOD_ASSIGN + | T_DIV_ASSIGN + | T_MULT_ASSIGN + | T_EXP_ASSIGN + | T_MINUS_ASSIGN + | T_PLUS_ASSIGN + | T_ASSIGN + | T_PLING_PERIOD + | T_PLING_PLING + | T_PLING + | T_COLON + | T_OR + | T_AND + | T_BIT_OR + | T_BIT_XOR + | T_BIT_AND + | T_EQUAL + | T_NOT_EQUAL + | T_STRICT_EQUAL + | T_STRICT_NOT_EQUAL + | T_LESS_THAN_EQUAL + | T_GREATER_THAN_EQUAL + | T_LESS_THAN + | T_GREATER_THAN + | T_LSHIFT + | T_RSHIFT + | T_RSHIFT3 + | T_PLUS + | T_MINUS + | T_DIV + | T_MULT + | T_EXP + | T_MOD + | T_NOT + | T_BIT_NOT + | T_INCR + | T_DECR + | T_EOF -> + false + (* literals *) + | T_NUMBER _ + | T_BIGINT _ + | T_STRING _ + | T_TEMPLATE_PART _ + | T_REGEXP _ + (* misc that shouldn't appear in NORMAL mode *) + | T_JSX_IDENTIFIER _ + | T_JSX_TEXT _ + | T_ERROR _ -> + false + end + | Lex_mode.JSX_TAG + | Lex_mode.JSX_CHILD + | Lex_mode.TEMPLATE + | Lex_mode.REGEXP -> + false + + let ith_is_identifier_name ~i env = ith_is_identifier ~i env || ith_is_type_identifier ~i env + + (* This returns true if the next token is identifier-ish (even if it is an + error) *) + let is_identifier env = ith_is_identifier ~i:0 env + + let is_identifier_name env = ith_is_identifier_name ~i:0 env + + let is_type_identifier env = ith_is_type_identifier ~i:0 env + + let is_function env = + token env = T_FUNCTION + || token env = T_ASYNC + && ith_token ~i:1 env = T_FUNCTION + && (loc env)._end.line = (ith_loc ~i:1 env).start.line + + let is_class env = + match token env with + | T_CLASS + | T_AT -> + true + | _ -> false +end + +(*****************************************************************************) +(* Errors *) +(*****************************************************************************) + +(* Complains about an error at the location of the lookahead *) +let error env e = + let loc = Peek.loc env in + error_at env (loc, e) + +let get_unexpected_error ?expected token = + if token_is_future_reserved token then + Parse_error.UnexpectedReserved + else if token_is_strict_reserved token then + Parse_error.StrictReservedWord + else + let unexpected = Token.explanation_of_token token in + match expected with + | Some expected_msg -> Parse_error.UnexpectedWithExpected (unexpected, expected_msg) + | None -> Parse_error.Unexpected unexpected + +let error_unexpected ?expected env = + (* So normally we consume the lookahead lex result when Eat.token calls + * Parser_env.advance, which will add any lexing errors to our list of errors. + * However, raising an unexpected error for a lookahead is kind of like + * consuming that token, so we should process any lexing errors before + * complaining about the unexpected token *) + error_list env (Peek.errors env); + error env (get_unexpected_error ?expected (Peek.token env)) + +let error_on_decorators env = + List.iter (fun decorator -> error_at env (fst decorator, Parse_error.UnsupportedDecorator)) + +let strict_error env e = if in_strict_mode env then error env e + +let strict_error_at env (loc, e) = if in_strict_mode env then error_at env (loc, e) + +let function_as_statement_error_at env loc = + error_at env (loc, Parse_error.FunctionAsStatement { in_strict_mode = in_strict_mode env }) + +(* Consume zero or more tokens *) +module Eat = struct + (* Consume a single token *) + let token env = + (* If there's a token_sink, emit the lexed token before moving forward *) + (match !(env.token_sink) with + | None -> () + | Some token_sink -> + token_sink + { + token_loc = Peek.loc env; + token = Peek.token env; + (* + * The lex mode is useful because it gives context to some + * context-sensitive tokens. + * + * Some examples of such tokens include: + * + * `=>` - Part of an arrow function? or part of a type annotation? + * `<` - A less-than? Or an opening to a JSX element? + * ...etc... + *) + token_context = lex_mode env; + }); + + env.lex_env := Peek.lex_env env; + + error_list env (Peek.errors env); + env.comments := List.rev_append (Lex_result.comments (lookahead ~i:0 env)) !(env.comments); + env.last_lex_result := Some (lookahead ~i:0 env); + + Lookahead.junk !(env.lookahead) + + (** [maybe env t] eats the next token and returns [true] if it is [t], else return [false] *) + let maybe env t = + if Token.equal (Peek.token env) t then ( + token env; + true + ) else + false + + let push_lex_mode env mode = + env.lex_mode_stack := mode :: !(env.lex_mode_stack); + env.lookahead := Lookahead.create !(env.lex_env) (lex_mode env) + + let pop_lex_mode env = + let new_stack = + match !(env.lex_mode_stack) with + | _mode :: stack -> stack + | _ -> failwith "Popping lex mode from empty stack" + in + env.lex_mode_stack := new_stack; + env.lookahead := Lookahead.create !(env.lex_env) (lex_mode env) + + let double_pop_lex_mode env = + let new_stack = + match !(env.lex_mode_stack) with + | _ :: _ :: stack -> stack + | _ -> failwith "Popping lex mode from empty stack" + in + env.lex_mode_stack := new_stack; + env.lookahead := Lookahead.create !(env.lex_env) (lex_mode env) + + let trailing_comments env = + let open Loc in + let loc = Peek.loc env in + if Peek.token env = Token.T_COMMA && Peek.ith_is_line_terminator ~i:1 env then ( + let trailing_before_comma = Peek.comments env in + let trailing_after_comma = + List.filter + (fun (comment_loc, _) -> comment_loc.start.line <= loc._end.line) + (Lex_result.comments (lookahead ~i:1 env)) + in + let trailing = trailing_before_comma @ trailing_after_comma in + consume_comments_until env { Loc.line = loc._end.line + 1; column = 0 }; + trailing + ) else + let trailing = Peek.comments env in + consume_comments_until env loc._end; + trailing + + let comments_until_next_line env = + let open Loc in + match !(env.last_lex_result) with + | None -> [] + | Some { Lex_result.lex_loc = last_loc; _ } -> + let comments = Peek.comments env in + let comments = List.filter (fun (loc, _) -> loc.start.line <= last_loc._end.line) comments in + consume_comments_until env { line = last_loc._end.line + 1; column = 0 }; + comments + + let program_comments env = + let open Flow_ast.Comment in + let comments = Peek.comments env in + let flow_directive = "@flow" in + let flow_directive_length = String.length flow_directive in + let contains_flow_directive { text; _ } = + let text_length = String.length text in + let rec contains_flow_directive_after_offset off = + if off + flow_directive_length > text_length then + false + else + String.sub text off flow_directive_length = flow_directive + || contains_flow_directive_after_offset (off + 1) + in + contains_flow_directive_after_offset 0 + in + (* Comments up through the last comment with an @flow directive are considered program comments *) + let rec flow_directive_comments comments = + match comments with + | [] -> [] + | (loc, comment) :: rest -> + if contains_flow_directive comment then ( + (env.consumed_comments_pos := Loc.(loc._end)); + List.rev ((loc, comment) :: rest) + ) else + flow_directive_comments rest + in + let program_comments = flow_directive_comments (List.rev comments) in + let program_comments = + if program_comments <> [] then + program_comments + else + (* If there is no @flow directive, consider the first block comment a program comment if + it starts with "/**" *) + match comments with + | ((loc, { kind = Block; text; _ }) as first_comment) :: _ + when String.length text >= 1 && text.[0] = '*' -> + (env.consumed_comments_pos := Loc.(loc._end)); + [first_comment] + | _ -> [] + in + program_comments +end + +module Expect = struct + let error env t = + let expected = Token.explanation_of_token ~use_article:true t in + error_unexpected ~expected env + + let token env t = + if not (Token.equal (Peek.token env) t) then error env t; + Eat.token env + + (** [token_opt env T_FOO] eats a token if it is [T_FOO], and errors without consuming if not. + This differs from [token], which always consumes. Only use [token_opt] when it's ok for + the parser to not advance, like if you are guaranteed that something else has eaten a + token. *) + let token_opt env t = + if not (Token.equal (Peek.token env) t) then + error env t + else + Eat.token env + + let identifier env name = + let t = Peek.token env in + begin + match t with + | Token.T_IDENTIFIER { raw; _ } when raw = name -> () + | _ -> + let expected = Printf.sprintf "the identifier `%s`" name in + error_unexpected ~expected env + end; + Eat.token env +end + +(* This module allows you to try parsing and rollback if you need. This is not + * cheap and its usage is strongly discouraged *) +module Try = struct + type 'a parse_result = + | ParsedSuccessfully of 'a + | FailedToParse + + exception Rollback + + type saved_state = { + saved_errors: (Loc.t * Parse_error.t) list; + saved_comments: Loc.t Flow_ast.Comment.t list; + saved_last_lex_result: Lex_result.t option; + saved_lex_mode_stack: Lex_mode.t list; + saved_lex_env: Lex_env.t; + saved_consumed_comments_pos: Loc.position; + token_buffer: ((token_sink_result -> unit) * token_sink_result Queue.t) option; + } + + let save_state env = + let token_buffer = + match !(env.token_sink) with + | None -> None + | Some orig_token_sink -> + let buffer = Queue.create () in + env.token_sink := Some (fun token_data -> Queue.add token_data buffer); + Some (orig_token_sink, buffer) + in + { + saved_errors = !(env.errors); + saved_comments = !(env.comments); + saved_last_lex_result = !(env.last_lex_result); + saved_lex_mode_stack = !(env.lex_mode_stack); + saved_lex_env = !(env.lex_env); + saved_consumed_comments_pos = !(env.consumed_comments_pos); + token_buffer; + } + + let reset_token_sink ~flush env token_buffer_info = + match token_buffer_info with + | None -> () + | Some (orig_token_sink, token_buffer) -> + env.token_sink := Some orig_token_sink; + if flush then Queue.iter orig_token_sink token_buffer + + let rollback_state env saved_state = + reset_token_sink ~flush:false env saved_state.token_buffer; + env.errors := saved_state.saved_errors; + env.comments := saved_state.saved_comments; + env.last_lex_result := saved_state.saved_last_lex_result; + env.lex_mode_stack := saved_state.saved_lex_mode_stack; + env.lex_env := saved_state.saved_lex_env; + env.consumed_comments_pos := saved_state.saved_consumed_comments_pos; + env.lookahead := Lookahead.create !(env.lex_env) (lex_mode env); + + FailedToParse + + let success env saved_state result = + reset_token_sink ~flush:true env saved_state.token_buffer; + ParsedSuccessfully result + + let to_parse env parse = + let saved_state = save_state env in + try success env saved_state (parse env) with + | Rollback -> rollback_state env saved_state + + let or_else env ~fallback parse = + match to_parse env parse with + | ParsedSuccessfully result -> result + | FailedToParse -> fallback +end diff --git a/flow/parser/parser_env.mli b/flow/parser/parser_env.mli new file mode 100644 index 0000000000..302f96d579 --- /dev/null +++ b/flow/parser/parser_env.mli @@ -0,0 +1,272 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +(* This module provides a layer between the lexer and the parser which includes + * some parser state and some lexer state *) + +module SSet : Flow_set.S with type t = Flow_set.Make(String).t + +module Lex_mode : sig + type t = + | NORMAL + | TYPE + | JSX_TAG + | JSX_CHILD + | TEMPLATE + | REGEXP + + val debug_string_of_lex_mode : t -> string +end + +type token_sink_result = { + token_loc: Loc.t; + token: Token.t; + token_context: Lex_mode.t; +} + +type parse_options = { + enums: bool; (** enable parsing of Flow enums *) + esproposal_decorators: bool; (** enable parsing of decorators *) + esproposal_export_star_as: bool; (** enable parsing of `export * as` syntax *) + types: bool; (** enable parsing of Flow types *) + use_strict: bool; (** treat the file as strict, without needing a "use strict" directive *) +} + +val default_parse_options : parse_options + +type env + +type allowed_super = + | No_super + | Super_prop + | Super_prop_or_call + +(* constructor: *) +val init_env : + ?token_sink:(token_sink_result -> unit) option -> + ?parse_options:parse_options option -> + File_key.t option -> + string -> + env + +(* getters: *) +val in_strict_mode : env -> bool + +val last_loc : env -> Loc.t option + +val last_token : env -> Token.t option + +val in_export : env -> bool + +val labels : env -> SSet.t + +val comments : env -> Loc.t Flow_ast.Comment.t list + +val in_loop : env -> bool + +val in_switch : env -> bool + +val in_formal_parameters : env -> bool + +val in_function : env -> bool + +val allow_yield : env -> bool + +val allow_await : env -> bool + +val allow_directive : env -> bool + +val allow_super : env -> allowed_super + +val no_in : env -> bool + +val no_call : env -> bool + +val no_let : env -> bool + +val no_anon_function_type : env -> bool + +val no_new : env -> bool + +val errors : env -> (Loc.t * Parse_error.t) list + +val parse_options : env -> parse_options + +val source : env -> File_key.t option + +val should_parse_types : env -> bool + +(* mutators: *) +val error_at : env -> Loc.t * Parse_error.t -> unit + +val error : env -> Parse_error.t -> unit + +val error_unexpected : ?expected:string -> env -> unit + +val error_on_decorators : env -> (Loc.t * 'a) list -> unit + +val strict_error : env -> Parse_error.t -> unit + +val strict_error_at : env -> Loc.t * Parse_error.t -> unit + +val function_as_statement_error_at : env -> Loc.t -> unit + +val error_list : env -> (Loc.t * Parse_error.t) list -> unit + +val record_export : env -> (Loc.t, Loc.t) Flow_ast.Identifier.t -> unit + +val enter_class : env -> unit + +val exit_class : env -> unit + +val add_declared_private : env -> string -> unit + +val add_used_private : env -> string -> Loc.t -> unit + +val consume_comments_until : env -> Loc.position -> unit + +(* functional operations -- these return shallow copies, so future mutations to + * the returned env will also affect the original: *) +val with_strict : bool -> env -> env + +val with_in_formal_parameters : bool -> env -> env + +val with_in_function : bool -> env -> env + +val with_allow_yield : bool -> env -> env + +val with_allow_await : bool -> env -> env + +val with_allow_directive : bool -> env -> env + +val with_allow_super : allowed_super -> env -> env + +val with_no_let : bool -> env -> env + +val with_in_loop : bool -> env -> env + +val with_no_in : bool -> env -> env + +val with_no_anon_function_type : bool -> env -> env + +val with_no_new : bool -> env -> env + +val with_in_switch : bool -> env -> env + +val with_in_export : bool -> env -> env + +val with_no_call : bool -> env -> env + +val with_error_callback : (env -> Parse_error.t -> unit) -> env -> env + +val without_error_callback : env -> env + +val add_label : env -> string -> env + +val enter_function : env -> async:bool -> generator:bool -> env + +val is_reserved : string -> bool + +val token_is_reserved : Token.t -> bool + +val is_future_reserved : string -> bool + +val is_strict_reserved : string -> bool + +val token_is_strict_reserved : Token.t -> bool + +val is_restricted : string -> bool + +val is_reserved_type : string -> bool + +val token_is_restricted : Token.t -> bool + +module Peek : sig + val token : env -> Token.t + + val loc : env -> Loc.t + + val loc_skip_lookahead : env -> Loc.t + + val errors : env -> (Loc.t * Parse_error.t) list + + val comments : env -> Loc.t Flow_ast.Comment.t list + + val has_eaten_comments : env -> bool + + val is_line_terminator : env -> bool + + val is_implicit_semicolon : env -> bool + + val is_identifier : env -> bool + + val is_type_identifier : env -> bool + + val is_identifier_name : env -> bool + + val is_function : env -> bool + + val is_class : env -> bool + + val ith_token : i:int -> env -> Token.t + + val ith_loc : i:int -> env -> Loc.t + + val ith_errors : i:int -> env -> (Loc.t * Parse_error.t) list + + val ith_comments : i:int -> env -> Loc.t Flow_ast.Comment.t list + + val ith_is_line_terminator : i:int -> env -> bool + + val ith_is_implicit_semicolon : i:int -> env -> bool + + val ith_is_identifier : i:int -> env -> bool + + val ith_is_identifier_name : i:int -> env -> bool + + val ith_is_type_identifier : i:int -> env -> bool +end + +module Eat : sig + val token : env -> unit + + val maybe : env -> Token.t -> bool + + val push_lex_mode : env -> Lex_mode.t -> unit + + val pop_lex_mode : env -> unit + + val double_pop_lex_mode : env -> unit + + val trailing_comments : env -> Loc.t Flow_ast.Comment.t list + + val comments_until_next_line : env -> Loc.t Flow_ast.Comment.t list + + val program_comments : env -> Loc.t Flow_ast.Comment.t list +end + +module Expect : sig + val error : env -> Token.t -> unit + + val token : env -> Token.t -> unit + + val token_opt : env -> Token.t -> unit + + val identifier : env -> string -> unit +end + +module Try : sig + type 'a parse_result = + | ParsedSuccessfully of 'a + | FailedToParse + + exception Rollback + + val to_parse : env -> (env -> 'a) -> 'a parse_result + + val or_else : env -> fallback:'a -> (env -> 'a) -> 'a +end diff --git a/flow/parser/parser_flow.ml b/flow/parser/parser_flow.ml new file mode 100644 index 0000000000..78798bcd61 --- /dev/null +++ b/flow/parser/parser_flow.ml @@ -0,0 +1,459 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +module Sedlexing = Flow_sedlexing +module Ast = Flow_ast +open Token +open Parser_env +open Parser_common + +(* Sometimes we add the same error for multiple different reasons. This is hard + to avoid, so instead we just filter the duplicates out. This function takes + a reversed list of errors and returns the list in forward order with dupes + removed. This differs from a set because the original order is preserved. *) +let filter_duplicate_errors = + let module PrintableErrorSet = Flow_set.Make (struct + type t = Loc.t * Parse_error.t + + let compare (a_loc, a_error) (b_loc, b_error) = + let loc = Loc.compare a_loc b_loc in + if loc = 0 then + Parse_error.compare a_error b_error + else + loc + end) in + fun errs -> + let errs = List.rev errs in + let (_, deduped) = + List.fold_left + (fun (set, deduped) err -> + if PrintableErrorSet.mem err set then + (set, deduped) + else + (PrintableErrorSet.add err set, err :: deduped)) + (PrintableErrorSet.empty, []) + errs + in + List.rev deduped + +module rec Parse : PARSER = struct + module Type = Type_parser.Type (Parse) + module Declaration = Declaration_parser.Declaration (Parse) (Type) + module Pattern_cover = Pattern_cover.Cover (Parse) + module Expression = Expression_parser.Expression (Parse) (Type) (Declaration) (Pattern_cover) + module Object = Object_parser.Object (Parse) (Type) (Declaration) (Expression) (Pattern_cover) + module Statement = + Statement_parser.Statement (Parse) (Type) (Declaration) (Object) (Pattern_cover) + module Pattern = Pattern_parser.Pattern (Parse) (Type) + module JSX = Jsx_parser.JSX (Parse) + + let identifier ?restricted_error env = + (match Peek.token env with + (* "let" is disallowed as an identifier in a few situations. 11.6.2.1 + lists them out. It is always disallowed in strict mode *) + | T_LET when in_strict_mode env -> error env Parse_error.StrictReservedWord + | T_LET when no_let env -> error_unexpected env + | T_LET -> () + (* `allow_await` means that `await` is allowed to be a keyword, + which makes it illegal to use as an identifier. + https://tc39.github.io/ecma262/#sec-identifiers-static-semantics-early-errors *) + | T_AWAIT when allow_await env -> error env Parse_error.UnexpectedReserved + | T_AWAIT -> () + (* `allow_yield` means that `yield` is allowed to be a keyword, + which makes it illegal to use as an identifier. + https://tc39.github.io/ecma262/#sec-identifiers-static-semantics-early-errors *) + | T_YIELD when allow_yield env -> error env Parse_error.UnexpectedReserved + | T_YIELD when in_strict_mode env -> error env Parse_error.StrictReservedWord + | T_YIELD -> () + | t when token_is_strict_reserved t -> strict_error env Parse_error.StrictReservedWord + | t when token_is_reserved t -> error_unexpected env + | t -> + (match restricted_error with + | Some err when token_is_restricted t -> strict_error env err + | _ -> ())); + identifier_name env + + let rec program env = + let leading = Eat.program_comments env in + let stmts = module_body_with_directives env (fun _ -> false) in + let end_loc = Peek.loc env in + Expect.token env T_EOF; + let loc = + match stmts with + | [] -> end_loc + | _ -> Loc.btwn (fst (List.hd stmts)) (fst (List.hd (List.rev stmts))) + in + let all_comments = List.rev (comments env) in + ( loc, + { + Ast.Program.statements = stmts; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + all_comments; + } + ) + + and directives = + let check env token = + match token with + | T_STRING (loc, _, _, octal) -> + if octal then strict_error_at env (loc, Parse_error.StrictOctalLiteral) + | _ -> failwith ("Nooo: " ^ token_to_string token ^ "\n") + in + let rec statement_list env term_fn item_fn (string_tokens, stmts) = + match Peek.token env with + | T_EOF -> (env, string_tokens, stmts) + | t when term_fn t -> (env, string_tokens, stmts) + | T_STRING _ as string_token -> + let possible_directive = item_fn env in + let stmts = possible_directive :: stmts in + (match possible_directive with + | (_, Ast.Statement.Expression { Ast.Statement.Expression.directive = Some raw; _ }) -> + (* 14.1.1 says that it has to be "use strict" without any + escapes, so "use\x20strict" is disallowed. *) + let strict = in_strict_mode env || raw = "use strict" in + let string_tokens = string_token :: string_tokens in + statement_list (env |> with_strict strict) term_fn item_fn (string_tokens, stmts) + | _ -> (env, string_tokens, stmts)) + | _ -> (env, string_tokens, stmts) + in + fun env term_fn item_fn -> + let env = with_allow_directive true env in + let (env, string_tokens, stmts) = statement_list env term_fn item_fn ([], []) in + let env = with_allow_directive false env in + List.iter (check env) (List.rev string_tokens); + (env, stmts) + + (* 15.2 *) + and module_item env = + let decorators = Object.decorator_list env in + match Peek.token env with + | T_EXPORT -> Statement.export_declaration ~decorators env + | T_IMPORT -> + error_on_decorators env decorators; + let statement = + match Peek.ith_token ~i:1 env with + | T_LPAREN (* import(...) *) + | T_PERIOD (* import.meta *) -> + Statement.expression env + | _ -> Statement.import_declaration env + in + statement + | T_DECLARE when Peek.ith_token ~i:1 env = T_EXPORT -> + error_on_decorators env decorators; + Statement.declare_export_declaration env + | _ -> statement_list_item env ~decorators + + and module_body_with_directives env term_fn = + let (env, directives) = directives env term_fn module_item in + let stmts = module_body ~term_fn env in + (* Prepend the directives *) + List.fold_left (fun acc stmt -> stmt :: acc) stmts directives + + and module_body = + let rec module_item_list env term_fn acc = + match Peek.token env with + | T_EOF -> List.rev acc + | t when term_fn t -> List.rev acc + | _ -> module_item_list env term_fn (module_item env :: acc) + in + (fun ~term_fn env -> module_item_list env term_fn []) + + and statement_list_with_directives ~term_fn env = + let (env, directives) = directives env term_fn statement_list_item in + let stmts = statement_list ~term_fn env in + (* Prepend the directives *) + let stmts = List.fold_left (fun acc stmt -> stmt :: acc) stmts directives in + (stmts, in_strict_mode env) + + and statement_list = + let rec statements env term_fn acc = + match Peek.token env with + | T_EOF -> List.rev acc + | t when term_fn t -> List.rev acc + | _ -> statements env term_fn (statement_list_item env :: acc) + in + (fun ~term_fn env -> statements env term_fn []) + + and statement_list_item ?(decorators = []) env = + if not (Peek.is_class env) then error_on_decorators env decorators; + let open Statement in + match Peek.token env with + (* Remember kids, these look like statements but they're not + * statements... (see section 13) *) + | T_LET -> let_ env + | T_CONST -> const env + | _ when Peek.is_function env -> Declaration._function env + | _ when Peek.is_class env -> class_declaration env decorators + | T_INTERFACE -> interface env + | T_DECLARE -> declare env + | T_TYPE -> type_alias env + | T_OPAQUE -> opaque_type env + | T_ENUM when (parse_options env).enums -> Declaration.enum_declaration env + | _ -> statement env + + and statement env = + let open Statement in + match Peek.token env with + | T_EOF -> + error_unexpected ~expected:"the start of a statement" env; + (Peek.loc env, Ast.Statement.Empty { Ast.Statement.Empty.comments = None }) + | T_SEMICOLON -> empty env + | T_LCURLY -> block env + | T_VAR -> var env + | T_BREAK -> break env + | T_CONTINUE -> continue env + | T_DEBUGGER -> debugger env + | T_DO -> do_while env + | T_FOR -> for_ env + | T_IF -> if_ env + | T_RETURN -> return env + | T_SWITCH -> switch env + | T_THROW -> throw env + | T_TRY -> try_ env + | T_WHILE -> while_ env + | T_WITH -> with_ env + (* If we see an else then it's definitely an error, but we can probably + * assume that this is a malformed if statement that is missing the if *) + | T_ELSE -> if_ env + (* There are a bunch of tokens that aren't the start of any valid + * statement. We list them here in order to skip over them, rather than + * getting stuck *) + | T_COLON + | T_RPAREN + | T_RCURLY + | T_RBRACKET + | T_COMMA + | T_PERIOD + | T_PLING_PERIOD + | T_ARROW + | T_IN + | T_INSTANCEOF + | T_CATCH + | T_FINALLY + | T_CASE + | T_DEFAULT + | T_EXTENDS + | T_STATIC + | T_EXPORT + (* TODO *) + | T_ELLIPSIS -> + error_unexpected ~expected:"the start of a statement" env; + Eat.token env; + statement env + (* The rest of these patterns handle ExpressionStatement and its negative + lookaheads, which prevent ambiguities. + See https://tc39.github.io/ecma262/#sec-expression-statement *) + | _ when Peek.is_function env -> + let func = Declaration._function env in + function_as_statement_error_at env (fst func); + func + | T_LET when Peek.ith_token ~i:1 env = T_LBRACKET -> + (* `let [foo]` is ambiguous: either a let binding pattern, or a + member expression, so it is banned. *) + let loc = Loc.btwn (Peek.loc env) (Peek.ith_loc ~i:1 env) in + error_at env (loc, Parse_error.AmbiguousLetBracket); + Statement.expression env + (* recover as a member expression *) + | _ when Peek.is_identifier env -> maybe_labeled env + | _ when Peek.is_class env -> + error_unexpected env; + Eat.token env; + Statement.expression env + | _ -> Statement.expression env + + and expression env = + let start_loc = Peek.loc env in + let expr = Expression.assignment env in + match Peek.token env with + | T_COMMA -> Expression.sequence env ~start_loc [expr] + | _ -> expr + + and expression_or_pattern env = + let start_loc = Peek.loc env in + let expr_or_pattern = Expression.assignment_cover env in + match Peek.token env with + | T_COMMA -> + let expr = Pattern_cover.as_expression env expr_or_pattern in + let seq = Expression.sequence env ~start_loc [expr] in + Cover_expr seq + | _ -> expr_or_pattern + + and conditional = Expression.conditional + + and assignment = Expression.assignment + + and left_hand_side = Expression.left_hand_side + + and object_initializer = Object._initializer + + and object_key = Object.key + + and class_declaration = Object.class_declaration + + and class_expression = Object.class_expression + + and is_assignable_lhs = Expression.is_assignable_lhs + + and number = Expression.number + + and identifier_with_type = + let with_loc_helper no_optional restricted_error env = + let name = identifier ~restricted_error env in + let optional = (not no_optional) && Peek.token env = T_PLING in + if optional then ( + if not (should_parse_types env) then error env Parse_error.UnexpectedTypeAnnotation; + Expect.token env T_PLING + ); + let annot = Type.annotation_opt env in + Ast.Pattern.Identifier.{ name; optional; annot } + in + fun env ?(no_optional = false) restricted_error -> + with_loc (with_loc_helper no_optional restricted_error) env + + and block_body env = + let start_loc = Peek.loc env in + let leading = Peek.comments env in + Expect.token env T_LCURLY; + let term_fn t = t = T_RCURLY in + let body = statement_list ~term_fn env in + let end_loc = Peek.loc env in + let internal = + if body = [] then + Peek.comments env + else + [] + in + Expect.token env T_RCURLY; + let trailing = Eat.trailing_comments env in + ( Loc.btwn start_loc end_loc, + { + Ast.Statement.Block.body; + comments = Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal (); + } + ) + + and function_block_body ~expression env = + let start_loc = Peek.loc env in + let leading = Peek.comments env in + Expect.token env T_LCURLY; + let term_fn t = t = T_RCURLY in + let (body, strict) = statement_list_with_directives ~term_fn env in + let end_loc = Peek.loc env in + let internal = + if body = [] then + Peek.comments env + else + [] + in + Expect.token env T_RCURLY; + let trailing = + match (expression, Peek.token env) with + | (true, _) + | (_, (T_RCURLY | T_EOF)) -> + Eat.trailing_comments env + | _ when Peek.is_line_terminator env -> Eat.comments_until_next_line env + | _ -> [] + in + ( Loc.btwn start_loc end_loc, + { + Ast.Statement.Block.body; + comments = Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal (); + }, + strict + ) + + and jsx_element_or_fragment = JSX.element_or_fragment + + and pattern = Pattern.pattern + + and pattern_from_expr = Pattern.from_expr +end + +(*****************************************************************************) +(* Entry points *) +(*****************************************************************************) +let do_parse env parser fail = + let ast = parser env in + let error_list = filter_duplicate_errors (errors env) in + match error_list with + | e :: es when fail -> raise (Parse_error.Error (e, es)) + | _ -> (ast, error_list) + +(* Makes the input parser expect EOF at the end. Use this to error on trailing + * junk when parsing non-Program nodes. *) +let with_eof parser env = + let ast = parser env in + Expect.token env T_EOF; + ast + +let parse_statement env fail = do_parse env (with_eof Parse.statement_list_item) fail + +let parse_expression env fail = do_parse env (with_eof Parse.expression) fail + +let parse_program fail ?(token_sink = None) ?(parse_options = None) filename content = + let env = init_env ~token_sink ~parse_options filename content in + do_parse env Parse.program fail + +let program ?(fail = true) ?(token_sink = None) ?(parse_options = None) content = + parse_program fail ~token_sink ~parse_options None content + +let program_file ?(fail = true) ?(token_sink = None) ?(parse_options = None) content filename = + parse_program fail ~token_sink ~parse_options filename content + +let package_json_file = + let parser env = + let (loc, obj, { if_expr; _ }) = Parse.object_initializer env in + List.iter (error_at env) if_expr; + (loc, obj) + in + fun ?(fail = true) ?(token_sink = None) ?(parse_options = None) content filename -> + let env = init_env ~token_sink ~parse_options filename content in + do_parse env parser fail + +(* even if fail=false, still raises an error on a totally invalid token, since + there's no legitimate fallback. *) +let json_file = + let null_fallback _env = + Ast.Expression.Literal { Ast.Literal.value = Ast.Literal.Null; raw = "null"; comments = None } + in + let parser env = + match Peek.token env with + | T_LBRACKET + | T_LCURLY + | T_STRING _ + | T_NUMBER _ + | T_TRUE + | T_FALSE + | T_NULL -> + Parse.expression env + | T_MINUS -> + (match Peek.ith_token ~i:1 env with + | T_NUMBER _ -> Parse.expression env + | _ -> + error_unexpected ~expected:"a number" env; + with_loc null_fallback env) + | _ -> + error_unexpected ~expected:"a valid JSON value" env; + with_loc null_fallback env + in + fun ?(fail = true) ?(token_sink = None) ?(parse_options = None) content filename -> + let env = init_env ~token_sink ~parse_options filename content in + do_parse env parser fail + +let jsx_pragma_expression = + let left_hand_side env = + let ast = Parse.left_hand_side (with_no_new true env) in + Expect.token env T_EOF; + ast + in + fun content filename -> + let env = init_env ~token_sink:None ~parse_options:None filename content in + do_parse env left_hand_side true + +let string_is_valid_identifier_name str = + let lexbuf = Sedlexing.Utf8.from_string str in + Flow_lexer.is_valid_identifier_name lexbuf diff --git a/flow/parser/pattern_cover.ml b/flow/parser/pattern_cover.ml new file mode 100644 index 0000000000..ad7b6f5217 --- /dev/null +++ b/flow/parser/pattern_cover.ml @@ -0,0 +1,55 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open Flow_ast +open Parser_common +open Parser_env + +module type COVER = sig + val as_expression : env -> pattern_cover -> (Loc.t, Loc.t) Expression.t + + val as_pattern : ?err:Parse_error.t -> env -> pattern_cover -> (Loc.t, Loc.t) Pattern.t + + val empty_errors : pattern_errors + + val rev_append_errors : pattern_errors -> pattern_errors -> pattern_errors + + val rev_errors : pattern_errors -> pattern_errors +end + +module Cover (Parse : PARSER) : COVER = struct + let as_expression env = function + | Cover_expr expr -> expr + | Cover_patt (expr, { if_expr; if_patt = _ }) -> + List.iter (error_at env) if_expr; + expr + + let as_pattern ?(err = Parse_error.InvalidLHSInAssignment) env cover = + let expr = + match cover with + | Cover_expr expr -> expr + | Cover_patt (expr, { if_expr = _; if_patt }) -> + List.iter (error_at env) if_patt; + expr + in + if not (Parse.is_assignable_lhs expr) then error_at env (fst expr, err); + + (match expr with + | (loc, Flow_ast.Expression.Identifier (_, { Flow_ast.Identifier.name; comments = _ })) + when is_restricted name -> + strict_error_at env (loc, Parse_error.StrictLHSAssignment) + | _ -> ()); + + Parse.pattern_from_expr env expr + + let empty_errors = { if_patt = []; if_expr = [] } + + let rev_append_errors a b = + { if_patt = List.rev_append a.if_patt b.if_patt; if_expr = List.rev_append a.if_expr b.if_expr } + + let rev_errors a = { if_patt = List.rev a.if_patt; if_expr = List.rev a.if_expr } +end diff --git a/flow/parser/pattern_parser.ml b/flow/parser/pattern_parser.ml new file mode 100644 index 0000000000..74a4abac24 --- /dev/null +++ b/flow/parser/pattern_parser.ml @@ -0,0 +1,397 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +module Ast = Flow_ast +open Token +open Parser_common +open Parser_env +open Flow_ast + +let missing_annot env = Ast.Type.Missing (Peek.loc_skip_lookahead env) + +module Pattern (Parse : Parser_common.PARSER) (Type : Type_parser.TYPE) = struct + (* Reinterpret various expressions as patterns. + * This is not the correct thing to do and is only used for assignment + * expressions. This should be removed and replaced ASAP. + *) + let rec object_from_expr = + let rec properties env acc = + let open Ast.Expression.Object in + function + | [] -> List.rev acc + | Property (loc, prop) :: remaining -> + let acc = + match prop with + | Property.Init { key; value; shorthand } -> + let open Ast.Expression in + let key = + match key with + | Property.Literal lit -> Pattern.Object.Property.Literal lit + | Property.Identifier id -> Pattern.Object.Property.Identifier id + | Property.PrivateName _ -> failwith "Internal Error: Found object private prop" + | Property.Computed key -> Pattern.Object.Property.Computed key + in + let (pattern, default) = + match value with + | (_loc, Assignment { Assignment.operator = None; left; right; comments = _ }) -> + (left, Some right) + | _ -> (from_expr env value, None) + in + Pattern.Object.Property + (loc, { Pattern.Object.Property.key; pattern; default; shorthand }) + :: acc + | Property.Method { key = _; value = (loc, _) } -> + error_at env (loc, Parse_error.MethodInDestructuring); + acc + | Property.Get { key = _; value = (loc, _); comments = _ } + | Property.Set { key = _; value = (loc, _); comments = _ } -> + (* these should never happen *) + error_at env (loc, Parse_error.Unexpected "identifier"); + acc + in + properties env acc remaining + | [SpreadProperty (loc, { SpreadProperty.argument; comments })] -> + let acc = + Pattern.Object.RestElement + (loc, { Pattern.RestElement.argument = from_expr env argument; comments }) + :: acc + in + properties env acc [] + | SpreadProperty (loc, _) :: remaining -> + error_at env (loc, Parse_error.PropertyAfterRestElement); + properties env acc remaining + in + fun env (loc, { Ast.Expression.Object.properties = props; comments }) -> + ( loc, + Pattern.( + Object + { Object.properties = properties env [] props; annot = missing_annot env; comments } + ) + ) + + and array_from_expr = + (* Convert an Expression to a Pattern if it is a valid + DestructuringAssignmentTarget, which must be an Object, Array or + IsValidSimpleAssignmentTarget. + #sec-destructuring-assignment-static-semantics-early-errors *) + let assignment_target env ((loc, _) as expr) = + if Parse.is_assignable_lhs expr then + Some (from_expr env expr) + else ( + error_at env (loc, Parse_error.InvalidLHSInAssignment); + None + ) + in + let rec elements env acc = + let open Ast.Expression in + function + | [] -> List.rev acc + | [Array.Spread (loc, { SpreadElement.argument; comments })] -> + (* AssignmentRestElement is a DestructuringAssignmentTarget, see + #prod-AssignmentRestElement *) + let acc = + match assignment_target env argument with + | Some argument -> + Pattern.Array.RestElement (loc, { Pattern.RestElement.argument; comments }) :: acc + | None -> acc + in + elements env acc [] + | Array.Spread (loc, _) :: remaining -> + error_at env (loc, Parse_error.ElementAfterRestElement); + elements env acc remaining + | Array.Expression (loc, Assignment { Assignment.operator = None; left; right; comments = _ }) + :: remaining -> + (* AssignmentElement is a `DestructuringAssignmentTarget Initializer`, see + #prod-AssignmentElement *) + let acc = + Pattern.Array.Element + (loc, { Pattern.Array.Element.argument = left; default = Some right }) + :: acc + in + elements env acc remaining + | Array.Expression expr :: remaining -> + (* AssignmentElement is a DestructuringAssignmentTarget, see + #prod-AssignmentElement *) + let acc = + match assignment_target env expr with + | Some ((loc, _) as expr) -> + let element = + Pattern.Array.Element (loc, { Pattern.Array.Element.argument = expr; default = None }) + in + element :: acc + | None -> acc + in + elements env acc remaining + | Array.Hole loc :: remaining -> elements env (Pattern.Array.Hole loc :: acc) remaining + in + fun env (loc, { Ast.Expression.Array.elements = elems; comments }) -> + ( loc, + Pattern.Array + { Pattern.Array.elements = elements env [] elems; annot = missing_annot env; comments } + ) + + and from_expr env (loc, expr) = + let open Ast.Expression in + match expr with + | Object obj -> object_from_expr env (loc, obj) + | Array arr -> array_from_expr env (loc, arr) + | Identifier ((id_loc, { Identifier.name = string_val; comments = _ }) as name) -> + (* per #sec-destructuring-assignment-static-semantics-early-errors, + it is a syntax error if IsValidSimpleAssignmentTarget of this + IdentifierReference is false. That happens when `string_val` is + "eval" or "arguments" in strict mode. *) + if in_strict_mode env && is_restricted string_val then + error_at env (id_loc, Parse_error.StrictLHSAssignment) + (* per #prod-IdentifierReference, yield is only a valid + IdentifierReference when [~Yield], and await is only valid + when [~Await]. but per #sec-identifiers-static-semantics-early-errors, + they are already invalid in strict mode, which we should have + already errored about when parsing the expression that we're now + converting into a pattern. *) + else if not (in_strict_mode env) then + if allow_yield env && string_val = "yield" then + error_at env (id_loc, Parse_error.YieldAsIdentifierReference) + else if allow_await env && string_val = "await" then + error_at env (id_loc, Parse_error.AwaitAsIdentifierReference); + ( loc, + Pattern.Identifier { Pattern.Identifier.name; annot = missing_annot env; optional = false } + ) + | expr -> (loc, Pattern.Expression (loc, expr)) + + (* Parse object destructuring pattern *) + let rec object_ restricted_error = + let rest_property env = + let leading = Peek.comments env in + let (loc, argument) = + with_loc + (fun env -> + Expect.token env T_ELLIPSIS; + pattern env restricted_error) + env + in + Pattern.Object.RestElement + ( loc, + { Pattern.RestElement.argument; comments = Flow_ast_utils.mk_comments_opt ~leading () } + ) + in + let property_default env = + match Peek.token env with + | T_ASSIGN -> + Expect.token env T_ASSIGN; + Some (Parse.assignment env) + | _ -> None + in + let rec property env = + if Peek.token env = T_ELLIPSIS then + Some (rest_property env) + else + let start_loc = Peek.loc env in + let raw_key = Parse.object_key env in + match Peek.token env with + | T_COLON -> + Expect.token env T_COLON; + let (loc, (pattern, default)) = + with_loc + ~start_loc + (fun env -> + let pattern = pattern env restricted_error in + let default = property_default env in + (pattern, default)) + env + in + let key = + let open Ast.Expression.Object.Property in + match raw_key with + | (_, Literal lit) -> Pattern.Object.Property.Literal lit + | (_, Identifier id) -> Pattern.Object.Property.Identifier id + | (_, PrivateName _) -> failwith "Internal Error: Found object private prop" + | (_, Computed key) -> Pattern.Object.Property.Computed key + in + Some + Pattern.Object.(Property (loc, Property.{ key; pattern; default; shorthand = false })) + | _ -> + (match raw_key with + | ( _, + Ast.Expression.Object.Property.Identifier + ((id_loc, { Identifier.name = string_val; comments = _ }) as name) + ) -> + (* #sec-identifiers-static-semantics-early-errors *) + if is_reserved string_val && string_val <> "yield" && string_val <> "await" then + (* it is a syntax error if `name` is a reserved word other than await or yield *) + error_at env (id_loc, Parse_error.UnexpectedReserved) + else if is_strict_reserved string_val then + (* it is a syntax error if `name` is a strict reserved word, in strict mode *) + strict_error_at env (id_loc, Parse_error.StrictReservedWord); + let (loc, (pattern, default)) = + with_loc + ~start_loc + (fun env -> + let pattern = + ( id_loc, + Pattern.Identifier + { Pattern.Identifier.name; annot = missing_annot env; optional = false } + ) + in + let default = property_default env in + (pattern, default)) + env + in + Some + Pattern.Object.( + Property + ( loc, + { Property.key = Property.Identifier name; pattern; default; shorthand = true } + ) + ) + | _ -> + error_unexpected ~expected:"an identifier" env; + + (* invalid shorthand destructuring *) + None) + (* seen_rest is true when we've seen a rest element. rest_trailing_comma is the location of + * the rest element's trailing command + * Trailing comma: `let { ...rest, } = obj` + * Still invalid, but not a trailing comma: `let { ...rest, x } = obj` *) + and properties env ~seen_rest ~rest_trailing_comma acc = + match Peek.token env with + | T_EOF + | T_RCURLY -> + begin + match rest_trailing_comma with + | Some loc -> error_at env (loc, Parse_error.TrailingCommaAfterRestElement) + | None -> () + end; + List.rev acc + | _ -> + (match property env with + | Some ((Pattern.Object.Property (loc, _) | Pattern.Object.RestElement (loc, _)) as prop) -> + let rest_trailing_comma = + if seen_rest then ( + error_at env (loc, Parse_error.PropertyAfterRestElement); + None + ) else + rest_trailing_comma + in + let (seen_rest, rest_trailing_comma) = + match prop with + | Pattern.Object.RestElement _ -> + ( true, + if Peek.token env = T_COMMA then + Some (Peek.loc env) + else + None + ) + | _ -> (seen_rest, rest_trailing_comma) + in + if Peek.token env <> T_RCURLY then Expect.token env T_COMMA; + properties env ~seen_rest ~rest_trailing_comma (prop :: acc) + | None -> properties env ~seen_rest ~rest_trailing_comma acc) + in + with_loc (fun env -> + let leading = Peek.comments env in + Expect.token env T_LCURLY; + let properties = properties env ~seen_rest:false ~rest_trailing_comma:None [] in + let internal = Peek.comments env in + Expect.token env T_RCURLY; + let trailing = Eat.trailing_comments env in + let annot = + if Peek.token env = T_COLON then + Ast.Type.Available (Type.annotation env) + else + missing_annot env + in + Pattern.Object + { + Pattern.Object.properties; + annot; + comments = Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal (); + } + ) + + (* Parse array destructuring pattern *) + and array_ restricted_error = + let rec elements env acc = + match Peek.token env with + | T_EOF + | T_RBRACKET -> + List.rev acc + | T_COMMA -> + let loc = Peek.loc env in + Expect.token env T_COMMA; + elements env (Pattern.Array.Hole loc :: acc) + | T_ELLIPSIS -> + let leading = Peek.comments env in + let (loc, argument) = + with_loc + (fun env -> + Expect.token env T_ELLIPSIS; + pattern env restricted_error) + env + in + let element = + Pattern.Array.RestElement + ( loc, + { + Pattern.RestElement.argument; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + in + (* rest elements are always last, the closing ] should be next. but if not, + error and keep going so we recover gracefully by parsing the rest of the + elements. *) + if Peek.token env <> T_RBRACKET then ( + error_at env (loc, Parse_error.ElementAfterRestElement); + if Peek.token env = T_COMMA then Eat.token env + ); + elements env (element :: acc) + | _ -> + let (loc, (pattern, default)) = + with_loc + (fun env -> + let pattern = pattern env restricted_error in + let default = + match Peek.token env with + | T_ASSIGN -> + Expect.token env T_ASSIGN; + Some (Parse.assignment env) + | _ -> None + in + (pattern, default)) + env + in + let element = Pattern.Array.(Element (loc, { Element.argument = pattern; default })) in + if Peek.token env <> T_RBRACKET then Expect.token env T_COMMA; + elements env (element :: acc) + in + with_loc (fun env -> + let leading = Peek.comments env in + Expect.token env T_LBRACKET; + let elements = elements env [] in + let internal = Peek.comments env in + Expect.token env T_RBRACKET; + let annot = + if Peek.token env = T_COLON then + Ast.Type.Available (Type.annotation env) + else + missing_annot env + in + let trailing = Eat.trailing_comments env in + let comments = + Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal () + in + Pattern.Array { Pattern.Array.elements; annot; comments } + ) + + and pattern env restricted_error = + match Peek.token env with + | T_LCURLY -> object_ restricted_error env + | T_LBRACKET -> array_ restricted_error env + | _ -> + let (loc, id) = Parse.identifier_with_type env restricted_error in + (loc, Pattern.Identifier id) +end diff --git a/flow/parser/statement_parser.ml b/flow/parser/statement_parser.ml new file mode 100644 index 0000000000..0e1be739b6 --- /dev/null +++ b/flow/parser/statement_parser.ml @@ -0,0 +1,2193 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +module Ast = Flow_ast +open Token +open Parser_env +open Flow_ast +module SSet = Flow_set.Make (String) +open Parser_common +open Comment_attachment + +module type STATEMENT = sig + val for_ : env -> (Loc.t, Loc.t) Statement.t + + val if_ : env -> (Loc.t, Loc.t) Statement.t + + val let_ : env -> (Loc.t, Loc.t) Statement.t + + val try_ : env -> (Loc.t, Loc.t) Statement.t + + val while_ : env -> (Loc.t, Loc.t) Statement.t + + val with_ : env -> (Loc.t, Loc.t) Statement.t + + val block : env -> (Loc.t, Loc.t) Statement.t + + val break : env -> (Loc.t, Loc.t) Statement.t + + val continue : env -> (Loc.t, Loc.t) Statement.t + + val debugger : env -> (Loc.t, Loc.t) Statement.t + + val declare : ?in_module:bool -> env -> (Loc.t, Loc.t) Statement.t + + val declare_export_declaration : ?allow_export_type:bool -> env -> (Loc.t, Loc.t) Statement.t + + val declare_opaque_type : env -> (Loc.t, Loc.t) Statement.t + + val do_while : env -> (Loc.t, Loc.t) Statement.t + + val empty : env -> (Loc.t, Loc.t) Statement.t + + val export_declaration : + decorators:(Loc.t, Loc.t) Class.Decorator.t list -> env -> (Loc.t, Loc.t) Statement.t + + val expression : env -> (Loc.t, Loc.t) Statement.t + + val import_declaration : env -> (Loc.t, Loc.t) Statement.t + + val interface : env -> (Loc.t, Loc.t) Statement.t + + val maybe_labeled : env -> (Loc.t, Loc.t) Statement.t + + val opaque_type : env -> (Loc.t, Loc.t) Statement.t + + val return : env -> (Loc.t, Loc.t) Statement.t + + val switch : env -> (Loc.t, Loc.t) Statement.t + + val throw : env -> (Loc.t, Loc.t) Statement.t + + val type_alias : env -> (Loc.t, Loc.t) Statement.t + + val var : env -> (Loc.t, Loc.t) Statement.t + + val const : env -> (Loc.t, Loc.t) Statement.t +end + +module Statement + (Parse : PARSER) + (Type : Type_parser.TYPE) + (Declaration : Declaration_parser.DECLARATION) + (Object : Object_parser.OBJECT) + (Pattern_cover : Pattern_cover.COVER) : STATEMENT = struct + type for_lhs = + | For_expression of pattern_cover + | For_declaration of (Loc.t * (Loc.t, Loc.t) Ast.Statement.VariableDeclaration.t) + + type semicolon_type = + | Explicit of Loc.t Comment.t list + | Implicit of Comment_attachment.trailing_and_remover_result + + (* FunctionDeclaration is not a valid Statement, but Annex B sometimes allows it. + However, AsyncFunctionDeclaration and GeneratorFunctionDeclaration are never + allowed as statements. We still parse them as statements (and raise an error) to + recover gracefully. *) + let function_as_statement env = + let func = Declaration._function env in + ( if in_strict_mode env then + function_as_statement_error_at env (fst func) + else + let open Ast.Statement in + match func with + | (loc, FunctionDeclaration { Ast.Function.async = true; _ }) -> + error_at env (loc, Parse_error.AsyncFunctionAsStatement) + | (loc, FunctionDeclaration { Ast.Function.generator = true; _ }) -> + error_at env (loc, Parse_error.GeneratorFunctionAsStatement) + | _ -> () + ); + func + + (* https://tc39.es/ecma262/#sec-exports-static-semantics-early-errors *) + let assert_identifier_name_is_identifier + ?restricted_error env (loc, { Ast.Identifier.name; comments = _ }) = + match name with + | "let" -> + (* "let" is disallowed as an identifier in a few situations. 11.6.2.1 + lists them out. It is always disallowed in strict mode *) + if in_strict_mode env then + strict_error_at env (loc, Parse_error.StrictReservedWord) + else if no_let env then + error_at env (loc, Parse_error.Unexpected (Token.quote_token_value name)) + | "await" -> + (* `allow_await` means that `await` is allowed to be a keyword, + which makes it illegal to use as an identifier. + https://tc39.github.io/ecma262/#sec-identifiers-static-semantics-early-errors *) + if allow_await env then error_at env (loc, Parse_error.UnexpectedReserved) + | "yield" -> + (* `allow_yield` means that `yield` is allowed to be a keyword, + which makes it illegal to use as an identifier. + https://tc39.github.io/ecma262/#sec-identifiers-static-semantics-early-errors *) + if allow_yield env then + error_at env (loc, Parse_error.UnexpectedReserved) + else + strict_error_at env (loc, Parse_error.StrictReservedWord) + | _ when is_strict_reserved name -> strict_error_at env (loc, Parse_error.StrictReservedWord) + | _ when is_reserved name -> + error_at env (loc, Parse_error.Unexpected (Token.quote_token_value name)) + | _ -> + begin + match restricted_error with + | Some err when is_restricted name -> strict_error_at env (loc, err) + | _ -> () + end + + let string_literal env (loc, value, raw, octal) = + if octal then strict_error env Parse_error.StrictOctalLiteral; + let leading = Peek.comments env in + Expect.token env (T_STRING (loc, value, raw, octal)); + let trailing = Eat.trailing_comments env in + ( loc, + { StringLiteral.value; raw; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + + (* Semicolon insertion is handled here :(. There seem to be 2 cases where + * semicolons are inserted. First, if we reach the EOF. Second, if the next + * token is } or is separated by a LineTerminator. + *) + let semicolon ?(expected = "the token `;`") ?(required = true) env = + match Peek.token env with + | T_EOF + | T_RCURLY -> + Implicit { trailing = Eat.trailing_comments env; remove_trailing = (fun x _ -> x) } + | T_SEMICOLON -> + Eat.token env; + (match Peek.token env with + | T_EOF + | T_RCURLY -> + Explicit (Eat.trailing_comments env) + | _ when Peek.is_line_terminator env -> Explicit (Eat.comments_until_next_line env) + | _ -> Explicit []) + | _ when Peek.is_line_terminator env -> + Implicit (Comment_attachment.trailing_and_remover_after_last_line env) + | _ -> + if required then error_unexpected ~expected env; + Explicit [] + + (* Consumes and returns the trailing comments after the end of a statement. Also returns + a remover that can remove all comments that are not trailing the previous token. + + If a statement is the end of a block or file, all comments are trailing. + Otherwise, if a statement is followed by a new line, only comments on the current + line are trailing. If a statement is not followed by a new line, it does not have + trailing comments as they are instead leading comments for the next statement. *) + let statement_end_trailing_comments env = + match Peek.token env with + | T_EOF + | T_RCURLY -> + { trailing = Eat.trailing_comments env; remove_trailing = (fun x _ -> x) } + | _ when Peek.is_line_terminator env -> + Comment_attachment.trailing_and_remover_after_last_line env + | _ -> Comment_attachment.trailing_and_remover_after_last_loc env + + let variable_declaration_end ~kind env declarations = + match semicolon env with + | Explicit comments -> (comments, declarations) + | Implicit { remove_trailing; _ } -> + (* Remove trailing comments from the last declarator *) + let declarations = + match List.rev declarations with + | [] -> [] + | decl :: decls -> + let decl' = + remove_trailing decl (fun remover decl -> remover#variable_declarator ~kind decl) + in + List.rev (decl' :: decls) + in + ([], declarations) + + let rec empty env = + let loc = Peek.loc env in + let leading = Peek.comments env in + Expect.token env T_SEMICOLON; + let { trailing; _ } = statement_end_trailing_comments env in + ( loc, + Statement.Empty + { Statement.Empty.comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + + and break env = + let leading = Peek.comments env in + let (loc, (label, trailing)) = + with_loc + (fun env -> + Expect.token env T_BREAK; + let label = + if Peek.token env = T_SEMICOLON || Peek.is_implicit_semicolon env then + None + else + let ((_, { Identifier.name; comments = _ }) as label) = Parse.identifier env in + if not (SSet.mem name (labels env)) then error env (Parse_error.UnknownLabel name); + Some label + in + let (trailing, label) = + match (semicolon env, label) with + | (Explicit trailing, _) + | (Implicit { trailing; _ }, None) -> + (trailing, label) + | (Implicit { remove_trailing; _ }, Some label) -> + ([], Some (remove_trailing label (fun remover label -> remover#identifier label))) + in + (label, trailing)) + env + in + if label = None && not (in_loop env || in_switch env) then + error_at env (loc, Parse_error.IllegalBreak); + let comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () in + (loc, Statement.Break { Statement.Break.label; comments }) + + and continue env = + let leading = Peek.comments env in + let (loc, (label, trailing)) = + with_loc + (fun env -> + Expect.token env T_CONTINUE; + let label = + if Peek.token env = T_SEMICOLON || Peek.is_implicit_semicolon env then + None + else + let ((_, { Identifier.name; comments = _ }) as label) = Parse.identifier env in + if not (SSet.mem name (labels env)) then error env (Parse_error.UnknownLabel name); + Some label + in + let (trailing, label) = + match (semicolon env, label) with + | (Explicit trailing, _) + | (Implicit { trailing; _ }, None) -> + (trailing, label) + | (Implicit { remove_trailing; _ }, Some label) -> + ([], Some (remove_trailing label (fun remover label -> remover#identifier label))) + in + (label, trailing)) + env + in + if not (in_loop env) then error_at env (loc, Parse_error.IllegalContinue); + ( loc, + Statement.Continue + { + Statement.Continue.label; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + + and debugger = + with_loc (fun env -> + let leading = Peek.comments env in + Expect.token env T_DEBUGGER; + let pre_semicolon_trailing = + if Peek.token env = T_SEMICOLON then + Eat.trailing_comments env + else + [] + in + let trailing = + match semicolon env with + | Explicit trailing + | Implicit { trailing; _ } -> + pre_semicolon_trailing @ trailing + in + Statement.Debugger + { Statement.Debugger.comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + + and do_while = + with_loc (fun env -> + let leading = Peek.comments env in + Expect.token env T_DO; + let body = Parse.statement (env |> with_in_loop true) in + (* Annex B allows labelled FunctionDeclarations (see + sec-labelled-function-declarations), but not in IterationStatement + (see sec-semantics-static-semantics-early-errors). *) + if (not (in_strict_mode env)) && is_labelled_function body then + function_as_statement_error_at env (fst body); + let pre_keyword_trailing = Eat.trailing_comments env in + Expect.token env T_WHILE; + let pre_cond_trailing = Eat.trailing_comments env in + Expect.token env T_LPAREN; + let test = Parse.expression env in + Expect.token env T_RPAREN; + let past_cond_trailing = + if Peek.token env = T_SEMICOLON then + Eat.trailing_comments env + else + [] + in + (* The rules of automatic semicolon insertion in ES5 don't mention this, + * but the semicolon after a do-while loop is optional. This is properly + * specified in ES6 *) + let past_cond_trailing = + match semicolon ~required:false env with + | Explicit trailing -> past_cond_trailing @ trailing + | Implicit { trailing; _ } -> trailing + in + let trailing = pre_keyword_trailing @ pre_cond_trailing @ past_cond_trailing in + Statement.DoWhile + { + Statement.DoWhile.body; + test; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + + and for_ = + let assert_can_be_forin_or_forof env err = function + | (loc, { Statement.VariableDeclaration.declarations; _ }) -> + (* Only a single declarator is allowed, without an init. So + * something like + * + * for (var x in y) {} + * + * is allowed, but we disallow + * + * for (var x, y in z) {} + * for (var x = 42 in y) {} + *) + (match declarations with + | [(_, { Statement.VariableDeclaration.Declarator.init = None; _ })] -> () + | _ -> error_at env (loc, err)) + in + (* Annex B allows labelled FunctionDeclarations (see + sec-labelled-function-declarations), but not in IterationStatement + (see sec-semantics-static-semantics-early-errors). *) + let assert_not_labelled_function env body = + if (not (in_strict_mode env)) && is_labelled_function body then + function_as_statement_error_at env (fst body) + else + () + in + with_loc (fun env -> + let leading = Peek.comments env in + Expect.token env T_FOR; + let async = allow_await env && Eat.maybe env T_AWAIT in + let leading = leading @ Peek.comments env in + Expect.token env T_LPAREN; + let comments = Flow_ast_utils.mk_comments_opt ~leading () in + let (init, errs) = + let env = env |> with_no_in true in + match Peek.token env with + | T_SEMICOLON -> (None, []) + | T_LET -> + let (loc, (declarations, leading, errs)) = with_loc Declaration.let_ env in + ( Some + (For_declaration + ( loc, + { + Statement.VariableDeclaration.kind = Statement.VariableDeclaration.Let; + declarations; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + ), + errs + ) + | T_CONST -> + let (loc, (declarations, leading, errs)) = with_loc Declaration.const env in + ( Some + (For_declaration + ( loc, + { + Statement.VariableDeclaration.kind = Statement.VariableDeclaration.Const; + declarations; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + ), + errs + ) + | T_VAR -> + let (loc, (declarations, leading, errs)) = with_loc Declaration.var env in + ( Some + (For_declaration + ( loc, + { + Statement.VariableDeclaration.kind = Statement.VariableDeclaration.Var; + declarations; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + ), + errs + ) + | _ -> + let expr = Parse.expression_or_pattern (env |> with_no_let true) in + (Some (For_expression expr), []) + in + match Peek.token env with + (* If `async` is true, this must be a for-await-of loop. *) + | t when t = T_OF || async -> + let left = + let open Statement in + match init with + | Some (For_declaration decl) -> + assert_can_be_forin_or_forof env Parse_error.InvalidLHSInForOf decl; + ForOf.LeftDeclaration decl + | Some (For_expression expr) -> + (* #sec-for-in-and-for-of-statements-static-semantics-early-errors *) + let patt = Pattern_cover.as_pattern ~err:Parse_error.InvalidLHSInForOf env expr in + ForOf.LeftPattern patt + | None -> assert false + in + (* This is a for of loop *) + Expect.token env T_OF; + let right = Parse.assignment env in + Expect.token env T_RPAREN; + let body = Parse.statement (env |> with_in_loop true) in + assert_not_labelled_function env body; + Statement.ForOf { Statement.ForOf.left; right; body; await = async; comments } + | T_IN -> + let left = + match init with + | Some (For_declaration decl) -> + assert_can_be_forin_or_forof env Parse_error.InvalidLHSInForIn decl; + Statement.ForIn.LeftDeclaration decl + | Some (For_expression expr) -> + (* #sec-for-in-and-for-of-statements-static-semantics-early-errors *) + let patt = Pattern_cover.as_pattern ~err:Parse_error.InvalidLHSInForIn env expr in + Statement.ForIn.LeftPattern patt + | None -> assert false + in + (* This is a for in loop *) + Expect.token env T_IN; + let right = Parse.expression env in + Expect.token env T_RPAREN; + let body = Parse.statement (env |> with_in_loop true) in + assert_not_labelled_function env body; + Statement.ForIn { Statement.ForIn.left; right; body; each = false; comments } + | _ -> + (* This is a for loop *) + errs |> List.iter (error_at env); + Expect.token env T_SEMICOLON; + let init = + match init with + | Some (For_declaration decl) -> Some (Statement.For.InitDeclaration decl) + | Some (For_expression expr) -> + Some (Statement.For.InitExpression (Pattern_cover.as_expression env expr)) + | None -> None + in + let test = + match Peek.token env with + | T_SEMICOLON -> None + | _ -> Some (Parse.expression env) + in + Expect.token env T_SEMICOLON; + let update = + match Peek.token env with + | T_RPAREN -> None + | _ -> Some (Parse.expression env) + in + Expect.token env T_RPAREN; + let body = Parse.statement (env |> with_in_loop true) in + assert_not_labelled_function env body; + Statement.For { Statement.For.init; test; update; body; comments } + ) + + and if_ = + (* + * Either the consequent or alternate of an if statement + *) + let if_branch env = + (* Normally this would just be a Statement, but Annex B allows + FunctionDeclarations in non-strict mode. See + sec-functiondeclarations-in-ifstatement-statement-clauses *) + let stmt = + if Peek.is_function env then + function_as_statement env + else + Parse.statement env + in + (* Annex B allows labelled FunctionDeclarations in non-strict mode + (see sec-labelled-function-declarations), but not in IfStatement + (see sec-if-statement-static-semantics-early-errors). *) + if (not (in_strict_mode env)) && is_labelled_function stmt then + function_as_statement_error_at env (fst stmt); + + stmt + in + let alternate env = + let leading = Peek.comments env in + Expect.token env T_ELSE; + let body = if_branch env in + { Statement.If.Alternate.body; comments = Flow_ast_utils.mk_comments_opt ~leading () } + in + with_loc (fun env -> + let pre_if_leading = Peek.comments env in + Expect.token env T_IF; + let pre_cond_leading = Peek.comments env in + let leading = pre_if_leading @ pre_cond_leading in + Expect.token env T_LPAREN; + let test = Parse.expression env in + Expect.token env T_RPAREN; + let consequent = if_branch env in + let alternate = + if Peek.token env = T_ELSE then + Some (with_loc alternate env) + else + None + in + Statement.If + { + Statement.If.test; + consequent; + alternate; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + + and return = + with_loc (fun env -> + if not (in_function env) then error env Parse_error.IllegalReturn; + let leading = Peek.comments env in + Expect.token env T_RETURN; + let trailing = + if Peek.token env = T_SEMICOLON then + Eat.trailing_comments env + else + [] + in + let argument = + if Peek.token env = T_SEMICOLON || Peek.is_implicit_semicolon env then + None + else + Some (Parse.expression env) + in + let (trailing, argument) = + match (semicolon env, argument) with + | (Explicit comments, _) + | (Implicit { trailing = comments; _ }, None) -> + (trailing @ comments, argument) + | (Implicit { remove_trailing; _ }, Some arg) -> + (trailing, Some (remove_trailing arg (fun remover arg -> remover#expression arg))) + in + Statement.Return + { + Statement.Return.argument; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + + and switch = + let rec case_list env (seen_default, acc) = + match Peek.token env with + | T_EOF + | T_RCURLY -> + List.rev acc + | _ -> + let start_loc = Peek.loc env in + let leading = Peek.comments env in + let (test, trailing) = + match Peek.token env with + | T_DEFAULT -> + if seen_default then error env Parse_error.MultipleDefaultsInSwitch; + Expect.token env T_DEFAULT; + (None, Eat.trailing_comments env) + | _ -> + Expect.token env T_CASE; + (Some (Parse.expression env), []) + in + let seen_default = seen_default || test = None in + let end_loc = Peek.loc env in + Expect.token env T_COLON; + let { trailing = line_end_trailing; _ } = statement_end_trailing_comments env in + let trailing = trailing @ line_end_trailing in + let term_fn = function + | T_RCURLY + | T_DEFAULT + | T_CASE -> + true + | _ -> false + in + let consequent = Parse.statement_list ~term_fn (env |> with_in_switch true) in + let end_loc = + match List.rev consequent with + | last_stmt :: _ -> fst last_stmt + | _ -> end_loc + in + let acc = + ( Loc.btwn start_loc end_loc, + Statement.Switch.Case. + { test; consequent; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + + ) + :: acc + in + case_list env (seen_default, acc) + in + with_loc (fun env -> + let leading = Peek.comments env in + Expect.token env T_SWITCH; + Expect.token env T_LPAREN; + let discriminant = Parse.expression env in + Expect.token env T_RPAREN; + Expect.token env T_LCURLY; + let cases = case_list env (false, []) in + Expect.token env T_RCURLY; + let { trailing; _ } = statement_end_trailing_comments env in + Statement.Switch + { + Statement.Switch.discriminant; + cases; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + + and throw = + with_loc (fun env -> + let leading = Peek.comments env in + let start_loc = Peek.loc env in + Expect.token env T_THROW; + if Peek.is_line_terminator env then error_at env (start_loc, Parse_error.NewlineAfterThrow); + let argument = Parse.expression env in + let (trailing, argument) = + match semicolon env with + | Explicit trailing -> (trailing, argument) + | Implicit { remove_trailing; _ } -> + ([], remove_trailing argument (fun remover arg -> remover#expression arg)) + in + let open Statement in + Throw { Throw.argument; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + + and try_ = + with_loc (fun env -> + let leading = Peek.comments env in + Expect.token env T_TRY; + let block = + let block = Parse.block_body env in + if Peek.token env = T_CATCH then + block_remove_trailing env block + else + block + in + let handler = + match Peek.token env with + | T_CATCH -> + let catch = + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_CATCH; + let trailing = Eat.trailing_comments env in + let param = + if Peek.token env = T_LPAREN then ( + Expect.token env T_LPAREN; + let p = Some (Parse.pattern env Parse_error.StrictCatchVariable) in + Expect.token env T_RPAREN; + p + ) else + None + in + let body = Parse.block_body env in + (* Fix trailing comment attachment if catch block is end of statement *) + let body = + if Peek.token env <> T_FINALLY then + let { remove_trailing; _ } = statement_end_trailing_comments env in + remove_trailing body (fun remover (loc, body) -> (loc, remover#block loc body)) + else + body + in + { + Ast.Statement.Try.CatchClause.param; + body; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + }) + env + in + Some catch + | _ -> None + in + let finalizer = + match Peek.token env with + | T_FINALLY -> + Expect.token env T_FINALLY; + let (loc, body) = Parse.block_body env in + let { remove_trailing; _ } = statement_end_trailing_comments env in + let body = remove_trailing body (fun remover body -> remover#block loc body) in + Some (loc, body) + | _ -> None + in + (* No catch or finally? That's an error! *) + if handler = None && finalizer = None then + error_at env (fst block, Parse_error.NoCatchOrFinally); + + Statement.Try + { + Statement.Try.block; + handler; + finalizer; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + + and var = + with_loc (fun env -> + let kind = Statement.VariableDeclaration.Var in + let (declarations, leading, errs) = Declaration.var env in + let (trailing, declarations) = variable_declaration_end ~kind env declarations in + errs |> List.iter (error_at env); + Statement.VariableDeclaration + { + Statement.VariableDeclaration.kind; + declarations; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + + and const = + with_loc (fun env -> + let kind = Statement.VariableDeclaration.Const in + let (declarations, leading, errs) = Declaration.const env in + let (trailing, declarations) = variable_declaration_end ~kind env declarations in + errs |> List.iter (error_at env); + Statement.VariableDeclaration + { + Statement.VariableDeclaration.kind; + declarations; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + + and let_ = + with_loc (fun env -> + let kind = Statement.VariableDeclaration.Let in + let (declarations, leading, errs) = Declaration.let_ env in + let (trailing, declarations) = variable_declaration_end ~kind env declarations in + errs |> List.iter (error_at env); + Statement.VariableDeclaration + { + Statement.VariableDeclaration.kind; + declarations; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + + and while_ = + with_loc (fun env -> + let leading = Peek.comments env in + Expect.token env T_WHILE; + let leading = leading @ Peek.comments env in + Expect.token env T_LPAREN; + let test = Parse.expression env in + Expect.token env T_RPAREN; + let body = Parse.statement (env |> with_in_loop true) in + (* Annex B allows labelled FunctionDeclarations in non-strict mode + (see sec-labelled-function-declarations), but not in IterationStatement + (see sec-semantics-static-semantics-early-errors). *) + if (not (in_strict_mode env)) && is_labelled_function body then + function_as_statement_error_at env (fst body); + Statement.While + { Statement.While.test; body; comments = Flow_ast_utils.mk_comments_opt ~leading () } + ) + + and with_ env = + let (loc, stmt) = + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_WITH; + let leading = leading @ Peek.comments env in + Expect.token env T_LPAREN; + let _object = Parse.expression env in + Expect.token env T_RPAREN; + let body = Parse.statement env in + (* Annex B allows labelled FunctionDeclarations in non-strict mode + (see sec-labelled-function-declarations), but not in WithStatement + (see sec-with-statement-static-semantics-early-errors). *) + if (not (in_strict_mode env)) && is_labelled_function body then + function_as_statement_error_at env (fst body); + Statement.With + { Statement.With._object; body; comments = Flow_ast_utils.mk_comments_opt ~leading () }) + env + in + strict_error_at env (loc, Parse_error.StrictModeWith); + (loc, stmt) + + and block env = + let (loc, block) = Parse.block_body env in + let { remove_trailing; _ } = statement_end_trailing_comments env in + let block = remove_trailing block (fun remover block -> remover#block loc block) in + (loc, Statement.Block block) + + and maybe_labeled = + with_loc (fun env -> + let leading = Peek.comments env in + match (Parse.expression env, Peek.token env) with + | ((loc, Ast.Expression.Identifier label), T_COLON) -> + let (_, { Identifier.name; comments = _ }) = label in + Expect.token env T_COLON; + if SSet.mem name (labels env) then + error_at env (loc, Parse_error.Redeclaration ("Label", name)); + let env = add_label env name in + let body = + (* labelled FunctionDeclarations are allowed in non-strict mode + (see #sec-labelled-function-declarations) *) + if Peek.is_function env then + function_as_statement env + else + Parse.statement env + in + Statement.Labeled + { Statement.Labeled.label; body; comments = Flow_ast_utils.mk_comments_opt ~leading () } + | (expression, _) -> + let (trailing, expression) = + match semicolon ~expected:"the end of an expression statement (`;`)" env with + | Explicit comments -> (comments, expression) + | Implicit { remove_trailing; _ } -> + ([], remove_trailing expression (fun remover expr -> remover#expression expr)) + in + let open Statement in + Expression + { + Expression.expression; + directive = None; + comments = Flow_ast_utils.mk_comments_opt ~trailing (); + } + ) + + and expression = + with_loc (fun env -> + let expression = Parse.expression env in + let (trailing, expression) = + match semicolon ~expected:"the end of an expression statement (`;`)" env with + | Explicit comments -> (comments, expression) + | Implicit { remove_trailing; _ } -> + ([], remove_trailing expression (fun remover expr -> remover#expression expr)) + in + let directive = + if allow_directive env then + match expression with + | (_, Ast.Expression.Literal { Ast.Literal.value = Ast.Literal.String _; raw; _ }) -> + Some (String.sub raw 1 (String.length raw - 2)) + | _ -> None + else + None + in + Statement.Expression + { + Statement.Expression.expression; + directive; + comments = Flow_ast_utils.mk_comments_opt ~trailing (); + } + ) + + and type_alias_helper ~leading env = + if not (should_parse_types env) then error env Parse_error.UnexpectedTypeAlias; + let leading = leading @ Peek.comments env in + Expect.token env T_TYPE; + Eat.push_lex_mode env Lex_mode.TYPE; + let id = + let id = Type.type_identifier env in + if Peek.token env = T_LESS_THAN then + id_remove_trailing env id + else + id + in + let tparams = Type.type_params env in + Expect.token env T_ASSIGN; + let right = Type._type env in + Eat.pop_lex_mode env; + let (trailing, right) = + match semicolon env with + | Explicit comments -> (comments, right) + | Implicit { remove_trailing; _ } -> + ([], remove_trailing right (fun remover right -> remover#type_ right)) + in + Statement.TypeAlias. + { id; tparams; right; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + + + and declare_type_alias env = + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_DECLARE; + let type_alias = type_alias_helper ~leading env in + Statement.DeclareTypeAlias type_alias) + env + + (** Type aliases squeeze into an unambiguous unused portion of the grammar: `type` is not a + reserved word, so `type T` is otherwise two identifiers in a row and that's never valid JS. + However, if there's a line separator between the two, ASI makes it valid JS, so line + separators are disallowed. *) + and type_alias env = + if Peek.ith_is_identifier ~i:1 env && not (Peek.ith_is_implicit_semicolon ~i:1 env) then + let (loc, type_alias) = with_loc (type_alias_helper ~leading:[]) env in + (loc, Statement.TypeAlias type_alias) + else + Parse.statement env + + and opaque_type_helper ?(declare = false) ~leading env = + if not (should_parse_types env) then error env Parse_error.UnexpectedOpaqueTypeAlias; + let leading_opaque = leading @ Peek.comments env in + Expect.token env T_OPAQUE; + let leading_type = Peek.comments env in + Expect.token env T_TYPE; + let leading = leading_opaque @ leading_type in + Eat.push_lex_mode env Lex_mode.TYPE; + let id = + let id = Type.type_identifier env in + if Peek.token env = T_LESS_THAN then + id_remove_trailing env id + else + id + in + let tparams = Type.type_params env in + let supertype = + match Peek.token env with + | T_COLON -> + Expect.token env T_COLON; + Some (Type._type env) + | _ -> None + in + let impltype = + if declare then + match Peek.token env with + | T_ASSIGN -> + error env Parse_error.DeclareOpaqueTypeInitializer; + Eat.token env; + if Peek.token env = T_SEMICOLON || Peek.is_implicit_semicolon env then + None + else + Some (Type._type env) + | _ -> None + else ( + Expect.token env T_ASSIGN; + Some (Type._type env) + ) + in + Eat.pop_lex_mode env; + let (trailing, id, tparams, supertype, impltype) = + match (semicolon env, tparams, supertype, impltype) with + (* opaque type Foo = Bar; *) + | (Explicit comments, _, _, _) -> (comments, id, tparams, supertype, impltype) + (* opaque type Foo = Bar *) + | (Implicit { remove_trailing; _ }, _, _, Some impl) -> + ( [], + id, + tparams, + supertype, + Some (remove_trailing impl (fun remover impl -> remover#type_ impl)) + ) + (* opaque type Foo: Super *) + | (Implicit { remove_trailing; _ }, _, Some super, None) -> + ( [], + id, + tparams, + Some (remove_trailing super (fun remover super -> remover#type_ super)), + None + ) + (* opaque type Foo *) + | (Implicit { remove_trailing; _ }, Some tparams, None, None) -> + ( [], + id, + Some (remove_trailing tparams (fun remover tparams -> remover#type_params tparams)), + None, + None + ) + (* declare opaque type Foo *) + | (Implicit { remove_trailing; _ }, None, None, None) -> + ([], remove_trailing id (fun remover id -> remover#identifier id), None, None, None) + in + Statement.OpaqueType. + { + id; + tparams; + impltype; + supertype; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + + + and declare_opaque_type env = + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_DECLARE; + let opaque_t = opaque_type_helper ~declare:true ~leading env in + Statement.DeclareOpaqueType opaque_t) + env + + and opaque_type env = + match Peek.ith_token ~i:1 env with + | T_TYPE -> + let (loc, opaque_t) = with_loc (opaque_type_helper ~declare:false ~leading:[]) env in + (loc, Statement.OpaqueType opaque_t) + | _ -> Parse.statement env + + and interface_helper ~leading env = + if not (should_parse_types env) then error env Parse_error.UnexpectedTypeInterface; + let leading = leading @ Peek.comments env in + Expect.token env T_INTERFACE; + let id = + let id = Type.type_identifier env in + if Peek.token env = T_EXTENDS then + id + else + id_remove_trailing env id + in + let tparams = + let tparams = Type.type_params env in + if Peek.token env = T_EXTENDS then + tparams + else + type_params_remove_trailing env tparams + in + let (extends, body) = Type.interface_helper env in + let { remove_trailing; _ } = statement_end_trailing_comments env in + let body = + remove_trailing body (fun remover (loc, body) -> (loc, remover#object_type loc body)) + in + Statement.Interface. + { id; tparams; body; extends; comments = Flow_ast_utils.mk_comments_opt ~leading () } + + + and declare_interface env = + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_DECLARE; + let iface = interface_helper ~leading env in + Statement.DeclareInterface iface) + env + + and interface env = + (* disambiguate between a value named `interface`, like `var interface = 1; interface++`, + and an interface declaration like `interface Foo {}`.` *) + if Peek.ith_is_identifier_name ~i:1 env then + let (loc, iface) = with_loc (interface_helper ~leading:[]) env in + (loc, Statement.InterfaceDeclaration iface) + else + expression env + + and declare_class = + let rec mixins env acc = + let super = Type.generic env in + let acc = super :: acc in + match Peek.token env with + | T_COMMA -> + Expect.token env T_COMMA; + mixins env acc + | _ -> List.rev acc + (* This is identical to `interface`, except that mixins are allowed *) + in + fun ~leading env -> + let env = env |> with_strict true in + let leading = leading @ Peek.comments env in + Expect.token env T_CLASS; + let id = + let id = Parse.identifier env in + match Peek.token env with + | T_LESS_THAN + | T_LCURLY -> + id_remove_trailing env id + | _ -> id + in + let tparams = + let tparams = Type.type_params env in + match Peek.token env with + | T_LCURLY -> type_params_remove_trailing env tparams + | _ -> tparams + in + let extends = + if Eat.maybe env T_EXTENDS then + let extends = Type.generic env in + match Peek.token env with + | T_LCURLY -> Some (generic_type_remove_trailing env extends) + | _ -> Some extends + else + None + in + let mixins = + match Peek.token env with + | T_IDENTIFIER { raw = "mixins"; _ } -> + Eat.token env; + let mixins = mixins env [] in + (match Peek.token env with + | T_LCURLY -> generic_type_list_remove_trailing env mixins + | _ -> mixins) + | _ -> [] + in + let implements = + match Peek.token env with + | T_IMPLEMENTS -> + let implements = Object.class_implements env ~attach_leading:false in + (match Peek.token env with + | T_LCURLY -> Some (class_implements_remove_trailing env implements) + | _ -> Some implements) + | _ -> None + in + let body = Type._object ~is_class:true env in + let { remove_trailing; _ } = statement_end_trailing_comments env in + let body = + remove_trailing body (fun remover (loc, body) -> (loc, remover#object_type loc body)) + in + let comments = Flow_ast_utils.mk_comments_opt ~leading () in + Statement.DeclareClass.{ id; tparams; body; extends; mixins; implements; comments } + + and declare_class_statement env = + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_DECLARE; + let fn = declare_class ~leading env in + Statement.DeclareClass fn) + env + + and declare_function ?(leading = []) env = + let leading = leading @ Peek.comments env in + Expect.token env T_FUNCTION; + let id = id_remove_trailing env (Parse.identifier env) in + let start_sig_loc = Peek.loc env in + let tparams = type_params_remove_trailing env (Type.type_params env) in + let params = Type.function_param_list env in + Expect.token env T_COLON; + let return = + let return = Type._type env in + let has_predicate = + Eat.push_lex_mode env Lex_mode.TYPE; + let type_token = Peek.token env in + Eat.pop_lex_mode env; + type_token = T_CHECKS + in + if has_predicate then + type_remove_trailing env return + else + return + in + let end_loc = fst return in + let loc = Loc.btwn start_sig_loc end_loc in + let annot = (loc, Ast.Type.(Function { Function.params; return; tparams; comments = None })) in + let predicate = Type.predicate_opt env in + let (trailing, annot, predicate) = + match (semicolon env, predicate) with + | (Explicit comments, _) -> (comments, annot, predicate) + | (Implicit { remove_trailing; _ }, None) -> + ([], remove_trailing annot (fun remover annot -> remover#type_ annot), None) + | (Implicit { remove_trailing; _ }, Some pred) -> + ([], annot, Some (remove_trailing pred (fun remover pred -> remover#predicate pred))) + in + let annot = (loc, annot) in + Statement.DeclareFunction. + { id; annot; predicate; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + + + and declare_function_statement env = + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_DECLARE; + begin + match Peek.token env with + | T_ASYNC -> + error env Parse_error.DeclareAsync; + Expect.token env T_ASYNC + | _ -> () + end; + let fn = declare_function ~leading env in + Statement.DeclareFunction fn) + env + + and declare_var env leading = + let leading = leading @ Peek.comments env in + Expect.token env T_VAR; + let name = Parse.identifier ~restricted_error:Parse_error.StrictVarName env in + let annot = Type.annotation env in + let (trailing, name, annot) = + match semicolon env with + (* declare var x; *) + | Explicit trailing -> (trailing, name, annot) + (* declare var x *) + | Implicit { remove_trailing; _ } -> + ([], name, remove_trailing annot (fun remover annot -> remover#type_annotation annot)) + in + Statement.DeclareVariable. + { id = name; annot; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + + + and declare_var_statement env = + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_DECLARE; + let var = declare_var env leading in + Statement.DeclareVariable var) + env + + and declare_module = + let rec module_items env ~module_kind acc = + match Peek.token env with + | T_EOF + | T_RCURLY -> + (module_kind, List.rev acc) + | _ -> + let stmt = declare ~in_module:true env in + (* TODO: This is a semantic analysis and shouldn't be in the parser *) + let module_kind = + let open Statement in + let (loc, stmt) = stmt in + match (module_kind, stmt) with + (* + * The first time we see either a `declare export` or a + * `declare module.exports`, we lock in the kind of the module. + * + * `declare export type` and `declare export interface` are the two + * exceptions to this rule because they are valid in both CommonJS + * and ES modules (and thus do not indicate an intent for either). + *) + | (None, DeclareModuleExports _) -> Some (DeclareModule.CommonJS loc) + | (None, DeclareExportDeclaration { DeclareExportDeclaration.declaration; _ }) -> + (match declaration with + | Some (DeclareExportDeclaration.NamedType _) + | Some (DeclareExportDeclaration.Interface _) -> + module_kind + | _ -> Some (DeclareModule.ES loc)) + (* + * There should never be more than one `declare module.exports` + * statement *) + | (Some (DeclareModule.CommonJS _), DeclareModuleExports _) -> + error env Parse_error.DuplicateDeclareModuleExports; + module_kind + (* + * It's never ok to mix and match `declare export` and + * `declare module.exports` in the same module because it leaves the + * kind of the module (CommonJS vs ES) ambiguous. + * + * The 1 exception to this rule is that `export type/interface` are + * both ok in CommonJS modules. + *) + | (Some (DeclareModule.ES _), DeclareModuleExports _) -> + error env Parse_error.AmbiguousDeclareModuleKind; + module_kind + | ( Some (DeclareModule.CommonJS _), + DeclareExportDeclaration { DeclareExportDeclaration.declaration; _ } + ) -> + (match declaration with + | Some (DeclareExportDeclaration.NamedType _) + | Some (DeclareExportDeclaration.Interface _) -> + () + | _ -> error env Parse_error.AmbiguousDeclareModuleKind); + module_kind + | _ -> module_kind + in + module_items env ~module_kind (stmt :: acc) + in + let declare_module_ env start_loc leading = + let id = + match Peek.token env with + | T_STRING str -> + Statement.DeclareModule.Literal + (string_literal_remove_trailing env (string_literal env str)) + | _ -> Statement.DeclareModule.Identifier (id_remove_trailing env (Parse.identifier env)) + in + let (body_loc, ((module_kind, body), comments)) = + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_LCURLY; + let (module_kind, body) = module_items env ~module_kind:None [] in + let internal = + if body = [] then + Peek.comments env + else + [] + in + Expect.token env T_RCURLY; + let { trailing; _ } = statement_end_trailing_comments env in + ( (module_kind, body), + Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal () + )) + env + in + let body = (body_loc, { Statement.Block.body; comments }) in + let loc = Loc.btwn start_loc body_loc in + let kind = + match module_kind with + | Some k -> k + | None -> Statement.DeclareModule.CommonJS loc + in + let comments = Flow_ast_utils.mk_comments_opt ~leading () in + (loc, Statement.(DeclareModule DeclareModule.{ id; body; kind; comments })) + in + fun ?(in_module = false) env -> + let start_loc = Peek.loc env in + let leading = Peek.comments env in + Expect.token env T_DECLARE; + let leading = leading @ Peek.comments env in + Expect.identifier env "module"; + if in_module || Peek.token env = T_PERIOD then + let (loc, exports) = with_loc (declare_module_exports ~leading) env in + (Loc.btwn start_loc loc, exports) + else + declare_module_ env start_loc leading + + and declare_module_exports ~leading env = + let leading_period = Peek.comments env in + Expect.token env T_PERIOD; + let leading_exports = Peek.comments env in + Expect.identifier env "exports"; + let leading_annot = Peek.comments env in + let leading = List.concat [leading; leading_period; leading_exports; leading_annot] in + let annot = Type.annotation env in + let (annot, trailing) = + match semicolon env with + | Explicit trailing -> (annot, trailing) + | Implicit { remove_trailing; _ } -> + (remove_trailing annot (fun remover annot -> remover#type_annotation annot), []) + in + let comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () in + Statement.DeclareModuleExports { Statement.DeclareModuleExports.annot; comments } + + and declare ?(in_module = false) env = + if not (should_parse_types env) then error env Parse_error.UnexpectedTypeDeclaration; + + (* eventually, just emit a wrapper AST node *) + match Peek.ith_token ~i:1 env with + | T_CLASS -> declare_class_statement env + | T_INTERFACE -> declare_interface env + | T_TYPE -> + (match Peek.token env with + | T_IMPORT when in_module -> import_declaration env + | _ -> declare_type_alias env) + | T_OPAQUE -> declare_opaque_type env + | T_TYPEOF when Peek.token env = T_IMPORT -> import_declaration env + | T_FUNCTION + | T_ASYNC -> + declare_function_statement env + | T_VAR -> declare_var_statement env + | T_EXPORT when in_module -> declare_export_declaration ~allow_export_type:in_module env + | T_IDENTIFIER { raw = "module"; _ } -> declare_module ~in_module env + | _ when in_module -> + (match Peek.token env with + | T_IMPORT -> + error env Parse_error.InvalidNonTypeImportInDeclareModule; + Parse.statement env + | _ -> + (* Oh boy, found some bad stuff in a declare module. Let's just + * pretend it's a declare var (arbitrary choice) *) + declare_var_statement env) + | _ -> Parse.statement env + + and export_source env = + Expect.identifier env "from"; + match Peek.token env with + | T_STRING str -> string_literal env str + | _ -> + (* Just make up a string for the error case *) + let ret = (Peek.loc env, { StringLiteral.value = ""; raw = ""; comments = None }) in + error_unexpected ~expected:"a string" env; + ret + + and export_source_and_semicolon env = + let (source_loc, source) = export_source env in + match semicolon env with + | Explicit trailing -> ((source_loc, source), trailing) + | Implicit { remove_trailing; _ } -> + ( ( source_loc, + remove_trailing source (fun remover source -> + remover#string_literal_type source_loc source + ) + ), + [] + ) + + and extract_pattern_binding_names = + let rec fold acc = + let open Pattern in + function + | (_, Object { Object.properties; _ }) -> + List.fold_left + (fun acc prop -> + match prop with + | Object.Property (_, { Object.Property.pattern; _ }) + | Object.RestElement (_, { RestElement.argument = pattern; comments = _ }) -> + fold acc pattern) + acc + properties + | (_, Array { Array.elements; _ }) -> + List.fold_left + (fun acc elem -> + match elem with + | Array.Element (_, { Array.Element.argument = pattern; default = _ }) + | Array.RestElement (_, { RestElement.argument = pattern; comments = _ }) -> + fold acc pattern + | Array.Hole _ -> acc) + acc + elements + | (_, Identifier { Pattern.Identifier.name; _ }) -> name :: acc + | (_, Expression _) -> failwith "Parser error: No such thing as an expression pattern!" + in + List.fold_left fold + + and extract_ident_name (_, { Identifier.name; comments = _ }) = name + + and export_specifiers ?(preceding_comma = true) env specifiers = + match Peek.token env with + | T_EOF + | T_RCURLY -> + List.rev specifiers + | _ -> + if not preceding_comma then error env Parse_error.ExportSpecifierMissingComma; + let specifier = + with_loc + (fun env -> + let local = identifier_name env in + let exported = + match Peek.token env with + | T_IDENTIFIER { raw = "as"; _ } -> + Eat.token env; + let exported = identifier_name env in + record_export env exported; + Some exported + | _ -> + record_export env local; + None + in + { Statement.ExportNamedDeclaration.ExportSpecifier.local; exported }) + env + in + let preceding_comma = Eat.maybe env T_COMMA in + export_specifiers ~preceding_comma env (specifier :: specifiers) + + and assert_export_specifier_identifiers env specifiers = + Statement.ExportNamedDeclaration.ExportSpecifier.( + List.iter + (function + | (_, { local = id; exported = None }) -> + assert_identifier_name_is_identifier ~restricted_error:Parse_error.StrictVarName env id + | _ -> ()) + specifiers + ) + + and export_declaration ~decorators = + with_loc (fun env -> + let env = env |> with_strict true |> with_in_export true in + let start_loc = Peek.loc env in + let leading = Peek.comments env in + Expect.token env T_EXPORT; + match Peek.token env with + | T_DEFAULT -> + (* export default ... *) + Statement.ExportDefaultDeclaration.( + let leading = leading @ Peek.comments env in + let (default, ()) = with_loc (fun env -> Expect.token env T_DEFAULT) env in + record_export + env + (Flow_ast_utils.ident_of_source (Loc.btwn start_loc (Peek.loc env), "default")); + let (declaration, trailing) = + if Peek.is_function env then + (* export default [async] function [foo] (...) { ... } *) + let fn = Declaration._function env in + (Declaration fn, []) + else if Peek.is_class env then + (* export default class foo { ... } *) + let _class = Object.class_declaration env decorators in + (Declaration _class, []) + else if Peek.token env = T_ENUM then + (* export default enum foo { ... } *) + (Declaration (Declaration.enum_declaration env), []) + else + (* export default [assignment expression]; *) + let expr = Parse.assignment env in + let (expr, trailing) = + match semicolon env with + | Explicit trailing -> (expr, trailing) + | Implicit { remove_trailing; _ } -> + (remove_trailing expr (fun remover expr -> remover#expression expr), []) + in + (Expression expr, trailing) + in + Statement.ExportDefaultDeclaration + { + default; + declaration; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + | T_TYPE when Peek.ith_token ~i:1 env <> T_LCURLY -> + (* export type ... *) + Statement.ExportNamedDeclaration.( + if not (should_parse_types env) then error env Parse_error.UnexpectedTypeExport; + (match Peek.ith_token ~i:1 env with + | T_MULT -> + Expect.token env T_TYPE; + let specifier_loc = Peek.loc env in + Expect.token env T_MULT; + let (source, trailing) = export_source_and_semicolon env in + Statement.ExportNamedDeclaration + { + declaration = None; + specifiers = Some (ExportBatchSpecifier (specifier_loc, None)); + source = Some source; + export_kind = Statement.ExportType; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + | T_ENUM -> + error env Parse_error.EnumInvalidExport; + Expect.token env T_TYPE; + Statement.ExportNamedDeclaration + { + declaration = None; + specifiers = None; + source = None; + export_kind = Statement.ExportType; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + | _ -> + let (loc, type_alias) = with_loc (type_alias_helper ~leading:[]) env in + record_export + env + (Flow_ast_utils.ident_of_source + (loc, extract_ident_name type_alias.Statement.TypeAlias.id) + ); + let type_alias = (loc, Statement.TypeAlias type_alias) in + Statement.ExportNamedDeclaration + { + declaration = Some type_alias; + specifiers = None; + source = None; + export_kind = Statement.ExportType; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + }) + ) + | T_OPAQUE -> + (* export opaque type ... *) + Statement.ExportNamedDeclaration.( + let (loc, opaque_t) = with_loc (opaque_type_helper ~leading:[]) env in + record_export + env + (Flow_ast_utils.ident_of_source + (loc, extract_ident_name opaque_t.Statement.OpaqueType.id) + ); + let opaque_t = (loc, Statement.OpaqueType opaque_t) in + Statement.ExportNamedDeclaration + { + declaration = Some opaque_t; + specifiers = None; + source = None; + export_kind = Statement.ExportType; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + | T_INTERFACE -> + (* export interface I { ... } *) + Statement.ExportNamedDeclaration.( + if not (should_parse_types env) then error env Parse_error.UnexpectedTypeExport; + let interface = interface env in + (match interface with + | (loc, Statement.InterfaceDeclaration { Statement.Interface.id; _ }) -> + record_export env (Flow_ast_utils.ident_of_source (loc, extract_ident_name id)) + | _ -> + failwith + ("Internal Flow Error! Parsed `export interface` into something " + ^ "other than an interface declaration!" + )); + Statement.ExportNamedDeclaration + { + declaration = Some interface; + specifiers = None; + source = None; + export_kind = Statement.ExportType; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + | T_LET + | T_CONST + | T_VAR + (* not using Peek.is_class here because it would guard all of the + * cases *) + | T_AT + | T_CLASS + (* not using Peek.is_function here because it would guard all of the + * cases *) + | T_ASYNC + | T_FUNCTION + | T_ENUM -> + Statement.ExportNamedDeclaration.( + let stmt = Parse.statement_list_item env ~decorators in + let names = + let open Statement in + match stmt with + | (_, VariableDeclaration { VariableDeclaration.declarations; _ }) -> + List.fold_left + (fun names (_, declaration) -> + let id = declaration.VariableDeclaration.Declarator.id in + extract_pattern_binding_names names [id]) + [] + declarations + | (loc, ClassDeclaration { Class.id = Some id; _ }) + | (loc, FunctionDeclaration { Function.id = Some id; _ }) + | (loc, EnumDeclaration { EnumDeclaration.id; _ }) -> + [Flow_ast_utils.ident_of_source (loc, extract_ident_name id)] + | (loc, ClassDeclaration { Class.id = None; _ }) -> + error_at env (loc, Parse_error.ExportNamelessClass); + [] + | (loc, FunctionDeclaration { Function.id = None; _ }) -> + error_at env (loc, Parse_error.ExportNamelessFunction); + [] + | _ -> failwith "Internal Flow Error! Unexpected export statement declaration!" + in + List.iter (record_export env) names; + Statement.ExportNamedDeclaration + { + declaration = Some stmt; + specifiers = None; + source = None; + export_kind = Statement.ExportValue; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + | T_MULT -> + Statement.ExportNamedDeclaration.( + let loc = Peek.loc env in + Expect.token env T_MULT; + let local_name = + let parse_export_star_as = (parse_options env).esproposal_export_star_as in + match Peek.token env with + | T_IDENTIFIER { raw = "as"; _ } -> + Eat.token env; + if parse_export_star_as then + Some (Parse.identifier env) + else ( + error env Parse_error.UnexpectedTypeDeclaration; + None + ) + | _ -> None + in + let specifiers = Some (ExportBatchSpecifier (loc, local_name)) in + let (source, trailing) = export_source_and_semicolon env in + Statement.ExportNamedDeclaration + { + declaration = None; + specifiers; + source = Some source; + export_kind = Statement.ExportValue; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + | _ -> + Statement.ExportNamedDeclaration.( + let export_kind = + match Peek.token env with + | T_TYPE -> + Eat.token env; + Statement.ExportType + | _ -> Statement.ExportValue + in + Expect.token env T_LCURLY; + let specifiers = export_specifiers env [] in + Expect.token env T_RCURLY; + let (source, trailing) = + match Peek.token env with + | T_IDENTIFIER { raw = "from"; _ } -> + let (source, trailing) = export_source_and_semicolon env in + (Some source, trailing) + | _ -> + assert_export_specifier_identifiers env specifiers; + let trailing = + match semicolon env with + | Explicit trailing -> trailing + | Implicit { trailing; _ } -> trailing + in + (None, trailing) + in + Statement.ExportNamedDeclaration + { + declaration = None; + specifiers = Some (ExportSpecifiers specifiers); + source; + export_kind; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + ) + + and declare_export_declaration ?(allow_export_type = false) = + with_loc (fun env -> + if not (should_parse_types env) then error env Parse_error.UnexpectedTypeDeclaration; + let leading = Peek.comments env in + Expect.token env T_DECLARE; + let env = env |> with_strict true |> with_in_export true in + let leading = leading @ Peek.comments env in + Expect.token env T_EXPORT; + Statement.DeclareExportDeclaration.( + match Peek.token env with + | T_DEFAULT -> + (* declare export default ... *) + let leading = leading @ Peek.comments env in + let (default, ()) = with_loc (fun env -> Expect.token env T_DEFAULT) env in + let (declaration, trailing) = + match Peek.token env with + | T_FUNCTION -> + (* declare export default function foo (...): ... *) + let fn = with_loc declare_function env in + (Some (Function fn), []) + | T_CLASS -> + (* declare export default class foo { ... } *) + let class_ = with_loc (declare_class ~leading:[]) env in + (Some (Class class_), []) + | _ -> + (* declare export default [type]; *) + let type_ = Type._type env in + let (type_, trailing) = + match semicolon env with + | Explicit trailing -> (type_, trailing) + | Implicit { remove_trailing; _ } -> + (remove_trailing type_ (fun remover type_ -> remover#type_ type_), []) + in + (Some (DefaultType type_), trailing) + in + let comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () in + Statement.DeclareExportDeclaration + { default = Some default; declaration; specifiers = None; source = None; comments } + | T_LET + | T_CONST + | T_VAR + | T_CLASS + | T_FUNCTION -> + let declaration = + match Peek.token env with + | T_FUNCTION -> + (* declare export function foo (...): ... *) + let fn = with_loc declare_function env in + Some (Function fn) + | T_CLASS -> + (* declare export class foo { ... } *) + let class_ = with_loc (declare_class ~leading:[]) env in + Some (Class class_) + | (T_LET | T_CONST | T_VAR) as token -> + (match token with + | T_LET -> error env Parse_error.DeclareExportLet + | T_CONST -> error env Parse_error.DeclareExportConst + | _ -> ()); + + (* declare export var foo: ... *) + let var = with_loc (fun env -> declare_var env []) env in + Some (Variable var) + | _ -> assert false + in + let comments = Flow_ast_utils.mk_comments_opt ~leading () in + Statement.DeclareExportDeclaration + { default = None; declaration; specifiers = None; source = None; comments } + | T_MULT -> + (* declare export * from 'foo' *) + let loc = Peek.loc env in + Expect.token env T_MULT; + let parse_export_star_as = (parse_options env).esproposal_export_star_as in + let local_name = + match Peek.token env with + | T_IDENTIFIER { raw = "as"; _ } -> + Eat.token env; + if parse_export_star_as then + Some (Parse.identifier env) + else ( + error env Parse_error.UnexpectedTypeDeclaration; + None + ) + | _ -> None + in + let specifiers = + Statement.ExportNamedDeclaration.(Some (ExportBatchSpecifier (loc, local_name))) + in + let (source, trailing) = export_source_and_semicolon env in + let comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () in + Statement.DeclareExportDeclaration + { default = None; declaration = None; specifiers; source = Some source; comments } + | T_TYPE when allow_export_type -> + (* declare export type = ... *) + let alias = with_loc (type_alias_helper ~leading:[]) env in + let comments = Flow_ast_utils.mk_comments_opt ~leading () in + Statement.DeclareExportDeclaration + { + default = None; + declaration = Some (NamedType alias); + specifiers = None; + source = None; + comments; + } + | T_OPAQUE -> + (* declare export opaque type = ... *) + let opaque = with_loc (opaque_type_helper ~declare:true ~leading:[]) env in + let comments = Flow_ast_utils.mk_comments_opt ~leading () in + Statement.DeclareExportDeclaration + { + default = None; + declaration = Some (NamedOpaqueType opaque); + specifiers = None; + source = None; + comments; + } + | T_INTERFACE when allow_export_type -> + (* declare export interface ... *) + let iface = with_loc (interface_helper ~leading:[]) env in + let comments = Flow_ast_utils.mk_comments_opt ~leading () in + Statement.DeclareExportDeclaration + { + default = None; + declaration = Some (Interface iface); + specifiers = None; + source = None; + comments; + } + | _ -> + (match Peek.token env with + | T_TYPE -> error env Parse_error.DeclareExportType + | T_INTERFACE -> error env Parse_error.DeclareExportInterface + | _ -> ()); + Expect.token env T_LCURLY; + let specifiers = export_specifiers env [] in + Expect.token env T_RCURLY; + let (source, trailing) = + match Peek.token env with + | T_IDENTIFIER { raw = "from"; _ } -> + let (source, trailing) = export_source_and_semicolon env in + (Some source, trailing) + | _ -> + assert_export_specifier_identifiers env specifiers; + let trailing = + match semicolon env with + | Explicit trailing -> trailing + | Implicit { trailing; _ } -> trailing + in + (None, trailing) + in + let comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () in + Statement.DeclareExportDeclaration + { + default = None; + declaration = None; + specifiers = Some (Statement.ExportNamedDeclaration.ExportSpecifiers specifiers); + source; + comments; + } + ) + ) + + and import_declaration = + Statement.ImportDeclaration.( + let missing_source env = + (* Just make up a string for the error case *) + let loc = Peek.loc_skip_lookahead env in + (loc, { StringLiteral.value = ""; raw = ""; comments = None }) + in + let source env = + match Peek.token env with + | T_IDENTIFIER { raw = "from"; _ } -> + Eat.token env; + (match Peek.token env with + | T_STRING str -> string_literal env str + | _ -> + error_unexpected ~expected:"a string" env; + missing_source env) + | _ -> + error_unexpected ~expected:"the keyword `from`" env; + missing_source env + in + let is_type_import = function + | T_TYPE + | T_TYPEOF -> + true + | _ -> false + (* `x` or `x as y` in a specifier *) + in + let with_maybe_as ~for_type ?error_if_type env = + let identifier env = + if for_type then + Type.type_identifier env + else + Parse.identifier env + in + match Peek.ith_token ~i:1 env with + | T_IDENTIFIER { raw = "as"; _ } -> + let remote = identifier_name env in + Eat.token env; + + (* as *) + let local = Some (identifier env) in + (remote, local) + | T_EOF + | T_COMMA + | T_RCURLY -> + (identifier env, None) + | _ -> + begin + match (error_if_type, Peek.token env) with + | (Some error_if_type, T_TYPE) + | (Some error_if_type, T_TYPEOF) -> + error env error_if_type; + Eat.token env; + + (* consume `type` or `typeof` *) + (Type.type_identifier env, None) + | _ -> (identifier env, None) + end + (* + ImportSpecifier[Type]: + [~Type] ImportedBinding + [~Type] IdentifierName ImportedTypeBinding + [~Type] IdentifierName IdentifierName ImportedBinding + [~Type] IdentifierName IdentifierName IdentifierName ImportedTypeBinding + [+Type] ImportedTypeBinding + [+Type] IdentifierName IdentifierName ImportedTypeBinding + + Static Semantics: + + `IdentifierName ImportedTypeBinding`: + - It is a Syntax Error if IdentifierName's StringValue is not "type" or "typeof" + + `IdentifierName IdentifierName ImportedBinding`: + - It is a Syntax Error if the second IdentifierName's StringValue is not "as" + + `IdentifierName IdentifierName IdentifierName ImportedTypeBinding`: + - It is a Syntax Error if the first IdentifierName's StringValue is not "type" + or "typeof", and the third IdentifierName's StringValue is not "as" + *) + in + + let specifier env = + let kind = + match Peek.token env with + | T_TYPE -> Some ImportType + | T_TYPEOF -> Some ImportTypeof + | _ -> None + in + if is_type_import (Peek.token env) then + (* consume `type`, but we don't know yet whether this is `type foo` or + `type as foo`. *) + let type_keyword_or_remote = identifier_name env in + match Peek.token env with + (* `type` (a value) *) + | T_EOF + | T_RCURLY + | T_COMMA -> + let remote = type_keyword_or_remote in + (* `type` becomes a value *) + assert_identifier_name_is_identifier env remote; + { remote; local = None; kind = None } + (* `type as foo` (value named `type`) or `type as,` (type named `as`) *) + | T_IDENTIFIER { raw = "as"; _ } -> + begin + match Peek.ith_token ~i:1 env with + | T_EOF + | T_RCURLY + | T_COMMA -> + (* `type as` *) + { remote = Type.type_identifier env; local = None; kind } + | T_IDENTIFIER { raw = "as"; _ } -> + (* `type as as foo` *) + let remote = identifier_name env in + (* first `as` *) + Eat.token env; + + (* second `as` *) + let local = Some (Type.type_identifier env) in + (* `foo` *) + { remote; local; kind } + | _ -> + (* `type as foo` *) + let remote = type_keyword_or_remote in + (* `type` becomes a value *) + assert_identifier_name_is_identifier env remote; + Eat.token env; + + (* `as` *) + let local = Some (Parse.identifier env) in + { remote; local; kind = None } + end + (* `type x`, or `type x as y` *) + | _ -> + let (remote, local) = with_maybe_as ~for_type:true env in + { remote; local; kind } + else + (* standard `x` or `x as y` *) + let (remote, local) = with_maybe_as ~for_type:false env in + { remote; local; kind = None } + (* specifier in an `import type { ... }` *) + in + let type_specifier env = + let (remote, local) = + with_maybe_as + env + ~for_type:true + ~error_if_type:Parse_error.ImportTypeShorthandOnlyInPureImport + in + { remote; local; kind = None } + (* specifier in an `import typeof { ... }` *) + in + let typeof_specifier env = + let (remote, local) = + with_maybe_as + env + ~for_type:true + ~error_if_type:Parse_error.ImportTypeShorthandOnlyInPureImport + in + { remote; local; kind = None } + in + let rec specifier_list ?(preceding_comma = true) env statement_kind acc = + match Peek.token env with + | T_EOF + | T_RCURLY -> + List.rev acc + | _ -> + if not preceding_comma then error env Parse_error.ImportSpecifierMissingComma; + let specifier = + match statement_kind with + | ImportType -> type_specifier env + | ImportTypeof -> typeof_specifier env + | ImportValue -> specifier env + in + let preceding_comma = Eat.maybe env T_COMMA in + specifier_list ~preceding_comma env statement_kind (specifier :: acc) + in + let named_or_namespace_specifier env import_kind = + match Peek.token env with + | T_MULT -> + let id = + with_loc_opt + (fun env -> + (* consume T_MULT *) + Eat.token env; + match Peek.token env with + | T_IDENTIFIER { raw = "as"; _ } -> + (* consume "as" *) + Eat.token env; + (match import_kind with + | ImportType + | ImportTypeof -> + Some (Type.type_identifier env) + | ImportValue -> Some (Parse.identifier env)) + | _ -> + error_unexpected ~expected:"the keyword `as`" env; + None) + env + in + (match id with + | Some id -> Some (ImportNamespaceSpecifier id) + | None -> None) + | _ -> + Expect.token env T_LCURLY; + let specifiers = specifier_list env import_kind [] in + Expect.token env T_RCURLY; + Some (ImportNamedSpecifiers specifiers) + in + let semicolon_and_trailing env source = + match semicolon env with + | Explicit trailing -> (trailing, source) + | Implicit { remove_trailing; _ } -> + ( [], + remove_trailing source (fun remover (loc, source) -> + (loc, remover#string_literal_type loc source) + ) + ) + in + let with_specifiers import_kind env leading = + let specifiers = named_or_namespace_specifier env import_kind in + let source = source env in + let (trailing, source) = semicolon_and_trailing env source in + Statement.ImportDeclaration + { + import_kind; + source; + specifiers; + default = None; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + in + let with_default import_kind env leading = + let default_specifier = + match import_kind with + | ImportType + | ImportTypeof -> + Type.type_identifier env + | ImportValue -> Parse.identifier env + in + let additional_specifiers = + match Peek.token env with + | T_COMMA -> + (* `import Foo, ...` *) + Expect.token env T_COMMA; + named_or_namespace_specifier env import_kind + | _ -> None + in + let source = source env in + let (trailing, source) = semicolon_and_trailing env source in + Statement.ImportDeclaration + { + import_kind; + source; + specifiers = additional_specifiers; + default = Some default_specifier; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + in + with_loc (fun env -> + let env = env |> with_strict true in + let leading = Peek.comments env in + Expect.token env T_IMPORT; + + match Peek.token env with + (* `import * as ns from "ModuleName";` *) + | T_MULT -> with_specifiers ImportValue env leading + (* `import { ... } from "ModuleName";` *) + | T_LCURLY -> with_specifiers ImportValue env leading + (* `import "ModuleName";` *) + | T_STRING str -> + let source = string_literal env str in + let (trailing, source) = semicolon_and_trailing env source in + Statement.ImportDeclaration + { + import_kind = ImportValue; + source; + specifiers = None; + default = None; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + (* `import type [...] from "ModuleName";` + note that if [...] is missing, we're importing a value named `type`! *) + | T_TYPE when should_parse_types env -> + begin + match Peek.ith_token ~i:1 env with + (* `import type, { other, names } from "ModuleName";` *) + | T_COMMA + (* `import type from "ModuleName";` *) + | T_IDENTIFIER { raw = "from"; _ } -> + (* Importing the exported value named "type". This is not a type-import.*) + with_default ImportValue env leading + (* `import type *` is invalid, since the namespace can't be a type *) + | T_MULT -> + (* consume `type` *) + Eat.token env; + + (* unexpected `*` *) + error_unexpected env; + + with_specifiers ImportType env leading + | T_LCURLY -> + (* consume `type` *) + Eat.token env; + + with_specifiers ImportType env leading + | _ -> + (* consume `type` *) + Eat.token env; + + with_default ImportType env leading + end + (* `import typeof ... from "ModuleName";` *) + | T_TYPEOF when should_parse_types env -> + Expect.token env T_TYPEOF; + begin + match Peek.token env with + | T_MULT + | T_LCURLY -> + with_specifiers ImportTypeof env leading + | _ -> with_default ImportTypeof env leading + end + (* import Foo from "ModuleName"; *) + | _ -> with_default ImportValue env leading + ) + ) +end diff --git a/flow/parser/token.ml b/flow/parser/token.ml new file mode 100644 index 0000000000..dbf2448e0f --- /dev/null +++ b/flow/parser/token.ml @@ -0,0 +1,500 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +type t = + | T_NUMBER of { + kind: number_type; + raw: string; + } + | T_BIGINT of { + kind: bigint_type; + raw: string; + } + | T_STRING of (Loc.t * string * string * bool) (* loc, value, raw, octal *) + | T_TEMPLATE_PART of (Loc.t * template_part * bool) (* loc, value, is_tail *) + | T_IDENTIFIER of { + loc: Loc.t; + value: string; + raw: string; + } + | T_REGEXP of Loc.t * string * string (* /pattern/flags *) + (* Syntax *) + | T_LCURLY + | T_RCURLY + | T_LCURLYBAR + | T_RCURLYBAR + | T_LPAREN + | T_RPAREN + | T_LBRACKET + | T_RBRACKET + | T_SEMICOLON + | T_COMMA + | T_PERIOD + | T_ARROW + | T_ELLIPSIS + | T_AT + | T_POUND + (* Keywords *) + | T_FUNCTION + | T_IF + | T_IN + | T_INSTANCEOF + | T_RETURN + | T_SWITCH + | T_THIS + | T_THROW + | T_TRY + | T_VAR + | T_WHILE + | T_WITH + | T_CONST + | T_LET + | T_NULL + | T_FALSE + | T_TRUE + | T_BREAK + | T_CASE + | T_CATCH + | T_CONTINUE + | T_DEFAULT + | T_DO + | T_FINALLY + | T_FOR + | T_CLASS + | T_EXTENDS + | T_STATIC + | T_ELSE + | T_NEW + | T_DELETE + | T_TYPEOF + | T_VOID + | T_ENUM + | T_EXPORT + | T_IMPORT + | T_SUPER + | T_IMPLEMENTS + | T_INTERFACE + | T_PACKAGE + | T_PRIVATE + | T_PROTECTED + | T_PUBLIC + | T_YIELD + | T_DEBUGGER + | T_DECLARE + | T_TYPE + | T_OPAQUE + | T_OF + | T_ASYNC + | T_AWAIT + | T_CHECKS + (* Operators *) + | T_RSHIFT3_ASSIGN + | T_RSHIFT_ASSIGN + | T_LSHIFT_ASSIGN + | T_BIT_XOR_ASSIGN + | T_BIT_OR_ASSIGN + | T_BIT_AND_ASSIGN + | T_MOD_ASSIGN + | T_DIV_ASSIGN + | T_MULT_ASSIGN + | T_EXP_ASSIGN + | T_MINUS_ASSIGN + | T_PLUS_ASSIGN + | T_ASSIGN + | T_PLING_PERIOD + | T_PLING_PLING + | T_PLING + | T_COLON + | T_OR + | T_AND + | T_BIT_OR + | T_BIT_XOR + | T_BIT_AND + | T_EQUAL + | T_NOT_EQUAL + | T_STRICT_EQUAL + | T_STRICT_NOT_EQUAL + | T_LESS_THAN_EQUAL + | T_GREATER_THAN_EQUAL + | T_LESS_THAN + | T_GREATER_THAN + | T_LSHIFT + | T_RSHIFT + | T_RSHIFT3 + | T_PLUS + | T_MINUS + | T_DIV + | T_MULT + | T_EXP + | T_MOD + | T_NOT + | T_BIT_NOT + | T_INCR + | T_DECR + (* Extra tokens *) + | T_ERROR of string + | T_EOF + (* JSX *) + | T_JSX_IDENTIFIER of { raw: string } + | T_JSX_TEXT of Loc.t * string * string (* loc, value, raw *) + (* Type primitives *) + | T_ANY_TYPE + | T_MIXED_TYPE + | T_EMPTY_TYPE + | T_BOOLEAN_TYPE of bool_or_boolean + | T_NUMBER_TYPE + | T_BIGINT_TYPE + | T_NUMBER_SINGLETON_TYPE of { + kind: number_type; + value: float; + raw: string; + } + | T_BIGINT_SINGLETON_TYPE of { + kind: bigint_type; + approx_value: float; + (* Warning! Might lose precision! *) + raw: string; + } + | T_STRING_TYPE + | T_VOID_TYPE + | T_SYMBOL_TYPE + +(* `bool` and `boolean` are equivalent annotations, but we need to track + which one was used for when it might be an identifier, as in + `(bool: boolean) => void`. It's lexed as two T_BOOLEAN_TYPEs, then the + first one is converted into an identifier. *) +and bool_or_boolean = + | BOOL + | BOOLEAN + +and number_type = + | BINARY + | LEGACY_OCTAL + | LEGACY_NON_OCTAL (* NonOctalDecimalIntegerLiteral in Annex B *) + | OCTAL + | NORMAL + +and bigint_type = + | BIG_BINARY + | BIG_OCTAL + | BIG_NORMAL + +and template_part = { + cooked: string; + (* string after processing special chars *) + raw: string; + (* string as specified in source *) + literal: string; (* same as raw, plus characters like ` and ${ *) +} +[@@deriving eq] + +let equal a b = a = b + +(*****************************************************************************) +(* Pretty printer (pretty?) *) +(*****************************************************************************) +let token_to_string = function + | T_NUMBER _ -> "T_NUMBER" + | T_BIGINT _ -> "T_BIGINT" + | T_STRING _ -> "T_STRING" + | T_TEMPLATE_PART _ -> "T_TEMPLATE_PART" + | T_IDENTIFIER _ -> "T_IDENTIFIER" + | T_REGEXP _ -> "T_REGEXP" + | T_FUNCTION -> "T_FUNCTION" + | T_IF -> "T_IF" + | T_IN -> "T_IN" + | T_INSTANCEOF -> "T_INSTANCEOF" + | T_RETURN -> "T_RETURN" + | T_SWITCH -> "T_SWITCH" + | T_THIS -> "T_THIS" + | T_THROW -> "T_THROW" + | T_TRY -> "T_TRY" + | T_VAR -> "T_VAR" + | T_WHILE -> "T_WHILE" + | T_WITH -> "T_WITH" + | T_CONST -> "T_CONST" + | T_LET -> "T_LET" + | T_NULL -> "T_NULL" + | T_FALSE -> "T_FALSE" + | T_TRUE -> "T_TRUE" + | T_BREAK -> "T_BREAK" + | T_CASE -> "T_CASE" + | T_CATCH -> "T_CATCH" + | T_CONTINUE -> "T_CONTINUE" + | T_DEFAULT -> "T_DEFAULT" + | T_DO -> "T_DO" + | T_FINALLY -> "T_FINALLY" + | T_FOR -> "T_FOR" + | T_CLASS -> "T_CLASS" + | T_EXTENDS -> "T_EXTENDS" + | T_STATIC -> "T_STATIC" + | T_ELSE -> "T_ELSE" + | T_NEW -> "T_NEW" + | T_DELETE -> "T_DELETE" + | T_TYPEOF -> "T_TYPEOF" + | T_VOID -> "T_VOID" + | T_ENUM -> "T_ENUM" + | T_EXPORT -> "T_EXPORT" + | T_IMPORT -> "T_IMPORT" + | T_SUPER -> "T_SUPER" + | T_IMPLEMENTS -> "T_IMPLEMENTS" + | T_INTERFACE -> "T_INTERFACE" + | T_PACKAGE -> "T_PACKAGE" + | T_PRIVATE -> "T_PRIVATE" + | T_PROTECTED -> "T_PROTECTED" + | T_PUBLIC -> "T_PUBLIC" + | T_YIELD -> "T_YIELD" + | T_DEBUGGER -> "T_DEBUGGER" + | T_DECLARE -> "T_DECLARE" + | T_TYPE -> "T_TYPE" + | T_OPAQUE -> "T_OPAQUE" + | T_OF -> "T_OF" + | T_ASYNC -> "T_ASYNC" + | T_AWAIT -> "T_AWAIT" + | T_CHECKS -> "T_CHECKS" + | T_LCURLY -> "T_LCURLY" + | T_RCURLY -> "T_RCURLY" + | T_LCURLYBAR -> "T_LCURLYBAR" + | T_RCURLYBAR -> "T_RCURLYBAR" + | T_LPAREN -> "T_LPAREN" + | T_RPAREN -> "T_RPAREN" + | T_LBRACKET -> "T_LBRACKET" + | T_RBRACKET -> "T_RBRACKET" + | T_SEMICOLON -> "T_SEMICOLON" + | T_COMMA -> "T_COMMA" + | T_PERIOD -> "T_PERIOD" + | T_ARROW -> "T_ARROW" + | T_ELLIPSIS -> "T_ELLIPSIS" + | T_AT -> "T_AT" + | T_POUND -> "T_POUND" + | T_RSHIFT3_ASSIGN -> "T_RSHIFT3_ASSIGN" + | T_RSHIFT_ASSIGN -> "T_RSHIFT_ASSIGN" + | T_LSHIFT_ASSIGN -> "T_LSHIFT_ASSIGN" + | T_BIT_XOR_ASSIGN -> "T_BIT_XOR_ASSIGN" + | T_BIT_OR_ASSIGN -> "T_BIT_OR_ASSIGN" + | T_BIT_AND_ASSIGN -> "T_BIT_AND_ASSIGN" + | T_MOD_ASSIGN -> "T_MOD_ASSIGN" + | T_DIV_ASSIGN -> "T_DIV_ASSIGN" + | T_MULT_ASSIGN -> "T_MULT_ASSIGN" + | T_EXP_ASSIGN -> "T_EXP_ASSIGN" + | T_MINUS_ASSIGN -> "T_MINUS_ASSIGN" + | T_PLUS_ASSIGN -> "T_PLUS_ASSIGN" + | T_ASSIGN -> "T_ASSIGN" + | T_PLING_PERIOD -> "T_PLING_PERIOD" + | T_PLING_PLING -> "T_PLING_PLING" + | T_PLING -> "T_PLING" + | T_COLON -> "T_COLON" + | T_OR -> "T_OR" + | T_AND -> "T_AND" + | T_BIT_OR -> "T_BIT_OR" + | T_BIT_XOR -> "T_BIT_XOR" + | T_BIT_AND -> "T_BIT_AND" + | T_EQUAL -> "T_EQUAL" + | T_NOT_EQUAL -> "T_NOT_EQUAL" + | T_STRICT_EQUAL -> "T_STRICT_EQUAL" + | T_STRICT_NOT_EQUAL -> "T_STRICT_NOT_EQUAL" + | T_LESS_THAN_EQUAL -> "T_LESS_THAN_EQUAL" + | T_GREATER_THAN_EQUAL -> "T_GREATER_THAN_EQUAL" + | T_LESS_THAN -> "T_LESS_THAN" + | T_GREATER_THAN -> "T_GREATER_THAN" + | T_LSHIFT -> "T_LSHIFT" + | T_RSHIFT -> "T_RSHIFT" + | T_RSHIFT3 -> "T_RSHIFT3" + | T_PLUS -> "T_PLUS" + | T_MINUS -> "T_MINUS" + | T_DIV -> "T_DIV" + | T_MULT -> "T_MULT" + | T_EXP -> "T_EXP" + | T_MOD -> "T_MOD" + | T_NOT -> "T_NOT" + | T_BIT_NOT -> "T_BIT_NOT" + | T_INCR -> "T_INCR" + | T_DECR -> "T_DECR" + (* Extra tokens *) + | T_ERROR _ -> "T_ERROR" + | T_EOF -> "T_EOF" + | T_JSX_IDENTIFIER _ -> "T_JSX_IDENTIFIER" + | T_JSX_TEXT _ -> "T_JSX_TEXT" + (* Type primitives *) + | T_ANY_TYPE -> "T_ANY_TYPE" + | T_MIXED_TYPE -> "T_MIXED_TYPE" + | T_EMPTY_TYPE -> "T_EMPTY_TYPE" + | T_BOOLEAN_TYPE _ -> "T_BOOLEAN_TYPE" + | T_NUMBER_TYPE -> "T_NUMBER_TYPE" + | T_BIGINT_TYPE -> "T_BIGINT_TYPE" + | T_NUMBER_SINGLETON_TYPE _ -> "T_NUMBER_SINGLETON_TYPE" + | T_BIGINT_SINGLETON_TYPE _ -> "T_BIGINT_SINGLETON_TYPE" + | T_STRING_TYPE -> "T_STRING_TYPE" + | T_VOID_TYPE -> "T_VOID_TYPE" + | T_SYMBOL_TYPE -> "T_SYMBOL_TYPE" + +let value_of_token = function + | T_NUMBER { raw; _ } -> raw + | T_BIGINT { raw; _ } -> raw + | T_STRING (_, _, raw, _) -> raw + | T_TEMPLATE_PART (_, { literal; _ }, _) -> literal + | T_IDENTIFIER { raw; _ } -> raw + | T_REGEXP (_, pattern, flags) -> "/" ^ pattern ^ "/" ^ flags + | T_LCURLY -> "{" + | T_RCURLY -> "}" + | T_LCURLYBAR -> "{|" + | T_RCURLYBAR -> "|}" + | T_LPAREN -> "(" + | T_RPAREN -> ")" + | T_LBRACKET -> "[" + | T_RBRACKET -> "]" + | T_SEMICOLON -> ";" + | T_COMMA -> "," + | T_PERIOD -> "." + | T_ARROW -> "=>" + | T_ELLIPSIS -> "..." + | T_AT -> "@" + | T_POUND -> "#" + | T_FUNCTION -> "function" + | T_IF -> "if" + | T_IN -> "in" + | T_INSTANCEOF -> "instanceof" + | T_RETURN -> "return" + | T_SWITCH -> "switch" + | T_THIS -> "this" + | T_THROW -> "throw" + | T_TRY -> "try" + | T_VAR -> "var" + | T_WHILE -> "while" + | T_WITH -> "with" + | T_CONST -> "const" + | T_LET -> "let" + | T_NULL -> "null" + | T_FALSE -> "false" + | T_TRUE -> "true" + | T_BREAK -> "break" + | T_CASE -> "case" + | T_CATCH -> "catch" + | T_CONTINUE -> "continue" + | T_DEFAULT -> "default" + | T_DO -> "do" + | T_FINALLY -> "finally" + | T_FOR -> "for" + | T_CLASS -> "class" + | T_EXTENDS -> "extends" + | T_STATIC -> "static" + | T_ELSE -> "else" + | T_NEW -> "new" + | T_DELETE -> "delete" + | T_TYPEOF -> "typeof" + | T_VOID -> "void" + | T_ENUM -> "enum" + | T_EXPORT -> "export" + | T_IMPORT -> "import" + | T_SUPER -> "super" + | T_IMPLEMENTS -> "implements" + | T_INTERFACE -> "interface" + | T_PACKAGE -> "package" + | T_PRIVATE -> "private" + | T_PROTECTED -> "protected" + | T_PUBLIC -> "public" + | T_YIELD -> "yield" + | T_DEBUGGER -> "debugger" + | T_DECLARE -> "declare" + | T_TYPE -> "type" + | T_OPAQUE -> "opaque" + | T_OF -> "of" + | T_ASYNC -> "async" + | T_AWAIT -> "await" + | T_CHECKS -> "%checks" + | T_RSHIFT3_ASSIGN -> ">>>=" + | T_RSHIFT_ASSIGN -> ">>=" + | T_LSHIFT_ASSIGN -> "<<=" + | T_BIT_XOR_ASSIGN -> "^=" + | T_BIT_OR_ASSIGN -> "|=" + | T_BIT_AND_ASSIGN -> "&=" + | T_MOD_ASSIGN -> "%=" + | T_DIV_ASSIGN -> "/=" + | T_MULT_ASSIGN -> "*=" + | T_EXP_ASSIGN -> "**=" + | T_MINUS_ASSIGN -> "-=" + | T_PLUS_ASSIGN -> "+=" + | T_ASSIGN -> "=" + | T_PLING_PERIOD -> "?." + | T_PLING_PLING -> "??" + | T_PLING -> "?" + | T_COLON -> ":" + | T_OR -> "||" + | T_AND -> "&&" + | T_BIT_OR -> "|" + | T_BIT_XOR -> "^" + | T_BIT_AND -> "&" + | T_EQUAL -> "==" + | T_NOT_EQUAL -> "!=" + | T_STRICT_EQUAL -> "===" + | T_STRICT_NOT_EQUAL -> "!==" + | T_LESS_THAN_EQUAL -> "<=" + | T_GREATER_THAN_EQUAL -> ">=" + | T_LESS_THAN -> "<" + | T_GREATER_THAN -> ">" + | T_LSHIFT -> "<<" + | T_RSHIFT -> ">>" + | T_RSHIFT3 -> ">>>" + | T_PLUS -> "+" + | T_MINUS -> "-" + | T_DIV -> "/" + | T_MULT -> "*" + | T_EXP -> "**" + | T_MOD -> "%" + | T_NOT -> "!" + | T_BIT_NOT -> "~" + | T_INCR -> "++" + | T_DECR -> "--" + (* Extra tokens *) + | T_ERROR raw -> raw + | T_EOF -> "" + | T_JSX_IDENTIFIER { raw } -> raw + | T_JSX_TEXT (_, _, raw) -> raw + (* Type primitives *) + | T_ANY_TYPE -> "any" + | T_MIXED_TYPE -> "mixed" + | T_EMPTY_TYPE -> "empty" + | T_BOOLEAN_TYPE kind -> + begin + match kind with + | BOOL -> "bool" + | BOOLEAN -> "boolean" + end + | T_NUMBER_TYPE -> "number" + | T_BIGINT_TYPE -> "bigint" + | T_NUMBER_SINGLETON_TYPE { raw; _ } -> raw + | T_BIGINT_SINGLETON_TYPE { raw; _ } -> raw + | T_STRING_TYPE -> "string" + | T_VOID_TYPE -> "void" + | T_SYMBOL_TYPE -> "symbol" + +let quote_token_value value = Printf.sprintf "token `%s`" value + +let explanation_of_token ?(use_article = false) token = + let (value, article) = + match token with + | T_NUMBER_SINGLETON_TYPE _ + | T_NUMBER _ -> + ("number", "a") + | T_BIGINT_SINGLETON_TYPE _ + | T_BIGINT _ -> + ("bigint", "a") + | T_JSX_TEXT _ + | T_STRING _ -> + ("string", "a") + | T_TEMPLATE_PART _ -> ("template literal part", "a") + | T_JSX_IDENTIFIER _ + | T_IDENTIFIER _ -> + ("identifier", "an") + | T_REGEXP _ -> ("regexp", "a") + | T_EOF -> ("end of input", "the") + | _ -> (quote_token_value (value_of_token token), "the") + in + if use_article then + article ^ " " ^ value + else + value diff --git a/flow/parser/type_parser.ml b/flow/parser/type_parser.ml new file mode 100644 index 0000000000..51cd207179 --- /dev/null +++ b/flow/parser/type_parser.ml @@ -0,0 +1,1484 @@ +(* + * Copyright (c) Meta Platforms, Inc. and affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +module Ast = Flow_ast +open Token +open Parser_env +open Flow_ast +open Parser_common +open Comment_attachment + +module type TYPE = sig + val _type : env -> (Loc.t, Loc.t) Ast.Type.t + + val type_identifier : env -> (Loc.t, Loc.t) Ast.Identifier.t + + val type_params : env -> (Loc.t, Loc.t) Ast.Type.TypeParams.t option + + val type_args : env -> (Loc.t, Loc.t) Ast.Type.TypeArgs.t option + + val generic : env -> Loc.t * (Loc.t, Loc.t) Ast.Type.Generic.t + + val _object : is_class:bool -> env -> Loc.t * (Loc.t, Loc.t) Type.Object.t + + val interface_helper : + env -> + (Loc.t * (Loc.t, Loc.t) Ast.Type.Generic.t) list * (Loc.t * (Loc.t, Loc.t) Ast.Type.Object.t) + + val function_param_list : env -> (Loc.t, Loc.t) Type.Function.Params.t + + val annotation : env -> (Loc.t, Loc.t) Ast.Type.annotation + + val annotation_opt : env -> (Loc.t, Loc.t) Ast.Type.annotation_or_hint + + val predicate_opt : env -> (Loc.t, Loc.t) Ast.Type.Predicate.t option + + val annotation_and_predicate_opt : + env -> (Loc.t, Loc.t) Ast.Type.annotation_or_hint * (Loc.t, Loc.t) Ast.Type.Predicate.t option +end + +module Type (Parse : Parser_common.PARSER) : TYPE = struct + type param_list_or_type = + | ParamList of (Loc.t, Loc.t) Type.Function.Params.t' + | Type of (Loc.t, Loc.t) Type.t + + let maybe_variance env = + let loc = Peek.loc env in + match Peek.token env with + | T_PLUS -> + let leading = Peek.comments env in + Eat.token env; + Some + ( loc, + { Variance.kind = Variance.Plus; comments = Flow_ast_utils.mk_comments_opt ~leading () } + ) + | T_MINUS -> + let leading = Peek.comments env in + Eat.token env; + Some + ( loc, + { Variance.kind = Variance.Minus; comments = Flow_ast_utils.mk_comments_opt ~leading () } + ) + | _ -> None + + let rec _type env = union env + + and annotation env = + if not (should_parse_types env) then error env Parse_error.UnexpectedTypeAnnotation; + with_loc + (fun env -> + Expect.token env T_COLON; + _type env) + env + + and union env = + let leading = + if Peek.token env = T_BIT_OR then ( + let leading = Peek.comments env in + Eat.token env; + leading + ) else + [] + in + let left = intersection env in + union_with env ~leading left + + and union_with = + let rec unions leading acc env = + match Peek.token env with + | T_BIT_OR -> + Expect.token env T_BIT_OR; + unions leading (intersection env :: acc) env + | _ -> + (match List.rev acc with + | t0 :: t1 :: ts -> + Type.Union + { + Type.Union.types = (t0, t1, ts); + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + | _ -> assert false) + in + fun env ?(leading = []) left -> + if Peek.token env = T_BIT_OR then + with_loc ~start_loc:(fst left) (unions leading [left]) env + else + left + + and intersection env = + let leading = + if Peek.token env = T_BIT_AND then ( + let leading = Peek.comments env in + Eat.token env; + leading + ) else + [] + in + let left = anon_function_without_parens env in + intersection_with env ~leading left + + and intersection_with = + let rec intersections leading acc env = + match Peek.token env with + | T_BIT_AND -> + Expect.token env T_BIT_AND; + intersections leading (anon_function_without_parens env :: acc) env + | _ -> + (match List.rev acc with + | t0 :: t1 :: ts -> + Type.Intersection + { + Type.Intersection.types = (t0, t1, ts); + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + | _ -> assert false) + in + fun env ?(leading = []) left -> + if Peek.token env = T_BIT_AND then + with_loc ~start_loc:(fst left) (intersections leading [left]) env + else + left + + and anon_function_without_parens env = + let param = prefix env in + anon_function_without_parens_with env param + + and anon_function_without_parens_with env param = + match Peek.token env with + | T_ARROW when not (no_anon_function_type env) -> + let (start_loc, tparams, params) = + let param = anonymous_function_param env param in + ( fst param, + None, + ( fst param, + { + Ast.Type.Function.Params.params = [param]; + this_ = None; + rest = None; + comments = None; + } + ) + ) + in + function_with_params env start_loc tparams params + | _ -> param + + and prefix env = + match Peek.token env with + | T_PLING -> + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_PLING; + Type.Nullable + { + Type.Nullable.argument = prefix env; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + }) + env + | _ -> postfix env + + and postfix env = + let t = primary env in + postfix_with env t + + and postfix_with ?(in_optional_indexed_access = false) env t = + if Peek.is_line_terminator env then + t + else + match Peek.token env with + | T_PLING_PERIOD -> + Eat.token env; + if Peek.token env <> T_LBRACKET then error env Parse_error.InvalidOptionalIndexedAccess; + Expect.token env T_LBRACKET; + postfix_brackets ~in_optional_indexed_access:true ~optional_indexed_access:true env t + | T_LBRACKET -> + Eat.token env; + postfix_brackets ~in_optional_indexed_access ~optional_indexed_access:false env t + | T_PERIOD -> + (match Peek.ith_token ~i:1 env with + | T_LBRACKET -> + error env (Parse_error.InvalidIndexedAccess { has_bracket = true }); + Expect.token env T_PERIOD; + Expect.token env T_LBRACKET; + postfix_brackets ~in_optional_indexed_access ~optional_indexed_access:false env t + | _ -> + error env (Parse_error.InvalidIndexedAccess { has_bracket = false }); + t) + | _ -> t + + and postfix_brackets ~in_optional_indexed_access ~optional_indexed_access env t = + let t = + with_loc + ~start_loc:(fst t) + (fun env -> + (* Legacy Array syntax `Foo[]` *) + if (not optional_indexed_access) && Eat.maybe env T_RBRACKET then + let trailing = Eat.trailing_comments env in + Type.Array + { Type.Array.argument = t; comments = Flow_ast_utils.mk_comments_opt ~trailing () } + else + let index = _type env in + Expect.token env T_RBRACKET; + let trailing = Eat.trailing_comments env in + let indexed_access = + { + Type.IndexedAccess._object = t; + index; + comments = Flow_ast_utils.mk_comments_opt ~trailing (); + } + in + if in_optional_indexed_access then + Type.OptionalIndexedAccess + { Type.OptionalIndexedAccess.indexed_access; optional = optional_indexed_access } + else + Type.IndexedAccess indexed_access) + env + in + postfix_with env ~in_optional_indexed_access t + + and typeof_expr env = raw_typeof_expr_with_identifier env (Parse.identifier env) + + and raw_typeof_expr_with_identifier = + let rec identifier env (q_loc, qualification) = + if Peek.token env = T_PERIOD && Peek.ith_is_identifier ~i:1 env then + let (loc, q) = + with_loc + ~start_loc:q_loc + (fun env -> + Expect.token env T_PERIOD; + let id = identifier_name env in + { Type.Typeof.Target.qualification; id }) + env + in + let qualification = Type.Typeof.Target.Qualified (loc, q) in + identifier env (loc, qualification) + else + qualification + in + fun env ((loc, _) as id) -> + let id = Type.Typeof.Target.Unqualified id in + identifier env (loc, id) + + and typeof_arg env = + match Peek.token env with + | T_LPAREN -> + Eat.token env; + let typeof = typeof_arg env in + Expect.token env T_RPAREN; + typeof + | T_IDENTIFIER _ (* `static` is reserved in strict mode, but still an identifier *) -> + Some (typeof_expr env) + | _ -> + error env Parse_error.InvalidTypeof; + None + + and typeof env = + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_TYPEOF; + match typeof_arg env with + | None -> Type.Any None + | Some argument -> + Type.Typeof + { Type.Typeof.argument; comments = Flow_ast_utils.mk_comments_opt ~leading () }) + env + + and primary env = + let loc = Peek.loc env in + match Peek.token env with + | T_MULT -> + let leading = Peek.comments env in + Expect.token env T_MULT; + let trailing = Eat.trailing_comments env in + (loc, Type.Exists (Flow_ast_utils.mk_comments_opt ~leading ~trailing ())) + | T_LESS_THAN -> _function env + | T_LPAREN -> function_or_group env + | T_LCURLY + | T_LCURLYBAR -> + let (loc, o) = _object env ~is_class:false ~allow_exact:true ~allow_spread:true in + (loc, Type.Object o) + | T_INTERFACE -> + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_INTERFACE; + let (extends, body) = interface_helper env in + Type.Interface + { Type.Interface.extends; body; comments = Flow_ast_utils.mk_comments_opt ~leading () }) + env + | T_TYPEOF -> typeof env + | T_LBRACKET -> tuple env + | T_IDENTIFIER _ + | T_STATIC (* `static` is reserved in strict mode, but still an identifier *) -> + let (loc, g) = generic env in + (loc, Type.Generic g) + | T_STRING (loc, value, raw, octal) -> + if octal then strict_error env Parse_error.StrictOctalLiteral; + let leading = Peek.comments env in + Expect.token env (T_STRING (loc, value, raw, octal)); + let trailing = Eat.trailing_comments env in + ( loc, + Type.StringLiteral + { + Ast.StringLiteral.value; + raw; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + | T_NUMBER_SINGLETON_TYPE { kind; value; raw } -> + let leading = Peek.comments env in + Expect.token env (T_NUMBER_SINGLETON_TYPE { kind; value; raw }); + let trailing = Eat.trailing_comments env in + if kind = LEGACY_OCTAL then strict_error env Parse_error.StrictOctalLiteral; + ( loc, + Type.NumberLiteral + { + Ast.NumberLiteral.value; + raw; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + | T_BIGINT_SINGLETON_TYPE { kind; approx_value; raw } -> + let bigint = raw in + let leading = Peek.comments env in + Expect.token env (T_BIGINT_SINGLETON_TYPE { kind; approx_value; raw }); + let trailing = Eat.trailing_comments env in + ( loc, + Type.BigIntLiteral + { + Ast.BigIntLiteral.approx_value; + bigint; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + | (T_TRUE | T_FALSE) as token -> + let leading = Peek.comments env in + Expect.token env token; + let trailing = Eat.trailing_comments env in + let value = token = T_TRUE in + ( loc, + Type.BooleanLiteral + { BooleanLiteral.value; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) + | _ -> + (match primitive env with + | Some t -> (loc, t) + | None -> + error_unexpected env; + (loc, Type.Any None)) + + and is_primitive = function + | T_ANY_TYPE + | T_MIXED_TYPE + | T_EMPTY_TYPE + | T_BOOLEAN_TYPE _ + | T_NUMBER_TYPE + | T_BIGINT_TYPE + | T_STRING_TYPE + | T_SYMBOL_TYPE + | T_VOID_TYPE + | T_NULL -> + true + | _ -> false + + and primitive env = + let leading = Peek.comments env in + let token = Peek.token env in + match token with + | T_ANY_TYPE -> + Eat.token env; + let trailing = Eat.trailing_comments env in + Some (Type.Any (Flow_ast_utils.mk_comments_opt ~leading ~trailing ())) + | T_MIXED_TYPE -> + Eat.token env; + let trailing = Eat.trailing_comments env in + Some (Type.Mixed (Flow_ast_utils.mk_comments_opt ~leading ~trailing ())) + | T_EMPTY_TYPE -> + Eat.token env; + let trailing = Eat.trailing_comments env in + Some (Type.Empty (Flow_ast_utils.mk_comments_opt ~leading ~trailing ())) + | T_BOOLEAN_TYPE _ -> + Eat.token env; + let trailing = Eat.trailing_comments env in + Some (Type.Boolean (Flow_ast_utils.mk_comments_opt ~leading ~trailing ())) + | T_NUMBER_TYPE -> + Eat.token env; + let trailing = Eat.trailing_comments env in + Some (Type.Number (Flow_ast_utils.mk_comments_opt ~leading ~trailing ())) + | T_BIGINT_TYPE -> + Eat.token env; + let trailing = Eat.trailing_comments env in + Some (Type.BigInt (Flow_ast_utils.mk_comments_opt ~leading ~trailing ())) + | T_STRING_TYPE -> + Eat.token env; + let trailing = Eat.trailing_comments env in + Some (Type.String (Flow_ast_utils.mk_comments_opt ~leading ~trailing ())) + | T_SYMBOL_TYPE -> + Eat.token env; + let trailing = Eat.trailing_comments env in + Some (Type.Symbol (Flow_ast_utils.mk_comments_opt ~leading ~trailing ())) + | T_VOID_TYPE -> + Eat.token env; + let trailing = Eat.trailing_comments env in + Some (Type.Void (Flow_ast_utils.mk_comments_opt ~leading ~trailing ())) + | T_NULL -> + Eat.token env; + let trailing = Eat.trailing_comments env in + Some (Type.Null (Flow_ast_utils.mk_comments_opt ~leading ~trailing ())) + | _ -> None + + and tuple = + let rec types env acc = + match Peek.token env with + | T_EOF + | T_RBRACKET -> + List.rev acc + | _ -> + let acc = _type env :: acc in + (* Trailing comma support (like [number, string,]) *) + if Peek.token env <> T_RBRACKET then Expect.token env T_COMMA; + types env acc + in + fun env -> + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_LBRACKET; + let tl = types (with_no_anon_function_type false env) [] in + Expect.token env T_RBRACKET; + let trailing = Eat.trailing_comments env in + Type.Tuple + { + Type.Tuple.types = tl; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + }) + env + + and anonymous_function_param _env annot = + (fst annot, Type.Function.Param.{ name = None; annot; optional = false }) + + and function_param_with_id env = + with_loc + (fun env -> + Eat.push_lex_mode env Lex_mode.NORMAL; + let name = Parse.identifier env in + Eat.pop_lex_mode env; + if not (should_parse_types env) then error env Parse_error.UnexpectedTypeAnnotation; + let optional = Eat.maybe env T_PLING in + Expect.token env T_COLON; + let annot = _type env in + { Type.Function.Param.name = Some name; annot; optional }) + env + + and function_param_list_without_parens = + let param env = + match Peek.ith_token ~i:1 env with + | T_COLON + | T_PLING -> + function_param_with_id env + | _ -> + let annot = _type env in + anonymous_function_param env annot + in + let rec param_list env this_ acc = + match Peek.token env with + | (T_EOF | T_ELLIPSIS | T_RPAREN) as t -> + let rest = + if t = T_ELLIPSIS then + let rest = + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_ELLIPSIS; + { + Type.Function.RestParam.argument = param env; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + }) + env + in + Some rest + else + None + in + { Ast.Type.Function.Params.params = List.rev acc; rest; this_; comments = None } + | T_IDENTIFIER { raw = "this"; _ } + when Peek.ith_token ~i:1 env == T_COLON || Peek.ith_token ~i:1 env == T_PLING -> + if this_ <> None || acc <> [] then error env Parse_error.ThisParamMustBeFirst; + let this_ = + with_loc + (fun env -> + let leading = Peek.comments env in + Eat.token env; + if Peek.token env == T_PLING then error env Parse_error.ThisParamMayNotBeOptional; + { + Type.Function.ThisParam.annot = annotation env; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + }) + env + in + if Peek.token env <> T_RPAREN then Expect.token env T_COMMA; + param_list env (Some this_) acc + | _ -> + let acc = param env :: acc in + if Peek.token env <> T_RPAREN then Expect.token env T_COMMA; + param_list env this_ acc + in + (fun env -> param_list env None) + + and function_param_list env = + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_LPAREN; + let params = function_param_list_without_parens env [] in + let internal = Peek.comments env in + Expect.token env T_RPAREN; + let trailing = Eat.trailing_comments env in + { + params with + Ast.Type.Function.Params.comments = + Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal (); + }) + env + + and param_list_or_type env = + let leading = Peek.comments env in + Expect.token env T_LPAREN; + let ret = + let env = with_no_anon_function_type false env in + match Peek.token env with + | T_EOF + | T_ELLIPSIS -> + (* (... is definitely the beginning of a param list *) + ParamList (function_param_list_without_parens env []) + | T_RPAREN -> + (* () or is definitely a param list *) + ParamList + { Ast.Type.Function.Params.this_ = None; params = []; rest = None; comments = None } + | T_IDENTIFIER _ + | T_STATIC (* `static` is reserved in strict mode, but still an identifier *) -> + (* This could be a function parameter or a generic type *) + function_param_or_generic_type env + | token when is_primitive token -> + (* Don't know if this is (number) or (number: number). The first + * is a type, the second is a param. *) + (match Peek.ith_token ~i:1 env with + | T_PLING + | T_COLON -> + (* Ok this is definitely a parameter *) + ParamList (function_param_list_without_parens env []) + | _ -> Type (_type env)) + | _ -> + (* All params start with an identifier or `...` *) + Type (_type env) + in + (* Now that we allow anonymous parameters in function types, we need to + * disambiguate a little bit more *) + let ret = + match ret with + | ParamList _ -> ret + | Type _ when no_anon_function_type env -> ret + | Type t -> + (match Peek.token env with + | T_RPAREN -> + (* Reinterpret `(type) =>` as a ParamList *) + if Peek.ith_token ~i:1 env = T_ARROW then + let param = anonymous_function_param env t in + ParamList (function_param_list_without_parens env [param]) + else + Type t + | T_COMMA -> + (* Reinterpret `(type,` as a ParamList *) + Expect.token env T_COMMA; + let param = anonymous_function_param env t in + ParamList (function_param_list_without_parens env [param]) + | _ -> ret) + in + let internal = Peek.comments env in + Expect.token env T_RPAREN; + let trailing = Eat.trailing_comments env in + let ret = + match ret with + | ParamList params -> + ParamList + { + params with + Ast.Type.Function.Params.comments = + Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal (); + } + | Type t -> Type (add_comments t leading trailing) + in + ret + + and function_param_or_generic_type env = + match Peek.ith_token ~i:1 env with + | T_PLING + (* optional param *) + | T_COLON -> + ParamList (function_param_list_without_parens env []) + | _ -> + let id = type_identifier env in + Type + (generic_type_with_identifier env id + |> postfix_with env + |> anon_function_without_parens_with env + |> intersection_with env + |> union_with env + ) + + and function_or_group env = + let start_loc = Peek.loc env in + match with_loc param_list_or_type env with + | (loc, ParamList params) -> function_with_params env start_loc None (loc, params) + | (_, Type _type) -> _type + + and _function env = + let start_loc = Peek.loc env in + let tparams = type_params_remove_trailing env (type_params env) in + let params = function_param_list env in + function_with_params env start_loc tparams params + + and function_with_params env start_loc tparams (params : (Loc.t, Loc.t) Ast.Type.Function.Params.t) + = + with_loc + ~start_loc + (fun env -> + Expect.token env T_ARROW; + let return = _type env in + Type.(Function { Function.params; return; tparams; comments = None })) + env + + and _object = + let methodish env start_loc tparams = + with_loc + ~start_loc + (fun env -> + let params = function_param_list env in + Expect.token env T_COLON; + let return = _type env in + { Type.Function.params; return; tparams; comments = None }) + env + in + let method_property env start_loc static key ~leading = + let key = object_key_remove_trailing env key in + let tparams = type_params_remove_trailing env (type_params env) in + let value = methodish env start_loc tparams in + let value = (fst value, Type.Function (snd value)) in + Type.Object.( + Property + ( fst value, + { + Property.key; + value = Property.Init value; + optional = false; + static = static <> None; + proto = false; + _method = true; + variance = None; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + ) + in + let call_property env start_loc static ~leading = + let prop = + with_loc + ~start_loc + (fun env -> + let start_loc = Peek.loc env in + let tparams = type_params_remove_trailing env (type_params env) in + let value = methodish env start_loc tparams in + Type.Object.CallProperty. + { + value; + static = static <> None; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + env + in + Type.Object.CallProperty prop + in + let init_property env start_loc ~variance ~static ~proto ~leading key = + ignore proto; + if not (should_parse_types env) then error env Parse_error.UnexpectedTypeAnnotation; + let prop = + with_loc + ~start_loc + (fun env -> + let optional = Eat.maybe env T_PLING in + Expect.token env T_COLON; + let value = _type env in + Type.Object.Property. + { + key; + value = Init value; + optional; + static = static <> None; + proto = proto <> None; + _method = false; + variance; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + env + in + Type.Object.Property prop + in + let getter_or_setter ~is_getter ~leading env start_loc static key = + let prop = + with_loc + ~start_loc + (fun env -> + let (key_loc, key) = key in + let key = object_key_remove_trailing env key in + let value = methodish env start_loc None in + let (_, { Type.Function.params; _ }) = value in + begin + match (is_getter, params) with + | (true, (_, { Type.Function.Params.this_ = Some _; _ })) -> + error_at env (key_loc, Parse_error.GetterMayNotHaveThisParam) + | (false, (_, { Type.Function.Params.this_ = Some _; _ })) -> + error_at env (key_loc, Parse_error.SetterMayNotHaveThisParam) + | ( true, + (_, { Type.Function.Params.params = []; rest = None; this_ = None; comments = _ }) + ) -> + () + | (false, (_, { Type.Function.Params.rest = Some _; _ })) -> + (* rest params don't make sense on a setter *) + error_at env (key_loc, Parse_error.SetterArity) + | (false, (_, { Type.Function.Params.params = [_]; _ })) -> () + | (true, _) -> error_at env (key_loc, Parse_error.GetterArity) + | (false, _) -> error_at env (key_loc, Parse_error.SetterArity) + end; + Type.Object.Property. + { + key; + value = + ( if is_getter then + Get value + else + Set value + ); + optional = false; + static = static <> None; + proto = false; + _method = false; + variance = None; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + } + ) + env + in + Type.Object.Property prop + in + let indexer_property env start_loc static variance ~leading = + let indexer = + with_loc + ~start_loc + (fun env -> + let leading = leading @ Peek.comments env in + Expect.token env T_LBRACKET; + let id = + if Peek.ith_token ~i:1 env = T_COLON then ( + let id = identifier_name env in + Expect.token env T_COLON; + Some id + ) else + None + in + let key = _type env in + Expect.token env T_RBRACKET; + let trailing = Eat.trailing_comments env in + Expect.token env T_COLON; + let value = _type env in + { + Type.Object.Indexer.id; + key; + value; + static = static <> None; + variance; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + }) + env + in + Type.Object.Indexer indexer + in + let internal_slot env start_loc static ~leading = + let islot = + with_loc + ~start_loc + (fun env -> + let leading = leading @ Peek.comments env in + Expect.token env T_LBRACKET; + Expect.token env T_LBRACKET; + let id = identifier_name env in + Expect.token env T_RBRACKET; + Expect.token env T_RBRACKET; + let (optional, _method, value, trailing) = + match Peek.token env with + | T_LESS_THAN + | T_LPAREN -> + let tparams = type_params_remove_trailing env (type_params env) in + let value = + let (fn_loc, fn) = methodish env start_loc tparams in + (fn_loc, Type.Function fn) + in + (false, true, value, []) + | _ -> + let optional = Eat.maybe env T_PLING in + let trailing = Eat.trailing_comments env in + Expect.token env T_COLON; + let value = _type env in + (optional, false, value, trailing) + in + { + Type.Object.InternalSlot.id; + value; + optional; + static = static <> None; + _method; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + }) + env + in + Type.Object.InternalSlot islot + (* Expects the T_ELLIPSIS has already been eaten *) + in + let spread_property env start_loc ~leading = + let spread = + with_loc + ~start_loc + (fun env -> + { + Type.Object.SpreadProperty.argument = _type env; + comments = Flow_ast_utils.mk_comments_opt ~leading (); + }) + env + in + Type.Object.SpreadProperty spread + in + let semicolon exact env = + match Peek.token env with + | T_COMMA + | T_SEMICOLON -> + Eat.token env + | T_RCURLYBAR when exact -> () + | T_RCURLY when not exact -> () + | _ -> error_unexpected env + in + let error_unexpected_variance env = function + | Some (loc, _) -> error_at env (loc, Parse_error.UnexpectedVariance) + | None -> () + in + let error_unexpected_proto env = function + | Some loc -> error_at env (loc, Parse_error.UnexpectedProto) + | None -> () + in + let error_invalid_property_name env is_class static key = + let is_static = static <> None in + let is_constructor = String.equal "constructor" in + let is_prototype = String.equal "prototype" in + match key with + | Expression.Object.Property.Identifier (loc, { Identifier.name; comments = _ }) + when is_class && (is_constructor name || (is_static && is_prototype name)) -> + error_at + env + ( loc, + Parse_error.InvalidClassMemberName + { name; static = is_static; method_ = false; private_ = false } + ) + | _ -> () + in + let rec properties + ~is_class ~allow_inexact ~allow_spread ~exact env ((props, inexact, internal) as acc) = + (* no `static ...A` *) + assert (not (is_class && allow_spread)); + + (* allow_inexact implies allow_spread *) + assert ((not allow_inexact) || allow_spread); + + let start_loc = Peek.loc env in + match Peek.token env with + | T_EOF -> (List.rev props, inexact, internal) + | T_RCURLYBAR when exact -> (List.rev props, inexact, internal) + | T_RCURLY when not exact -> (List.rev props, inexact, internal) + | T_ELLIPSIS when allow_spread -> + let leading = Peek.comments env in + Eat.token env; + begin + match Peek.token env with + | T_COMMA + | T_SEMICOLON + | T_RCURLY + | T_RCURLYBAR -> + semicolon exact env; + begin + match Peek.token env with + | T_RCURLY when allow_inexact -> (List.rev props, true, leading) + | T_RCURLYBAR -> + error_at env (start_loc, Parse_error.InexactInsideExact); + (List.rev props, inexact, internal) + | _ -> + error_at env (start_loc, Parse_error.UnexpectedExplicitInexactInObject); + properties ~is_class ~allow_inexact ~allow_spread ~exact env acc + end + | _ -> + let prop = spread_property env start_loc leading in + semicolon exact env; + properties + ~is_class + ~allow_inexact + ~allow_spread + ~exact + env + (prop :: props, inexact, internal) + end + (* In this case, allow_spread is false, so we may assume allow_inexact is false based on our + * assertion at the top of this function. Thus, any T_ELLIPSIS here is not allowed. + *) + | T_ELLIPSIS -> + Eat.token env; + begin + match Peek.token env with + | T_COMMA + | T_SEMICOLON + | T_RCURLY + | T_RCURLYBAR -> + error_at env (start_loc, Parse_error.InexactInsideNonObject); + semicolon exact env; + properties ~is_class ~allow_inexact ~allow_spread ~exact env acc + | _ -> + error_list env (Peek.errors env); + error_at env (start_loc, Parse_error.UnexpectedSpreadType); + + (* It's likely the user is trying to spread something here, so we can + * eat what they try to spread to try to continue parsing the remaining + * properties. + *) + Eat.token env; + semicolon exact env; + properties ~is_class ~allow_inexact ~allow_spread ~exact env acc + end + | _ -> + let prop = + property + env + start_loc + ~is_class + ~allow_static:is_class + ~allow_proto:is_class + ~variance:None + ~static:None + ~proto:None + ~leading:[] + in + semicolon exact env; + properties + ~is_class + ~allow_inexact + ~allow_spread + ~exact + env + (prop :: props, inexact, internal) + and property + env ~is_class ~allow_static ~allow_proto ~variance ~static ~proto ~leading start_loc = + match Peek.token env with + | T_PLUS + | T_MINUS + when variance = None -> + let variance = maybe_variance env in + property + env + ~is_class + ~allow_static:false + ~allow_proto:false + ~variance + ~static + ~proto + ~leading + start_loc + | T_STATIC when allow_static -> + assert (variance = None); + + (* if we parsed variance, allow_static = false *) + let static = Some (Peek.loc env) in + let leading = leading @ Peek.comments env in + Eat.token env; + property + env + ~is_class + ~allow_static:false + ~allow_proto:false + ~variance + ~static + ~proto + ~leading + start_loc + | T_IDENTIFIER { raw = "proto"; _ } when allow_proto -> + assert (variance = None); + + (* if we parsed variance, allow_proto = false *) + let proto = Some (Peek.loc env) in + let leading = leading @ Peek.comments env in + Eat.token env; + property + env + ~is_class + ~allow_static:false + ~allow_proto:false + ~variance + ~static + ~proto + ~leading + start_loc + | T_LBRACKET -> + error_unexpected_proto env proto; + (match Peek.ith_token ~i:1 env with + | T_LBRACKET -> + error_unexpected_variance env variance; + internal_slot env start_loc static ~leading + | _ -> indexer_property env start_loc static variance ~leading) + | T_LESS_THAN + | T_LPAREN -> + (* Note that `static(): void` is a static callable property if we + successfully parsed the static modifier above. *) + error_unexpected_proto env proto; + error_unexpected_variance env variance; + call_property env start_loc static ~leading + | token -> + (match (static, proto, token) with + | (Some _, Some _, _) -> failwith "Can not have both `static` and `proto`" + | (Some static_loc, None, (T_PLING | T_COLON)) -> + (* We speculatively parsed `static` as a static modifier, but now + that we've parsed the next token, we changed our minds and want + to parse `static` as the key of a named property. *) + let key = + Expression.Object.Property.Identifier + (Flow_ast_utils.ident_of_source + (static_loc, "static") + ?comments:(Flow_ast_utils.mk_comments_opt ~leading ()) + ) + in + let static = None in + init_property env start_loc ~variance ~static ~proto ~leading:[] key + | (None, Some proto_loc, (T_PLING | T_COLON)) -> + (* We speculatively parsed `proto` as a proto modifier, but now + that we've parsed the next token, we changed our minds and want + to parse `proto` as the key of a named property. *) + let key = + Expression.Object.Property.Identifier + (Flow_ast_utils.ident_of_source + (proto_loc, "proto") + ?comments:(Flow_ast_utils.mk_comments_opt ~leading ()) + ) + in + let proto = None in + init_property env start_loc ~variance ~static ~proto ~leading:[] key + | _ -> + let object_key env = + Eat.push_lex_mode env Lex_mode.NORMAL; + let result = Parse.object_key env in + Eat.pop_lex_mode env; + result + in + let leading_key = Peek.comments env in + (match object_key env with + | ( _, + ( Expression.Object.Property.Identifier + (_, { Identifier.name = ("get" | "set") as name; comments = _ }) as key + ) + ) -> + begin + match Peek.token env with + | T_LESS_THAN + | T_LPAREN -> + error_unexpected_proto env proto; + error_unexpected_variance env variance; + method_property env start_loc static key leading + | T_COLON + | T_PLING -> + init_property env start_loc ~variance ~static ~proto ~leading key + | _ -> + ignore (object_key_remove_trailing env key); + let key = object_key env in + let is_getter = name = "get" in + let leading = leading @ leading_key in + error_unexpected_proto env proto; + error_unexpected_variance env variance; + getter_or_setter ~is_getter ~leading env start_loc static key + end + | (_, key) -> + begin + match Peek.token env with + | T_LESS_THAN + | T_LPAREN -> + error_unexpected_proto env proto; + error_unexpected_variance env variance; + method_property env start_loc static key leading + | _ -> + error_invalid_property_name env is_class static key; + init_property env start_loc ~variance ~static ~proto ~leading key + end)) + in + fun ~is_class ~allow_exact ~allow_spread env -> + let exact = allow_exact && Peek.token env = T_LCURLYBAR in + let allow_inexact = allow_exact && not exact in + with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token + env + ( if exact then + T_LCURLYBAR + else + T_LCURLY + ); + let (properties, inexact, internal) = + let env = with_no_anon_function_type false env in + properties ~is_class ~allow_inexact ~exact ~allow_spread env ([], false, []) + in + let internal = internal @ Peek.comments env in + Expect.token + env + ( if exact then + T_RCURLYBAR + else + T_RCURLY + ); + let trailing = Eat.trailing_comments env in + + (* inexact = true iff `...` was used to indicate inexactnes *) + { + Type.Object.exact; + properties; + inexact; + comments = Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal (); + }) + env + + and interface_helper = + let rec supers env acc = + let super = generic env in + let acc = super :: acc in + match Peek.token env with + | T_COMMA -> + Expect.token env T_COMMA; + supers env acc + | _ -> List.rev acc + in + fun env -> + let extends = + if Peek.token env = T_EXTENDS then ( + Expect.token env T_EXTENDS; + let extends = supers env [] in + generic_type_list_remove_trailing env extends + ) else + [] + in + let body = _object env ~allow_exact:false ~allow_spread:false ~is_class:false in + (extends, body) + + and type_identifier env = + let (loc, { Identifier.name; comments }) = identifier_name env in + if is_reserved_type name then error_at env (loc, Parse_error.UnexpectedReservedType); + (loc, { Identifier.name; comments }) + + and bounded_type env = + with_loc + (fun env -> + let name = type_identifier env in + let bound = + if Peek.token env = T_COLON then + Ast.Type.Available (annotation env) + else + Ast.Type.Missing (Peek.loc_skip_lookahead env) + in + (name, bound)) + env + + and type_params = + let rec params env ~require_default acc = + Type.TypeParam.( + let (loc, (variance, name, bound, default, require_default)) = + with_loc + (fun env -> + let variance = maybe_variance env in + let (loc, (name, bound)) = bounded_type env in + let (default, require_default) = + match Peek.token env with + | T_ASSIGN -> + Eat.token env; + (Some (_type env), true) + | _ -> + if require_default then error_at env (loc, Parse_error.MissingTypeParamDefault); + (None, require_default) + in + (variance, name, bound, default, require_default)) + env + in + let param = (loc, { name; bound; variance; default }) in + let acc = param :: acc in + match Peek.token env with + | T_EOF + | T_GREATER_THAN -> + List.rev acc + | _ -> + Expect.token env T_COMMA; + if Peek.token env = T_GREATER_THAN then + List.rev acc + else + params env ~require_default acc + ) + in + fun env -> + if Peek.token env = T_LESS_THAN then ( + if not (should_parse_types env) then error env Parse_error.UnexpectedTypeAnnotation; + Some + (with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_LESS_THAN; + let params = params env ~require_default:false [] in + let internal = Peek.comments env in + Expect.token env T_GREATER_THAN; + let trailing = Eat.trailing_comments env in + { + Type.TypeParams.params; + comments = + Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal (); + }) + env + ) + ) else + None + + and type_args = + let rec args env acc = + match Peek.token env with + | T_EOF + | T_GREATER_THAN -> + List.rev acc + | _ -> + let acc = _type env :: acc in + if Peek.token env <> T_GREATER_THAN then Expect.token env T_COMMA; + args env acc + in + fun env -> + if Peek.token env = T_LESS_THAN then + Some + (with_loc + (fun env -> + let leading = Peek.comments env in + Expect.token env T_LESS_THAN; + let env = with_no_anon_function_type false env in + let arguments = args env [] in + let internal = Peek.comments env in + Expect.token env T_GREATER_THAN; + let trailing = Eat.trailing_comments env in + { + Type.TypeArgs.arguments; + comments = + Flow_ast_utils.mk_comments_with_internal_opt ~leading ~trailing ~internal (); + }) + env + ) + else + None + + and generic env = raw_generic_with_identifier env (type_identifier env) + + and raw_generic_with_identifier = + let rec identifier env (q_loc, qualification) = + if Peek.token env = T_PERIOD && Peek.ith_is_type_identifier ~i:1 env then + let (loc, q) = + with_loc + ~start_loc:q_loc + (fun env -> + Expect.token env T_PERIOD; + let id = type_identifier env in + { Type.Generic.Identifier.qualification; id }) + env + in + let qualification = Type.Generic.Identifier.Qualified (loc, q) in + identifier env (loc, qualification) + else + (q_loc, qualification) + in + fun env id -> + with_loc + ~start_loc:(fst id) + (fun env -> + let id = (fst id, Type.Generic.Identifier.Unqualified id) in + let id = + let (_id_loc, id) = identifier env id in + if Peek.token env <> T_LESS_THAN then + id + else + let { remove_trailing; _ } = trailing_and_remover env in + remove_trailing id (fun remover id -> remover#generic_identifier_type id) + in + let targs = type_args env in + { Type.Generic.id; targs; comments = None }) + env + + and generic_type_with_identifier env id = + let (loc, generic) = raw_generic_with_identifier env id in + (loc, Type.Generic generic) + + and annotation_opt env = + match Peek.token env with + | T_COLON -> Type.Available (annotation env) + | _ -> Type.Missing (Peek.loc_skip_lookahead env) + + and add_comments (loc, t) leading trailing = + let merge_comments inner = + Flow_ast_utils.merge_comments + ~inner + ~outer:(Flow_ast_utils.mk_comments_opt ~leading ~trailing ()) + in + let merge_comments_with_internal inner = + Flow_ast_utils.merge_comments_with_internal + ~inner + ~outer:(Flow_ast_utils.mk_comments_opt ~leading ~trailing ()) + in + let open Ast.Type in + ( loc, + match t with + | Any comments -> Any (merge_comments comments) + | Mixed comments -> Mixed (merge_comments comments) + | Empty comments -> Empty (merge_comments comments) + | Void comments -> Void (merge_comments comments) + | Null comments -> Null (merge_comments comments) + | Number comments -> Number (merge_comments comments) + | BigInt comments -> BigInt (merge_comments comments) + | String comments -> String (merge_comments comments) + | Boolean comments -> Boolean (merge_comments comments) + | Symbol comments -> Symbol (merge_comments comments) + | Exists comments -> Exists (merge_comments comments) + | Nullable ({ Nullable.comments; _ } as t) -> + Nullable { t with Nullable.comments = merge_comments comments } + | Function ({ Function.comments; _ } as t) -> + Function { t with Function.comments = merge_comments comments } + | Object ({ Object.comments; _ } as t) -> + Object { t with Object.comments = merge_comments_with_internal comments } + | Interface ({ Interface.comments; _ } as t) -> + Interface { t with Interface.comments = merge_comments comments } + | Array ({ Array.comments; _ } as t) -> + Array { t with Array.comments = merge_comments comments } + | Generic ({ Generic.comments; _ } as t) -> + Generic { t with Generic.comments = merge_comments comments } + | IndexedAccess ({ IndexedAccess.comments; _ } as t) -> + IndexedAccess { t with IndexedAccess.comments = merge_comments comments } + | OptionalIndexedAccess + { + OptionalIndexedAccess.indexed_access = { IndexedAccess.comments; _ } as indexed_access; + optional; + } -> + OptionalIndexedAccess + { + OptionalIndexedAccess.indexed_access = + { indexed_access with IndexedAccess.comments = merge_comments comments }; + optional; + } + | Union ({ Union.comments; _ } as t) -> + Union { t with Union.comments = merge_comments comments } + | Intersection ({ Intersection.comments; _ } as t) -> + Intersection { t with Intersection.comments = merge_comments comments } + | Typeof ({ Typeof.comments; _ } as t) -> + Typeof { t with Typeof.comments = merge_comments comments } + | Tuple ({ Tuple.comments; _ } as t) -> + Tuple { t with Tuple.comments = merge_comments comments } + | StringLiteral ({ StringLiteral.comments; _ } as t) -> + StringLiteral { t with StringLiteral.comments = merge_comments comments } + | NumberLiteral ({ NumberLiteral.comments; _ } as t) -> + NumberLiteral { t with NumberLiteral.comments = merge_comments comments } + | BigIntLiteral ({ BigIntLiteral.comments; _ } as t) -> + BigIntLiteral { t with BigIntLiteral.comments = merge_comments comments } + | BooleanLiteral ({ BooleanLiteral.comments; _ } as t) -> + BooleanLiteral { t with BooleanLiteral.comments = merge_comments comments } + ) + + let predicate = + with_loc (fun env -> + let open Ast.Type.Predicate in + let leading = Peek.comments env in + Expect.token env T_CHECKS; + if Peek.token env = T_LPAREN then ( + let leading = leading @ Peek.comments env in + Expect.token env T_LPAREN; + Eat.push_lex_mode env Lex_mode.NORMAL; + let exp = Parse.conditional env in + Eat.pop_lex_mode env; + Expect.token env T_RPAREN; + let trailing = Eat.trailing_comments env in + { kind = Declared exp; comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing () } + ) else + let trailing = Eat.trailing_comments env in + { + kind = Ast.Type.Predicate.Inferred; + comments = Flow_ast_utils.mk_comments_opt ~leading ~trailing (); + } + ) + + let predicate_opt env = + let env = with_no_anon_function_type false env in + match Peek.token env with + | T_CHECKS -> Some (predicate env) + | _ -> None + + let annotation_and_predicate_opt env = + let open Ast.Type in + match (Peek.token env, Peek.ith_token ~i:1 env) with + | (T_COLON, T_CHECKS) -> + Expect.token env T_COLON; + (Missing (Peek.loc_skip_lookahead env), predicate_opt env) + | (T_COLON, _) -> + let annotation = + let annotation = annotation_opt env in + if Peek.token env = T_CHECKS then + type_annotation_hint_remove_trailing env annotation + else + annotation + in + let predicate = predicate_opt env in + (annotation, predicate) + | _ -> (Missing (Peek.loc_skip_lookahead env), None) + + let wrap f env = + let env = env |> with_strict true in + Eat.push_lex_mode env Lex_mode.TYPE; + let ret = f env in + Eat.pop_lex_mode env; + ret + + let _type = wrap _type + + let type_identifier = wrap type_identifier + + let type_params = wrap type_params + + let type_args = wrap type_args + + let _object ~is_class env = wrap (_object ~is_class ~allow_exact:false ~allow_spread:false) env + + let interface_helper = wrap interface_helper + + let function_param_list = wrap function_param_list + + let annotation = wrap annotation + + let annotation_opt = wrap annotation_opt + + let predicate_opt = wrap predicate_opt + + let annotation_and_predicate_opt = wrap annotation_and_predicate_opt + + let generic = wrap generic +end diff --git a/flow/parser/wtf8.ml b/flow/parser/wtf8.ml new file mode 100644 index 0000000000..be7d3718fd --- /dev/null +++ b/flow/parser/wtf8.ml @@ -0,0 +1,103 @@ +(** + * Copyright (c) 2017-present, Facebook, Inc. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +(* + * WTF-8 is a superset of UTF-8 that allows unpaired surrogates. + * + * From ES6 6.1.4, "The String Type": + * + * Where ECMAScript operations interpret String values, each element is + * interpreted as a single UTF-16 code unit. However, ECMAScript does not + * place any restrictions or requirements on the sequence of code units in + * a String value, so they may be ill-formed when interpreted as UTF-16 code + * unit sequences. Operations that do not interpret String contents treat + * them as sequences of undifferentiated 16-bit unsigned integers. + * + * If we try to encode these ill-formed code units into UTF-8, we similarly + * get ill-formed UTF-8. WTF-8 is a fun name for that encoding. + * + * https://simonsapin.github.io/wtf-8/ + *) + +type codepoint = + | Point of int + | Malformed + +type 'a folder = 'a -> int -> codepoint -> 'a + +(* WTF-8 is a variable length encoding. The first byte in each codepoint + determines how many other bytes follow. *) +let needed_bytes c = + if 0x00 <= c && c <= 0x7F then 1 else + if 0xC2 <= c && c <= 0xDF then 2 else + if 0xE0 <= c && c <= 0xEF then 3 else + if 0xF0 <= c && c <= 0xF4 then 4 else + 0 + +let unsafe_char s i = Char.code (Bytes.unsafe_get s i) + +let codepoint s i = function + | 1 -> unsafe_char s i + | 2 -> + let b0 = unsafe_char s i in + let b1 = unsafe_char s (i + 1) in + ((b0 land 0x1F) lsl 6) lor (b1 land 0x3F) + | 3 -> + let b0 = unsafe_char s (i) in + let b1 = unsafe_char s (i + 1) in + let b2 = unsafe_char s (i + 2) in + ((b0 land 0x0F) lsl 12) lor + ((b1 land 0x3F) lsl 6) lor + (b2 land 0x3F) + | 4 -> + let b0 = unsafe_char s (i) in + let b1 = unsafe_char s (i + 1) in + let b2 = unsafe_char s (i + 2) in + let b3 = unsafe_char s (i + 3) in + ((b0 land 0x07) lsl 18) lor + ((b1 land 0x3F) lsl 12) lor + ((b2 land 0x3F) lsl 6) lor + (b3 land 0x3F) + | _ -> assert false + +(* Fold over the WTF-8 code units in a string *) +let fold_wtf_8 ?(pos = 0) ?len f acc s = + let rec loop acc f s i l = + if i = l then acc else + let need = needed_bytes (unsafe_char s i) in + if need = 0 then (loop [@tailcall]) (f acc i Malformed) f s (i + 1) l else + let rem = l - i in + if rem < need then f acc i Malformed else + (loop [@tailcall]) (f acc i (Point (codepoint s i need))) f s (i + need) l + in + let len = match len with + | None -> String.length s - pos + | Some l -> l + in + loop acc f (Bytes.unsafe_of_string s) pos len + +(* Add a UTF-16 code unit to a buffer, encoded in WTF-8. *) +let add_wtf_8 buf code = + let[@inline] w byte = Buffer.add_char buf (Char.unsafe_chr byte) in + if code >= 0x10000 then begin + (* 4 bytes *) + w (0xf0 lor (code lsr 18)); + w (0x80 lor ((code lsr 12) land 0x3F)); + w (0x80 lor ((code lsr 6) land 0x3F)); + w (0x80 lor (code land 0x3F)) + end else if code >= 0x800 then begin + (* 3 bytes *) + w (0xe0 lor (code lsr 12)); + w (0x80 lor ((code lsr 6) land 0x3F)); + w (0x80 lor (code land 0x3F)) + end else if code >= 0x80 then begin + (* 2 bytes *) + w (0xc0 lor (code lsr 6)); + w (0x80 lor (code land 0x3F)) + end else + (* 1 byte *) + w code diff --git a/flow/parser/wtf8.mli b/flow/parser/wtf8.mli new file mode 100644 index 0000000000..1b4235b8e1 --- /dev/null +++ b/flow/parser/wtf8.mli @@ -0,0 +1,15 @@ +(** + * Copyright (c) 2017-present, Facebook, Inc. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +type codepoint = + | Point of int + | Malformed + +type 'a folder = 'a -> int -> codepoint -> 'a + +val fold_wtf_8 : ?pos:int -> ?len:int -> 'a folder -> 'a -> string -> 'a +val add_wtf_8 : Buffer.t -> int -> unit