Tweak grammar of primitive list in externals (rescript-lang#415)

Fixes rescript-lang/syntax#412

Currently the grammar allows for a list of primitives in an external declaration: i.e. `"hi" "hx"` in `external f: (int, int) => int = "hi" "hx"`. This stems from the fact that user primitives with arity greater than 5 should be implemented by two C functions. The first function, to be used in conjunction with the bytecode compiler ocamlc, receives two arguments: a pointer to an array of OCaml values (the values for the arguments), and an integer which is the number of arguments provided. The other function, to be used in conjunction with the native-code compiler ocamlopt, takes its arguments directly. However in the case of compiling to JS, we don't need to deal with this. In order to reduce some complexity, we'll now parse just one primitive.

Author: IwanKaramazow

syntax/src/res_core.ml

@@ -5209,19 +5209,6 @@ and parseTypeDefinitionOrExtension ~attrs p =
     let typeDefs = parseTypeDefinitions ~attrs ~name ~params ~startPos p in
     TypeDef {recFlag; types = typeDefs}
 
-and parsePrimitive p =
-  match p.Parser.token with
-  | String s -> Parser.next p; Some s
-  | _ -> None
-
-and parsePrimitives p =
-  match (parseRegion ~grammar:Grammar.Primitive ~f:parsePrimitive p) with
-  | [] ->
-    let msg = "An external definition should have at least one primitive. Example: \"setTimeout\"" in
-    Parser.err p (Diagnostics.message msg);
-    []
-  | primitives -> primitives
-
 (* external value-name : typexp = external-declaration *)
 and parseExternalDef ~attrs ~startPos p =
   Parser.leaveBreadcrumb p Grammar.External;
@@ -5230,8 +5217,18 @@ and parseExternalDef ~attrs ~startPos p =
   let name = Location.mkloc name loc in
   Parser.expect ~grammar:(Grammar.TypeExpression) Colon p;
   let typExpr = parseTypExpr p in
+  let equalStart = p.startPos in
+  let equalEnd = p.endPos in
   Parser.expect Equal p;
-  let prim = parsePrimitives p in
+  let prim = match p.token with
+  | String s -> Parser.next p; [s]
+  | _ ->
+      Parser.err ~startPos:equalStart ~endPos:equalEnd p
+        (Diagnostics.message
+          ("An external requires the name of the JS value you're referring to, like \""
+          ^ name.txt ^ "\"."));
+    []
+  in
   let loc = mkLoc startPos p.prevEndPos in
   let vb = Ast_helper.Val.mk ~loc ~attrs ~prim name typExpr in
   Parser.eatBreadcrumb p;

syntax/src/res_grammar.ml

@@ -53,7 +53,6 @@ type t =
   | Implementation
   | Attribute
   | TypeConstraint
-  | Primitive
   | AtomicTypExpr
   | ListExpr
   | JsFfiImport
@@ -111,7 +110,6 @@ let toString = function
   | Implementation -> "implementation"
   | Attribute -> "an attribute"
   | TypeConstraint -> "constraints on a type"
-  | Primitive -> "an external primitive"
   | AtomicTypExpr -> "a type"
   | ListExpr -> "an ocaml list expr"
   | PackageConstraint -> "a package constraint"
@@ -335,7 +333,6 @@ let isListElement grammar token =
   | TypeConstraint -> token = Constraint
   | PackageConstraint -> token = And
   | ConstructorDeclaration -> token = Bar
-  | Primitive -> begin match token with Token.String _ -> true | _ -> false end
   | JsxAttribute -> isJsxAttributeStart token
   | JsFfiImport -> isJsFfiImportStart token
   | AttributePayload -> token = Lparen
@@ -363,8 +360,6 @@ let isListTerminator grammar token =
   | TypeConstraint, token when token <> Constraint -> true
   | PackageConstraint, token when token <> And -> true
   | ConstructorDeclaration, token when token <> Bar -> true
-  | Primitive, Semicolon -> true
-  | Primitive, token when isStructureItemStart token -> true
   | AttributePayload, Rparen -> true
 
   | _ -> false

syntax/tests/idempotency/lwt/unix/lwt_bytes.ml

@@ -17,7 +17,7 @@ external unsafe_get : t -> int -> char = "%caml_ba_unsafe_ref_1"
 external unsafe_set : t -> int -> char -> unit = "%caml_ba_unsafe_set_1"
 
 [@@@ocaml.warning "-3"]
-external unsafe_fill : t -> int -> int -> char -> unit = "lwt_unix_fill_bytes" "noalloc"
+external unsafe_fill : t -> int -> int -> char -> unit = "noalloc"
 [@@@ocaml.warning "+3"]
 
 let fill bytes ofs len ch =
@@ -31,9 +31,9 @@ let fill bytes ofs len ch =
    +-----------------------------------------------------------------+ *)
 
 [@@@ocaml.warning "-3"]
-external unsafe_blit_from_bytes : Bytes.t -> int -> t -> int -> int -> unit = "lwt_unix_blit_from_bytes" "noalloc"
-external unsafe_blit_to_bytes : t -> int -> Bytes.t -> int -> int -> unit = "lwt_unix_blit_to_bytes" "noalloc"
-external unsafe_blit : t -> int -> t -> int -> int -> unit = "lwt_unix_blit" "noalloc"
+external unsafe_blit_from_bytes : Bytes.t -> int -> t -> int -> int -> unit = "noalloc"
+external unsafe_blit_to_bytes : t -> int -> Bytes.t -> int -> int -> unit = "noalloc"
+external unsafe_blit : t -> int -> t -> int -> int -> unit = "noalloc"
 [@@@ocaml.warning "+3"]
 
 let blit_from_bytes src_buf src_ofs dst_buf dst_ofs len =
@@ -154,7 +154,7 @@ let recvfrom fd buf pos len flags =
   else
     wrap_syscall Read fd (fun () -> stub_recvfrom (unix_file_descr fd) buf pos len flags)
 
-external stub_sendto : Unix.file_descr -> t -> int -> int -> Unix.msg_flag list -> Unix.sockaddr -> int = "lwt_unix_bytes_sendto_byte" "lwt_unix_bytes_sendto"
+external stub_sendto : Unix.file_descr -> t -> int -> int -> Unix.msg_flag list -> Unix.sockaddr -> int = "lwt_unix_bytes_sendto"
 
 let sendto fd buf pos len flags addr =
   if pos < 0 || len < 0 || pos > length buf - len then
@@ -171,7 +171,7 @@ let map_file ~fd ?pos ~shared ?(size=(-1)) () =
   |> Bigarray.array1_of_genarray
 
 [@@@ocaml.warning "-3"]
-external mapped : t -> bool = "lwt_unix_mapped" "noalloc"
+external mapped : t -> bool = "noalloc"
 [@@@ocaml.warning "+3"]
 
 type advice =

syntax/tests/idempotency/lwt/unix/lwt_bytes.mli

@@ -90,7 +90,7 @@ val fill : t -> int -> int -> char -> unit
   (** [fill buffer offset length value] puts [value] in all [length]
       bytes of [buffer] starting at offset [offset]. *)
 
-external unsafe_fill : t -> int -> int -> char -> unit = "lwt_unix_fill_bytes" "noalloc"
+external unsafe_fill : t -> int -> int -> char -> unit = "noalloc"
   [@@ocaml.warning "-3"]
   (** Same as {!fill} but without bounds checking. *)
 
@@ -141,7 +141,7 @@ val map_file : fd : Unix.file_descr -> ?pos : int64 -> shared : bool -> ?size :
   (** [map_file ~fd ?pos ~shared ?size ()] maps the file descriptor
       [fd] to an array of bytes. *)
 
-external mapped : t -> bool = "lwt_unix_mapped" "noalloc"
+external mapped : t -> bool = "noalloc"
   [@@ocaml.warning "-3"]
   (** [mapped buffer] returns [true] iff [buffer] is a memory mapped
       file. *)

syntax/tests/idempotency/lwt/unix/lwt_unix.ml

@@ -153,7 +153,7 @@ external start_job : 'a job -> async_method -> bool = "lwt_unix_start_job"
    if the job is already terminated. *)
 
 [@@@ocaml.warning "-3"]
-external check_job : 'a job -> int -> bool = "lwt_unix_check_job" "noalloc"
+external check_job : 'a job -> int -> bool = "noalloc"
 (* Check whether that a job has terminated or not. If it has not
    yet terminated, it is marked so it will send a notification
    when it finishes. *)
@@ -294,7 +294,7 @@ type file_descr = {
 }
 
 [@@@ocaml.warning "-3"]
-external is_socket : Unix.file_descr -> bool = "lwt_unix_is_socket" "noalloc"
+external is_socket : Unix.file_descr -> bool = "noalloc"
 [@@@ocaml.warning "+3"]
 
 external guess_blocking_job : Unix.file_descr -> bool job = "lwt_unix_guess_blocking_job"
@@ -1602,7 +1602,7 @@ let recvfrom ch buf pos len flags =
     let do_recvfrom = if Sys.win32 then Unix.recvfrom else stub_recvfrom in
     wrap_syscall Read ch (fun () -> do_recvfrom ch.fd buf pos len flags)
 
-external stub_sendto : Unix.file_descr -> Bytes.t -> int -> int -> Unix.msg_flag list -> Unix.sockaddr -> int = "lwt_unix_sendto_byte" "lwt_unix_sendto"
+external stub_sendto : Unix.file_descr -> Bytes.t -> int -> int -> Unix.msg_flag list -> Unix.sockaddr -> int = "lwt_unix_sendto"
 
 let sendto ch buf pos len flags addr =
   if pos < 0 || len < 0 || pos > Bytes.length buf - len then
@@ -2448,10 +2448,10 @@ let handle_unix_error f x =
    +-----------------------------------------------------------------+ *)
 
 [@@@ocaml.warning "-3"]
-external pool_size : unit -> int = "lwt_unix_pool_size" "noalloc"
-external set_pool_size : int -> unit = "lwt_unix_set_pool_size" "noalloc"
-external thread_count : unit -> int = "lwt_unix_thread_count" "noalloc"
-external thread_waiting_count : unit -> int = "lwt_unix_thread_waiting_count" "noalloc"
+external pool_size : unit -> int = "lwt_unix_pool_size"
+external set_pool_size : int -> unit = "lwt_unix_set_pool_size"
+external thread_count : unit -> int = "lwt_unix_thread_count"
+external thread_waiting_count : unit -> int = "lwt_unix_thread_waiting_count"
 [@@@ocaml.warning "+3"]
 
 (* +-----------------------------------------------------------------+

syntax/tests/idempotency/ocaml/stdlib/gc.ml

@@ -47,7 +47,7 @@ external stat : unit -> stat = "caml_gc_stat"
 external quick_stat : unit -> stat = "caml_gc_quick_stat"
 external counters : unit -> (float * float * float) = "caml_gc_counters"
 external minor_words : unit -> (float [@unboxed])
-  = "caml_gc_minor_words" "caml_gc_minor_words_unboxed"
+  = "caml_gc_minor_words_unboxed"
 external get : unit -> control = "caml_gc_get"
 external set : control -> unit = "caml_gc_set"
 external minor : unit -> unit = "caml_gc_minor"

syntax/tests/idempotency/ocaml/stdlib/gc.mli

@@ -171,7 +171,7 @@ external counters : unit -> float * float * float = "caml_gc_counters"
     is as fast as [quick_stat]. *)
 
 external minor_words : unit -> (float [@unboxed])
-  = "caml_gc_minor_words" "caml_gc_minor_words_unboxed"
+  = "caml_gc_minor_words_unboxed"
 (** Number of words allocated in the minor heap since the program was
     started. This number is accurate in byte-code programs, but only an
     approximation in programs compiled to native code.

syntax/tests/idempotency/ocaml/stdlib/int32.ml

@@ -30,16 +30,16 @@ external shift_right_logical : int32 -> int -> int32 = "%int32_lsr"
 external of_int : int -> int32 = "%int32_of_int"
 external to_int : int32 -> int = "%int32_to_int"
 external of_float : float -> int32
-  = "caml_int32_of_float" "caml_int32_of_float_unboxed"
+  = "caml_int32_of_float_unboxed"
   [@@unboxed] [@@noalloc]
 external to_float : int32 -> float
-  = "caml_int32_to_float" "caml_int32_to_float_unboxed"
+  = "caml_int32_to_float_unboxed"
   [@@unboxed] [@@noalloc]
 external bits_of_float : float -> int32
-  = "caml_int32_bits_of_float" "caml_int32_bits_of_float_unboxed"
+  = "caml_int32_bits_of_float_unboxed"
   [@@unboxed] [@@noalloc]
 external float_of_bits : int32 -> float
-  = "caml_int32_float_of_bits" "caml_int32_float_of_bits_unboxed"
+  = "caml_int32_float_of_bits_unboxed"
   [@@unboxed] [@@noalloc]
 
 let zero = 0l

syntax/tests/idempotency/ocaml/stdlib/int32.mli

@@ -114,21 +114,21 @@ external to_int : int32 -> int = "%int32_to_int"
    is exact. *)
 
 external of_float : float -> int32
-  = "caml_int32_of_float" "caml_int32_of_float_unboxed"
+  = "caml_int32_of_float_unboxed"
   [@@unboxed] [@@noalloc]
 (** Convert the given floating-point number to a 32-bit integer,
    discarding the fractional part (truncate towards 0).
    The result of the conversion is undefined if, after truncation,
    the number is outside the range \[{!Int32.min_int}, {!Int32.max_int}\]. *)
 
 external to_float : int32 -> float
-  = "caml_int32_to_float" "caml_int32_to_float_unboxed"
+  = "caml_int32_to_float_unboxed"
   [@@unboxed] [@@noalloc]
 (** Convert the given 32-bit integer to a floating-point number. *)
 
 external of_string : string -> int32 = "caml_int32_of_string"
 (** Convert the given string to a 32-bit integer.
-   The string is read in decimal (by default, or if the string 
+   The string is read in decimal (by default, or if the string
    begins with [0u]) or in hexadecimal, octal or binary if the
    string begins with [0x], [0o] or [0b] respectively.
 
@@ -152,7 +152,7 @@ val to_string : int32 -> string
 (** Return the string representation of its argument, in signed decimal. *)
 
 external bits_of_float : float -> int32
-  = "caml_int32_bits_of_float" "caml_int32_bits_of_float_unboxed"
+  = "caml_int32_bits_of_float_unboxed"
   [@@unboxed] [@@noalloc]
 (** Return the internal representation of the given float according
    to the IEEE 754 floating-point 'single format' bit layout.
@@ -161,7 +161,7 @@ external bits_of_float : float -> int32
    represent the mantissa. *)
 
 external float_of_bits : int32 -> float
-  = "caml_int32_float_of_bits" "caml_int32_float_of_bits_unboxed"
+  = "caml_int32_float_of_bits_unboxed"
   [@@unboxed] [@@noalloc]
 (** Return the floating-point number whose internal representation,
    according to the IEEE 754 floating-point 'single format' bit layout,

syntax/tests/idempotency/ocaml/stdlib/int64.ml

@@ -30,10 +30,10 @@ external shift_right_logical : int64 -> int -> int64 = "%int64_lsr"
 external of_int : int -> int64 = "%int64_of_int"
 external to_int : int64 -> int = "%int64_to_int"
 external of_float : float -> int64
-  = "caml_int64_of_float" "caml_int64_of_float_unboxed"
+  = "caml_int64_of_float_unboxed"
   [@@unboxed] [@@noalloc]
 external to_float : int64 -> float
-  = "caml_int64_to_float" "caml_int64_to_float_unboxed"
+  = "caml_int64_to_float_unboxed"
   [@@unboxed] [@@noalloc]
 external of_int32 : int32 -> int64 = "%int64_of_int32"
 external to_int32 : int64 -> int32 = "%int64_to_int32"
@@ -63,10 +63,10 @@ let of_string_opt s =
 
 
 external bits_of_float : float -> int64
-  = "caml_int64_bits_of_float" "caml_int64_bits_of_float_unboxed"
+  = "caml_int64_bits_of_float_unboxed"
   [@@unboxed] [@@noalloc]
 external float_of_bits : int64 -> float
-  = "caml_int64_float_of_bits" "caml_int64_float_of_bits_unboxed"
+  = "caml_int64_float_of_bits_unboxed"
   [@@unboxed] [@@noalloc]
 
 type t = int64

syntax/tests/idempotency/ocaml/stdlib/int64.mli

@@ -115,15 +115,15 @@ external to_int : int64 -> int = "%int64_to_int"
    during the conversion. *)
 
 external of_float : float -> int64
-  = "caml_int64_of_float" "caml_int64_of_float_unboxed"
+  = "caml_int64_of_float_unboxed"
   [@@unboxed] [@@noalloc]
 (** Convert the given floating-point number to a 64-bit integer,
    discarding the fractional part (truncate towards 0).
    The result of the conversion is undefined if, after truncation,
    the number is outside the range \[{!Int64.min_int}, {!Int64.max_int}\]. *)
 
 external to_float : int64 -> float
-  = "caml_int64_to_float" "caml_int64_to_float_unboxed"
+  = "caml_int64_to_float_unboxed"
   [@@unboxed] [@@noalloc]
 (** Convert the given 64-bit integer to a floating-point number. *)
 
@@ -150,7 +150,7 @@ external to_nativeint : int64 -> nativeint = "%int64_to_nativeint"
 
 external of_string : string -> int64 = "caml_int64_of_string"
 (** Convert the given string to a 64-bit integer.
-   The string is read in decimal (by default, or if the string 
+   The string is read in decimal (by default, or if the string
    begins with [0u]) or in hexadecimal, octal or binary if the
    string begins with [0x], [0o] or [0b] respectively.
 
@@ -173,7 +173,7 @@ val to_string : int64 -> string
 (** Return the string representation of its argument, in decimal. *)
 
 external bits_of_float : float -> int64
-  = "caml_int64_bits_of_float" "caml_int64_bits_of_float_unboxed"
+  = "caml_int64_bits_of_float_unboxed"
   [@@unboxed] [@@noalloc]
 (** Return the internal representation of the given float according
    to the IEEE 754 floating-point 'double format' bit layout.
@@ -182,7 +182,7 @@ external bits_of_float : float -> int64
    represent the mantissa. *)
 
 external float_of_bits : int64 -> float
-  = "caml_int64_float_of_bits" "caml_int64_float_of_bits_unboxed"
+  = "caml_int64_float_of_bits_unboxed"
   [@@unboxed] [@@noalloc]
 (** Return the floating-point number whose internal representation,
    according to the IEEE 754 floating-point 'double format' bit layout,

syntax/tests/idempotency/ocaml/stdlib/nativeint.ml

@@ -30,10 +30,10 @@ external shift_right_logical: nativeint -> int -> nativeint = "%nativeint_lsr"
 external of_int: int -> nativeint = "%nativeint_of_int"
 external to_int: nativeint -> int = "%nativeint_to_int"
 external of_float : float -> nativeint
-  = "caml_nativeint_of_float" "caml_nativeint_of_float_unboxed"
+  = "caml_nativeint_of_float_unboxed"
   [@@unboxed] [@@noalloc]
 external to_float : nativeint -> float
-  = "caml_nativeint_to_float" "caml_nativeint_to_float_unboxed"
+  = "caml_nativeint_to_float_unboxed"
   [@@unboxed] [@@noalloc]
 external of_int32: int32 -> nativeint = "%nativeint_of_int32"
 external to_int32: nativeint -> int32 = "%nativeint_to_int32"

syntax/tests/idempotency/ocaml/stdlib/nativeint.mli

@@ -132,7 +132,7 @@ external to_int : nativeint -> int = "%nativeint_to_int"
    the conversion. *)
 
 external of_float : float -> nativeint
-  = "caml_nativeint_of_float" "caml_nativeint_of_float_unboxed"
+  = "caml_nativeint_of_float_unboxed"
   [@@unboxed] [@@noalloc]
 (** Convert the given floating-point number to a native integer,
    discarding the fractional part (truncate towards 0).
@@ -141,7 +141,7 @@ external of_float : float -> nativeint
    \[{!Nativeint.min_int}, {!Nativeint.max_int}\]. *)
 
 external to_float : nativeint -> float
-  = "caml_nativeint_to_float" "caml_nativeint_to_float_unboxed"
+  = "caml_nativeint_to_float_unboxed"
   [@@unboxed] [@@noalloc]
 (** Convert the given native integer to a floating-point number. *)
 
@@ -158,7 +158,7 @@ external to_int32 : nativeint -> int32 = "%nativeint_to_int32"
 
 external of_string : string -> nativeint = "caml_nativeint_of_string"
 (** Convert the given string to a native integer.
-   The string is read in decimal (by default, or if the string 
+   The string is read in decimal (by default, or if the string
    begins with [0u]) or in hexadecimal, octal or binary if the
    string begins with [0x], [0o] or [0b] respectively.