Skip to content
This repository was archived by the owner on Jun 15, 2023. It is now read-only.

Tweak grammar of primitive list in externals #415

Merged
merged 1 commit into from
May 25, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
25 changes: 11 additions & 14 deletions src/res_core.ml
Original file line number Diff line number Diff line change
Expand Up @@ -5217,19 +5217,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;
Expand All @@ -5238,8 +5225,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;
Expand Down
5 changes: 0 additions & 5 deletions src/res_grammar.ml
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,6 @@ type t =
| Implementation
| Attribute
| TypeConstraint
| Primitive
| AtomicTypExpr
| ListExpr
| JsFfiImport
Expand Down Expand Up @@ -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"
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
12 changes: 6 additions & 6 deletions tests/idempotency/lwt/unix/lwt_bytes.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand All @@ -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 =
Expand Down Expand Up @@ -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
Expand All @@ -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 =
Expand Down
4 changes: 2 additions & 2 deletions tests/idempotency/lwt/unix/lwt_bytes.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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. *)

Expand Down Expand Up @@ -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. *)
Expand Down
14 changes: 7 additions & 7 deletions tests/idempotency/lwt/unix/lwt_unix.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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. *)
Expand Down Expand Up @@ -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"
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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"]

(* +-----------------------------------------------------------------+
Expand Down
2 changes: 1 addition & 1 deletion tests/idempotency/ocaml/stdlib/gc.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
2 changes: 1 addition & 1 deletion tests/idempotency/ocaml/stdlib/gc.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
8 changes: 4 additions & 4 deletions tests/idempotency/ocaml/stdlib/int32.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 5 additions & 5 deletions tests/idempotency/ocaml/stdlib/int32.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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.

Expand All @@ -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.
Expand All @@ -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,
Expand Down
8 changes: 4 additions & 4 deletions tests/idempotency/ocaml/stdlib/int64.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down Expand Up @@ -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
Expand Down
10 changes: 5 additions & 5 deletions tests/idempotency/ocaml/stdlib/int64.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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. *)

Expand All @@ -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.

Expand All @@ -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.
Expand All @@ -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,
Expand Down
4 changes: 2 additions & 2 deletions tests/idempotency/ocaml/stdlib/nativeint.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
6 changes: 3 additions & 3 deletions tests/idempotency/ocaml/stdlib/nativeint.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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).
Expand All @@ -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. *)

Expand All @@ -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.

Expand Down
Loading