flambda-backend: Parse unboxed literals, treating them as boxed (#1437)

* Parse `#0`, `-#1`, `#2.7`, and `-#3.1`, treating them as boxed

* Fix parsing of unsuffixed unboxed int literals

* Rewrite CR comment

* Update comment

* promote-menhir

* Unboxed literal tests

* Adjust error for unsuffixed unboxed integers

Author: antalsz

boot/menhir/parser.ml

@@ -780,6 +780,40 @@ let check_layout loc id =
   let loc = make_loc loc in
   Attr.mk ~loc (mkloc id loc) (PStr [])
 
+(* Unboxed literals *)
+
+let unboxed_literals_extension : Language_extension.t = Layouts Alpha
+
+type sign = Positive | Negative
+
+let with_sign sign num =
+  match sign with
+  | Positive -> num
+  | Negative -> "-" ^ num
+
+(* CR layouts ASZ: The [unboxed_*] functions will both be improved and lose
+   their explicit assert once we have real unboxed literals in Jane syntax; they
+   may also get re-inlined at that point *)
+
+let unboxed_int sloc int_loc sign (n, m) =
+  match m with
+  | Some _ ->
+      Jane_syntax_parsing.assert_extension_enabled
+        ~loc:(make_loc sloc) unboxed_literals_extension;
+      Pconst_integer (with_sign sign n, m)
+  | None ->
+      if Language_extension.is_enabled unboxed_literals_extension then
+        expecting int_loc "integer literal with type-specifying suffix"
+      else
+        not_expecting sloc "line number directive"
+
+let unboxed_float sloc sign (f, m) =
+  Jane_syntax_parsing.assert_extension_enabled
+    ~loc:(make_loc sloc) unboxed_literals_extension;
+  Pconst_float (with_sign sign f, m)
+
+(* Jane syntax *)
+
 let mkexp_jane_syntax
       ~loc
       { Jane_syntax_parsing.With_attributes.jane_syntax_attributes; desc }
@@ -2063,7 +2097,7 @@ formal_class_parameters:
 (* Class expressions. *)
 
 class_expr:
-    class_simple_expr
+    class_simple_expr %prec below_HASH
       { $1 }
   | FUN attributes class_fun_def
       { wrap_class_attrs ~loc:$sloc $3 $2 }
@@ -2076,7 +2110,7 @@ class_expr:
   | class_expr attribute
       { Cl.attr $1 $2 }
   | mkclass(
-      class_simple_expr nonempty_llist(labeled_simple_expr)
+      class_simple_expr nonempty_llist(labeled_simple_expr) %prec below_HASH
         { Pcl_apply($1, $2) }
     | extension
         { Pcl_extension $1 }
@@ -2556,7 +2590,7 @@ expr:
       { Pexp_lazy $3, $2 }
 ;
 %inline expr_:
-  | simple_expr nonempty_llist(labeled_simple_expr)
+  | simple_expr nonempty_llist(labeled_simple_expr) %prec below_HASH
       { Pexp_apply($1, $2) }
   | expr_comma_list %prec below_COMMA
       { Pexp_tuple($1) }
@@ -3932,17 +3966,25 @@ meth_list:
 /* Constants */
 
 constant:
-  | INT          { let (n, m) = $1 in Pconst_integer (n, m) }
-  | CHAR         { Pconst_char $1 }
-  | STRING       { let (s, strloc, d) = $1 in Pconst_string (s, strloc, d) }
-  | FLOAT        { let (f, m) = $1 in Pconst_float (f, m) }
+  | INT               { let (n, m) = $1 in Pconst_integer (n, m) }
+  | CHAR              { Pconst_char $1 }
+  | STRING            { let (s, strloc, d) = $1 in Pconst_string (s, strloc, d) }
+  | FLOAT             { let (f, m) = $1 in Pconst_float (f, m) }
+  (* The unboxed literals have to be composed of multiple lexemes so we can
+     handle line number directives properly *)
+  | HASH INT          { unboxed_int $sloc $loc($2) Positive $2 }
+  | HASH FLOAT        { unboxed_float $sloc Positive $2 }
 ;
 signed_constant:
-    constant     { $1 }
-  | MINUS INT    { let (n, m) = $2 in Pconst_integer("-" ^ n, m) }
-  | MINUS FLOAT  { let (f, m) = $2 in Pconst_float("-" ^ f, m) }
-  | PLUS INT     { let (n, m) = $2 in Pconst_integer (n, m) }
-  | PLUS FLOAT   { let (f, m) = $2 in Pconst_float(f, m) }
+    constant          { $1 }
+  | MINUS INT         { let (n, m) = $2 in Pconst_integer("-" ^ n, m) }
+  | MINUS FLOAT       { let (f, m) = $2 in Pconst_float("-" ^ f, m) }
+  | MINUS HASH INT    { unboxed_int $sloc $loc($3) Negative $3 }
+  | MINUS HASH FLOAT  { unboxed_float $sloc Negative $3 }
+  | PLUS INT          { let (n, m) = $2 in Pconst_integer (n, m) }
+  | PLUS FLOAT        { let (f, m) = $2 in Pconst_float(f, m) }
+  | PLUS HASH INT     { unboxed_int $sloc $loc($3) Positive $3 }
+  | PLUS HASH FLOAT   { unboxed_float $sloc Negative $3 }
 ;
 
 /* Identifiers and long identifiers */

parsing/parser.mly

@@ -1,4 +1,4 @@
-File "pr6604.ml", line 9, characters 0-1:
+File "pr6604.ml", line 9, characters 0-2:
 9 | #1
-    ^
-Error: Syntax error
+    ^^
+Error: Syntax error: line number directive not expected.

testsuite/tests/parsing/pr6604.compilers.reference

@@ -1,4 +1,4 @@
-File "pr6604_2.ml", line 9, characters 1-2:
+File "pr6604_2.ml", line 9, characters 1-3:
 9 |  #1 "pr6604.ml"
-     ^
-Error: Syntax error
+     ^^
+Error: Syntax error: line number directive not expected.

testsuite/tests/parsing/pr6604_2.compilers.reference

@@ -0,0 +1,6 @@
+
+Line 6, characters 45-47:
+6 | let unboxed_integers_must_have_a_modifier = #42
+                                                 ^^
+Error: Syntax error: integer literal with type-specifying suffix expected.
+

testsuite/tests/typing-layouts/invalid_integer_literals.compilers.reference

@@ -0,0 +1,6 @@
+(* TEST
+   flags = "-extension layouts_alpha"
+   * toplevel
+*)
+
+let unboxed_integers_must_have_a_modifier = #42

testsuite/tests/typing-layouts/invalid_integer_literals.ml

@@ -0,0 +1,64 @@
+(* TEST
+   flags = "-extension layouts_alpha"
+   * expect
+*)
+
+let e = #2.718281828459045
+[%%expect{|
+val e : float = 2.71828182845904509
+|}]
+
+let negative_one_half = -#0.5
+[%%expect{|
+val negative_one_half : float = -0.5
+|}]
+
+let positive_one_dot = +#1.
+[%%expect{|
+val positive_one_dot : float = 1.
+|}]
+
+let one_billion = #1e9
+[%%expect{|
+val one_billion : float = 1000000000.
+|}]
+
+let zero = #0n
+[%%expect{|
+val zero : nativeint = 0n
+|}]
+
+let positive_one = +#1l
+[%%expect{|
+val positive_one : int32 = 1l
+|}]
+
+let negative_one = -#1L
+[%%expect{|
+val negative_one : int64 = -1L
+|}]
+
+let two_fifty_five_in_hex = #0xFFn
+[%%expect{|
+val two_fifty_five_in_hex : nativeint = 255n
+|}]
+
+let twenty_five_in_octal = #0o31l
+[%%expect{|
+val twenty_five_in_octal : int32 = 25l
+|}]
+
+let forty_two_in_binary = #0b101010L
+[%%expect{|
+val forty_two_in_binary : int64 = 42L
+|}]
+
+let one_twenty_seven_point_two_five_in_floating_hex = #0x7f.4
+[%%expect{|
+val one_twenty_seven_point_two_five_in_floating_hex : float = 127.25
+|}]
+
+let five_point_three_seven_five_in_floating_hexponent = #0xa.cp-1
+[%%expect{|
+val five_point_three_seven_five_in_floating_hexponent : float = 5.375
+|}]