move back to previous strategy

Since infix operators are weird constraints, scanner shouldn't touch it.

Therefore, the printer still needs to distinguish whether the given ident is infix-like or not.

Author: cometkim

jscomp/ext/ext_ident.ml

@@ -134,9 +134,11 @@ let [@inline] no_escape (c : char) =
 
 let is_exotic name =
   (* Exotic idents should always wrapped by \"..." *)
-  match String.unsafe_get name 0 with
-  | '\\' -> true
-  | _ -> false
+  let len = String.length name in
+  len >= 3
+  && String.unsafe_get name 0 = '\\'
+  && String.unsafe_get name 1 = '\"'
+  && String.unsafe_get name (len - 1) = '\"'
 
 let wrap_exotic name = "\\\"" ^ name ^ "\""
 

jscomp/stdlib-406/release.ninja

@@ -68,7 +68,7 @@ o stdlib-406/pervasivesU.cmj : cc_cmi stdlib-406/pervasivesU.res | stdlib-406/pe
 o stdlib-406/pervasivesU.cmi : cc stdlib-406/pervasivesU.resi | stdlib-406/pervasives.cmj $bsc others
 o stdlib-406/queue.cmj : cc_cmi stdlib-406/queue.res | stdlib-406/queue.cmi $bsc others
 o stdlib-406/queue.cmi : cc stdlib-406/queue.resi | stdlib-406/pervasives.cmj $bsc others
-o stdlib-406/random.cmj : cc_cmi stdlib-406/random.res | stdlib-406/array.cmj stdlib-406/char.cmj stdlib-406/digest.cmj stdlib-406/int32.cmj stdlib-406/int64.cmj stdlib-406/random.cmi $bsc others
+o stdlib-406/random.cmj : cc_cmi stdlib-406/random.res | stdlib-406/array.cmj stdlib-406/char.cmj stdlib-406/digest.cmj stdlib-406/int32.cmj stdlib-406/int64.cmj stdlib-406/random.cmi stdlib-406/string.cmj $bsc others
 o stdlib-406/random.cmi : cc stdlib-406/random.resi | stdlib-406/int32.cmi stdlib-406/int64.cmi stdlib-406/pervasives.cmj $bsc others
 o stdlib-406/set.cmj : cc_cmi stdlib-406/set.res | stdlib-406/list.cmj stdlib-406/set.cmi $bsc others
 o stdlib-406/set.cmi : cc stdlib-406/set.resi | stdlib-406/pervasives.cmj $bsc others

jscomp/syntax/src/res_ast_debugger.ml

@@ -54,7 +54,7 @@ module SexpAst = struct
     | [] -> [Sexp.list []]
     | items -> List.map f items
 
-  let string txt = Sexp.atom ("\"" ^ txt ^ "\"")
+  let string txt = Sexp.atom ("\"" ^ Ext_ident.unwrap_exotic txt ^ "\"")
 
   let char c = Sexp.atom ("'" ^ Char.escaped c ^ "'")
 
@@ -66,8 +66,7 @@ module SexpAst = struct
   let longident l =
     let rec loop l =
       match l with
-      | Longident.Lident ident ->
-        Sexp.list [Sexp.atom "Lident"; string (Ext_ident.unwrap_exotic ident)]
+      | Longident.Lident ident -> Sexp.list [Sexp.atom "Lident"; string ident]
       | Longident.Ldot (lident, txt) ->
         Sexp.list [Sexp.atom "Ldot"; loop lident; string txt]
       | Longident.Lapply (l1, l2) ->
@@ -602,7 +601,7 @@ module SexpAst = struct
         Sexp.list
           [
             Sexp.atom "Pexp_variant";
-            string (Ext_ident.unwrap_exotic lbl);
+            string lbl;
             (match exprOpt with
             | None -> Sexp.atom "None"
             | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr]);
@@ -761,7 +760,7 @@ module SexpAst = struct
         Sexp.list
           [
             Sexp.atom "Ppat_variant";
-            string (Ext_ident.unwrap_exotic lbl);
+            string lbl;
             (match optPattern with
             | None -> Sexp.atom "None"
             | Some p -> Sexp.list [Sexp.atom "Some"; pattern p]);
@@ -815,7 +814,7 @@ module SexpAst = struct
       Sexp.list
         [
           Sexp.atom "Rtag";
-          string (Ext_ident.unwrap_exotic labelLoc.txt);
+          string labelLoc.txt;
           attributes attrs;
           Sexp.atom (if truth then "true" else "false");
           Sexp.list (mapEmpty ~f:coreType types);

jscomp/syntax/src/res_core.ml

@@ -384,39 +384,20 @@ let buildLongident words =
   | hd :: tl -> List.fold_left (fun p s -> Longident.Ldot (p, s)) (Lident hd) tl
 
 let makeInfixOperator (p : Parser.t) token startPos endPos =
-  (* FIXME: why this always gonna be true???? *)
-  let isBinaryOp =
-    Lexing.(Scanner.isBinaryOp p.scanner.src startPos.pos_cnum endPos.pos_cnum)
-  in
   let stringifiedToken =
-    if isBinaryOp then
-      match token with
-      | Token.Minus ->
-        print_endline "@@@ binary";
-        Ext_ident.wrap_exotic "-"
-      | Token.PlusPlus -> Ext_ident.wrap_exotic "^"
-      | Token.BangEqual -> Ext_ident.wrap_exotic "<>"
-      | Token.BangEqualEqual -> Ext_ident.wrap_exotic "!="
-      | Token.Equal ->
-        (* TODO: could have a totally different meaning like x->fooSet(y)*)
-        Parser.err ~startPos ~endPos p
-          (Diagnostics.message "Did you mean `==` here?");
-        "="
-      | Token.EqualEqual -> Ext_ident.wrap_exotic "="
-      | Token.EqualEqualEqual -> Ext_ident.wrap_exotic "=="
-      | Token.GreaterThan -> Ext_ident.wrap_exotic ">"
-      | Token.LessThan -> Ext_ident.wrap_exotic "<"
-      | token -> Ext_ident.wrap_exotic (Token.toString token)
-    else
-      (* unary *)
-      match token with
-      | Token.Minus ->
-        print_endline "@@@ unary";
-        Ext_ident.wrap_exotic "~-"
-      | Token.MinusDot -> Ext_ident.wrap_exotic "~-."
-      | Token.MinusGreater when p.uncurried_config = Legacy -> "|."
-      | Token.MinusGreater -> "|.u"
-      | token -> Ext_ident.wrap_exotic (Token.toString token)
+    if token = Token.MinusGreater then
+      if p.uncurried_config = Legacy then "|." else "|.u"
+    else if token = Token.PlusPlus then "^"
+    else if token = Token.BangEqual then "<>"
+    else if token = Token.BangEqualEqual then "!="
+    else if token = Token.Equal then (
+      (* TODO: could have a totally different meaning like x->fooSet(y)*)
+      Parser.err ~startPos ~endPos p
+        (Diagnostics.message "Did you mean `==` here?");
+      "=")
+    else if token = Token.EqualEqual then "="
+    else if token = Token.EqualEqualEqual then "=="
+    else Token.toString token
   in
   let loc = mkLoc startPos endPos in
   let operator = Location.mkloc (Longident.Lident stringifiedToken) loc in

jscomp/syntax/src/res_printer.ml

@@ -376,11 +376,10 @@ let printLongident = function
   | Longident.Lident txt -> Doc.text txt
   | lid -> Doc.join ~sep:Doc.dot (printLongidentAux [] lid)
 
-type identifierStyle = ExoticLike | NormalIdent
+type polyVarIdentifierStyle = ExoticLike | NormalIdent
 
-let classifyIdentContent txt =
-  if Ext_ident.is_exotic txt then ExoticLike
-  else if Token.isKeywordTxt txt then ExoticLike
+let classifyPolyVarIdentContent txt =
+  if Token.isKeywordTxt txt then ExoticLike
   else
     let len = String.length txt in
     let rec loop i =
@@ -406,7 +405,7 @@ let for_all_from s start p =
   unsafe_for_all_range s ~start ~finish:(len - 1) p
 
 (* See https://github.com/rescript-lang/rescript-compiler/blob/726cfa534314b586e5b5734471bc2023ad99ebd9/jscomp/ext/ext_string.ml#L510 *)
-let isValidNumericPolyvarNumber (x : string) =
+let isValidNumericPolyVarNumber (x : string) =
   let len = String.length x in
   len > 0
   &&
@@ -423,12 +422,10 @@ let isValidNumericPolyvarNumber (x : string) =
 (* Exotic identifiers in poly-vars have a "lighter" syntax: #"ease-in" *)
 let printPolyVarIdent txt =
   (* numeric poly-vars don't need quotes: #644 *)
-  if isValidNumericPolyvarNumber txt then Doc.text txt
+  if isValidNumericPolyVarNumber txt then Doc.text txt
   else
-    match classifyIdentContent txt with
-    | ExoticLike ->
-      Doc.concat
-        [Doc.text "\""; Doc.text (Ext_ident.unwrap_exotic txt); Doc.text "\""]
+    match classifyPolyVarIdentContent txt with
+    | ExoticLike -> Doc.text ("\"" ^ Ext_ident.unwrap_exotic txt ^ "\"")
     | NormalIdent -> (
       match txt with
       | "" -> Doc.concat [Doc.text "\""; Doc.text txt; Doc.text "\""]
@@ -438,6 +435,10 @@ let polyVarIdentToString polyVarIdent =
   Doc.concat [Doc.text "#"; printPolyVarIdent polyVarIdent]
   |> Doc.toString ~width:80
 
+let printIdentPossiblyInfixOperator txt =
+  if Res_token.isInfixOperatorTxt txt then Doc.text (Ext_ident.wrap_exotic txt)
+  else Doc.text txt
+
 let printLident l =
   let flatLidOpt lid =
     let rec flat accu = function
@@ -448,14 +449,16 @@ let printLident l =
     flat [] lid
   in
   match l with
-  | Longident.Lident txt -> Doc.text txt
+  | Longident.Lident txt -> printIdentPossiblyInfixOperator txt
   | Longident.Ldot (path, txt) ->
     let doc =
       match flatLidOpt path with
       | Some txts ->
         Doc.concat
           [
-            Doc.join ~sep:Doc.dot (List.map Doc.text txts); Doc.dot; Doc.text txt;
+            Doc.join ~sep:Doc.dot (List.map Doc.text txts);
+            Doc.dot;
+            printIdentPossiblyInfixOperator txt;
           ]
       | None -> Doc.text "printLident: Longident.Lapply is not supported"
     in
@@ -1053,7 +1056,7 @@ and printValueDescription ~state valueDescription cmtTbl =
          attrs;
          Doc.text header;
          printComments
-           (Doc.text valueDescription.pval_name.txt)
+           (printIdentPossiblyInfixOperator valueDescription.pval_name.txt)
            cmtTbl valueDescription.pval_name.loc;
          Doc.text ": ";
          printTypExpr ~state valueDescription.pval_type cmtTbl;
@@ -2119,7 +2122,7 @@ and printPattern ~state (p : Parsetree.pattern) cmtTbl =
   let patternWithoutAttributes =
     match p.ppat_desc with
     | Ppat_any -> Doc.text "_"
-    | Ppat_var var -> Doc.text var.txt
+    | Ppat_var var -> printIdentPossiblyInfixOperator var.txt
     | Ppat_constant c ->
       let templateLiteral =
         ParsetreeViewer.hasTemplateLiteralAttr p.ppat_attributes
@@ -4421,16 +4424,15 @@ and printJsxProp ~state arg cmtTbl =
  * Navabar.createElement -> Navbar
  * Staff.Users.createElement -> Staff.Users *)
 and printJsxName {txt = lident} =
-  let printIdent = Doc.text in
   let rec flatten acc lident =
     match lident with
-    | Longident.Lident txt -> printIdent txt :: acc
+    | Longident.Lident txt -> Doc.text txt :: acc
     | Ldot (lident, "createElement") -> flatten acc lident
-    | Ldot (lident, txt) -> flatten (printIdent txt :: acc) lident
+    | Ldot (lident, txt) -> flatten (Doc.text txt :: acc) lident
     | _ -> acc
   in
   match lident with
-  | Longident.Lident txt -> printIdent txt
+  | Longident.Lident txt -> Doc.text txt
   | _ as lident ->
     let segments = flatten [] lident in
     Doc.join ~sep:Doc.dot segments
@@ -4987,7 +4989,7 @@ and printExpFunParameter ~state parameter cmtTbl =
           [
             printAttributes ~state ppat_attributes cmtTbl;
             Doc.text "~";
-            Doc.text lbl;
+            printIdentPossiblyInfixOperator lbl;
           ]
       | ( (Asttypes.Labelled lbl | Optional lbl),
           {
@@ -5000,7 +5002,7 @@ and printExpFunParameter ~state parameter cmtTbl =
           [
             printAttributes ~state ppat_attributes cmtTbl;
             Doc.text "~";
-            Doc.text lbl;
+            printIdentPossiblyInfixOperator lbl;
             Doc.text ": ";
             printTypExpr ~state typ cmtTbl;
           ]
@@ -5009,7 +5011,7 @@ and printExpFunParameter ~state parameter cmtTbl =
         Doc.concat
           [
             Doc.text "~";
-            Doc.text lbl;
+            printIdentPossiblyInfixOperator lbl;
             Doc.text " as ";
             printPattern ~state pattern cmtTbl;
           ]

jscomp/syntax/src/res_scanner.ml

@@ -329,7 +329,8 @@ let scanExoticIdentifier scanner =
         scanner.err ~startPos ~endPos
           (Diagnostics.message "A quoted identifier can't be empty string.")
     in
-    Token.Lident ident
+    if Res_token.isInfixOperatorTxt name then Token.Lident name
+    else Token.Lident ident
 
 let scanStringEscapeSequence ~startPos scanner =
   let scan ~n ~base ~max =

jscomp/syntax/src/res_token.ml

@@ -257,4 +257,38 @@ let isKeywordTxt str =
     true
   with Not_found -> false
 
+let infixOperatorTable = function
+  | "==" -> EqualEqual
+  | "===" -> EqualEqualEqual
+  | "-" -> Minus
+  | "-." -> MinusDot
+  | "+" -> Plus
+  | "+." -> PlusDot
+  | "++" -> PlusPlus
+  | "/" -> Forwardslash
+  | "/." -> ForwardslashDot
+  | ">" -> GreaterThan
+  | "<" -> LessThan
+  | "*" -> Asterisk
+  | "*." -> AsteriskDot
+  | "**" -> Exponentiation
+  | "||" -> Lor
+  | "&&" -> Land
+  | "!=" -> BangEqual
+  | "!==" -> BangEqualEqual
+  | ">=" -> GreaterEqual
+  | "<=" -> LessEqual
+  | _ -> raise Not_found
+[@@raises Not_found]
+
+let isInfixOperatorTxt str =
+  match str with
+  | "=" | "<>" | "^" | "~-" | "~-." | ":=" | "|." | "|.u" | "|>" ->
+    true (* Allow internally aliases to OCaml ones *)
+  | _ -> (
+    try
+      let _ = infixOperatorTable str in
+      true
+    with Not_found -> false)
+
 let catch = Lident "catch"