From 20f4c6ced326b82f056e593a1f4dbb7ece7f4166 Mon Sep 17 00:00:00 2001
From: yallop <yallop@gmail.com>
Date: Mon, 22 Oct 2018 22:33:00 +0900
Subject: [PATCH] Disallow .~ in extended indexing operators. (#2106)

Disallow .~ in the lexer to preserve MetaOCaml compatibility.
---
 Changes                       |  5 +++++
 manual/manual/refman/lex.etex |  6 +++---
 parsing/lexer.mli             |  1 +
 parsing/lexer.mll             | 12 +++++++++++-
 parsing/parse.ml              |  1 +
 5 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/Changes b/Changes
index 876c65208..a387d7acc 100644
--- a/Changes
+++ b/Changes
@@ -15,6 +15,11 @@ Working version
 - GPR#1892: Allow shadowing of items coming from an include
   (Thomas Refis, review by Gabriel Radanne)
 
+* GPR#2106: .~ is now a reserved keyword, and is no longer available
+  for use in extended indexing operators
+  (Jeremy Yallop, review by Gabriel Scherer, Florian Angeletti, and
+   Damien Doligez)
+
 ### Type system:
 
 - GPR#1826: allow expanding a type to a private abbreviation instead of
diff --git a/manual/manual/refman/lex.etex b/manual/manual/refman/lex.etex
index 4ae81f3cf..3ae76ee5f 100644
--- a/manual/manual/refman/lex.etex
+++ b/manual/manual/refman/lex.etex
@@ -280,9 +280,9 @@ The following character sequences are also keywords:
 %
 \begin{alltt}
 "    !=    #     &     &&    '     (     )     *     +     ,     -"
-"    -.    ->    .     ..    :     ::    :=    :>    ;     ;;    <"
-"    <-    =     >     >]    >}    ?     [     [<    [>    [|    ]"
-"    _     `     {     {<    |     |]    ||    }     ~"
+"    -.    ->    .     ..    .~    :     ::    :=    :>    ;     ;;"
+"    <     <-    =     >     >]    >}    ?     [     [<    [>    [|"
+"    ]     _     `     {     {<    |     |]    ||    }     ~"
 \end{alltt}
 %
 Note that the following identifiers are keywords of the Camlp4
diff --git a/parsing/lexer.mli b/parsing/lexer.mli
index f8831e5e0..cde2ad5cf 100644
--- a/parsing/lexer.mli
+++ b/parsing/lexer.mli
@@ -27,6 +27,7 @@ val skip_hash_bang: Lexing.lexbuf -> unit
 type error =
   | Illegal_character of char
   | Illegal_escape of string * string option
+  | Reserved_sequence of string * string option
   | Unterminated_comment of Location.t
   | Unterminated_string
   | Unterminated_string_in_comment of Location.t * Location.t
diff --git a/parsing/lexer.mll b/parsing/lexer.mll
index ef528cab9..c807b8964 100644
--- a/parsing/lexer.mll
+++ b/parsing/lexer.mll
@@ -23,6 +23,7 @@ open Parser
 type error =
   | Illegal_character of char
   | Illegal_escape of string * string option
+  | Reserved_sequence of string * string option
   | Unterminated_comment of Location.t
   | Unterminated_string
   | Unterminated_string_in_comment of Location.t * Location.t
@@ -263,6 +264,12 @@ let prepare_error loc = function
         (fun ppf -> match explanation with
            | None -> ()
            | Some expl -> fprintf ppf ": %s" expl)
+  | Reserved_sequence (s, explanation) ->
+      Location.errorf ~loc
+        "Reserved character sequence: %s%t" s
+        (fun ppf -> match explanation with
+           | None -> ()
+           | Some expl -> fprintf ppf " %s" expl)
   | Unterminated_comment _ ->
       Location.errorf ~loc "Comment not terminated"
   | Unterminated_string ->
@@ -305,7 +312,7 @@ let identchar_latin1 =
 let symbolchar =
   ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~']
 let dotsymbolchar =
-  ['!' '$' '%' '&' '*' '+' '-' '/' ':' '=' '>' '?' '@' '^' '|' '~']
+  ['!' '$' '%' '&' '*' '+' '-' '/' ':' '=' '>' '?' '@' '^' '|']
 let decimal_literal =
   ['0'-'9'] ['0'-'9' '_']*
 let hex_digit =
@@ -343,6 +350,9 @@ rule token = parse
       { UNDERSCORE }
   | "~"
       { TILDE }
+  | ".~"
+      { error lexbuf
+          (Reserved_sequence (".~", Some "is reserved for use in MetaOCaml")) }
   | "~" (lowercase identchar * as name) ':'
       { check_label_name lexbuf name;
         LABEL name }
diff --git a/parsing/parse.ml b/parsing/parse.ml
index 221eb0fe5..e7edd7079 100644
--- a/parsing/parse.ml
+++ b/parsing/parse.ml
@@ -30,6 +30,7 @@ let rec skip_phrase lexbuf =
   | _ -> skip_phrase lexbuf
   | exception (Lexer.Error (Lexer.Unterminated_comment _, _)
               | Lexer.Error (Lexer.Unterminated_string, _)
+              | Lexer.Error (Lexer.Reserved_sequence _, _)
               | Lexer.Error (Lexer.Unterminated_string_in_comment _, _)
               | Lexer.Error (Lexer.Illegal_character _, _)) ->
       skip_phrase lexbuf