Revert "Simplify the definition of custom .{} operators"
This reverts commit 4a80e9da11
.
(The revert required some manual conflict resolution because of use of
function argument labels in the parser.)
master
parent
2e5f4f3238
commit
cca2eed653
BIN
boot/ocamlc
BIN
boot/ocamlc
Binary file not shown.
BIN
boot/ocamldep
BIN
boot/ocamldep
Binary file not shown.
|
@ -281,30 +281,3 @@ external get3: unit -> unit = "caml_ba_get_3"
|
|||
external set1: unit -> unit = "caml_ba_set_1"
|
||||
external set2: unit -> unit = "caml_ba_set_2"
|
||||
external set3: unit -> unit = "caml_ba_set_3"
|
||||
|
||||
(* Index operators *)
|
||||
|
||||
(* Array1 *)
|
||||
external ( .{} ) : ('a, 'b, 'c) Array1.t -> int -> 'a = "%caml_ba_opt_ref_1"
|
||||
external ( .{} <- ) : ('a, 'b, 'c) Array1.t -> int -> 'a -> unit
|
||||
= "%caml_ba_opt_set_1"
|
||||
|
||||
|
||||
(* Array2 *)
|
||||
external ( .{,} ) : ('a, 'b, 'c) Array2.t -> int->int -> 'a
|
||||
= "%caml_ba_opt_ref_2"
|
||||
external ( .{,} <- ) : ('a, 'b, 'c) Array2.t -> int->int -> 'a -> unit
|
||||
= "%caml_ba_opt_set_2"
|
||||
|
||||
(*Array3*)
|
||||
external ( .{,,} ) : ('a, 'b, 'c) Array3.t -> int->int->int -> 'a
|
||||
= "%caml_ba_opt_ref_3"
|
||||
external ( .{,,} <- ) : ('a, 'b, 'c) Array3.t -> int->int->int -> 'a -> unit
|
||||
= "%caml_ba_opt_set_3"
|
||||
|
||||
|
||||
(*Genarray*)
|
||||
external ( .{,..,} ) : ('a, 'b, 'c) Genarray.t -> int array -> 'a
|
||||
= "caml_ba_get_generic"
|
||||
external ( .{,..,} <- ) : ('a, 'b, 'c) Genarray.t -> int array -> 'a -> unit
|
||||
= "caml_ba_set_generic"
|
||||
|
|
|
@ -460,18 +460,6 @@ module Genarray :
|
|||
|
||||
end
|
||||
|
||||
external ( .{,..,} ) : ('a, 'b, 'c) Genarray.t -> int array -> 'a
|
||||
= "caml_ba_get_generic"
|
||||
(** Index operator for generic arrays. When the [Bigarray] module is
|
||||
open, [ bigarray.{a,b,c,d,...} ] is desugared to [ (.{,..,} )
|
||||
bigarray [|a,b,c,d,...|] ]. *)
|
||||
|
||||
external ( .{,..,} <- ) : ('a, 'b, 'c) Genarray.t -> int array -> 'a -> unit
|
||||
= "caml_ba_set_generic"
|
||||
(** Indexed assignment operator for generic arrays. When the
|
||||
[Bigarray] module is open, [ bigarray.{a,b,c,d,...} <- x ] is
|
||||
desugared to [ (.{,..,} ) bigarray [|a,b,c,d,...|] x ]. *)
|
||||
|
||||
(** {6 One-dimensional arrays} *)
|
||||
|
||||
(** One-dimensional arrays. The [Array1] structure provides operations
|
||||
|
@ -553,16 +541,6 @@ module Array1 : sig
|
|||
|
||||
end
|
||||
|
||||
external ( .{} ) : ('a, 'b, 'c) Array1.t -> int -> 'a = "%caml_ba_opt_ref_1"
|
||||
(** Index operator for one-dimensional arrays. When the [Bigarray]
|
||||
module is open, [ bigarray.{a} ] is desugared to [ (.{} ) bigarray a
|
||||
]. *)
|
||||
|
||||
external ( .{} <- ) : ('a, 'b, 'c) Array1.t -> int -> 'a -> unit
|
||||
= "%caml_ba_opt_set_1"
|
||||
(** Indexed assignment operator for one-dimensional arrays. When the
|
||||
[Bigarray] module is open, [ bigarray.{a} <- x ] is desugared to [
|
||||
(.{} ) bigarray x ]. *)
|
||||
|
||||
(** {6 Two-dimensional arrays} *)
|
||||
|
||||
|
@ -667,19 +645,6 @@ module Array2 :
|
|||
|
||||
end
|
||||
|
||||
external ( .{,} ) : ('a, 'b, 'c) Array2.t -> int -> int -> 'a
|
||||
= "%caml_ba_opt_ref_2"
|
||||
(** Index operator for bidimensional arrays. When the [Bigarray] module is open,
|
||||
[ bigarray.{a,b} ] is desugared to [ (.{,} ) bigarray a b ].
|
||||
*)
|
||||
|
||||
external ( .{,} <- ) : ('a, 'b, 'c) Array2.t -> int -> int -> 'a -> unit
|
||||
= "%caml_ba_opt_set_2"
|
||||
(** Indexed assignment operator for bidimensionnal arrays. When the
|
||||
[Bigarray] module is open, [ bigarray.{a,b} <- x ] is desugared to
|
||||
[ (.{,} ) bigarray a b x ]. *)
|
||||
|
||||
|
||||
(** {6 Three-dimensional arrays} *)
|
||||
|
||||
(** Three-dimensional arrays. The [Array3] structure provides operations
|
||||
|
@ -808,18 +773,6 @@ module Array3 :
|
|||
|
||||
end
|
||||
|
||||
external ( .{,,} ) : ('a, 'b, 'c) Array3.t -> int -> int -> int -> 'a
|
||||
= "%caml_ba_opt_ref_3"
|
||||
(** Index operator for tridimensional arrays. When the [Bigarray]
|
||||
module is open, [ bigarray.{a,b,c} ] is desugared to
|
||||
[ (.{,} ) bigarray a b c ]. *)
|
||||
|
||||
external ( .{,,} <- ) : ('a, 'b, 'c) Array3.t -> int -> int -> int -> 'a -> unit
|
||||
= "%caml_ba_opt_set_3"
|
||||
(** Indexed assignment operator for tridimensionnal arrays. When the
|
||||
[Bigarray] module is open, [ bigarray.{a,b,c} <- x ] is desugared to
|
||||
[ (.{,,} ) bigarray a b c x ]. *)
|
||||
|
||||
(** {6 Coercions between generic big arrays and fixed-dimension big arrays} *)
|
||||
|
||||
external genarray_of_array1 :
|
||||
|
|
|
@ -171,53 +171,45 @@ let expecting pos nonterm =
|
|||
let not_expecting pos nonterm =
|
||||
raise Syntaxerr.(Error(Not_expecting(rhs_loc pos, nonterm)))
|
||||
|
||||
let bigarray_function order assign =
|
||||
let op =
|
||||
match order with
|
||||
| 1 -> ".{}"
|
||||
| 2 -> ".{,}"
|
||||
| 3 -> ".{,,}"
|
||||
| _ -> ".{,..,}"
|
||||
in
|
||||
let op= if assign then op^"<-" else op in
|
||||
ghloc ( Lident op )
|
||||
let bigarray_function str name =
|
||||
ghloc (Ldot(Ldot(Lident "Bigarray", str), name))
|
||||
|
||||
let bigarray_untuplify = function
|
||||
{ pexp_desc = Pexp_tuple explist; pexp_loc = _ } -> explist
|
||||
| exp -> [exp]
|
||||
|
||||
let bigarray_get arr arg =
|
||||
let get order = bigarray_function order false in
|
||||
let get = if !Clflags.fast then "unsafe_get" else "get" in
|
||||
match bigarray_untuplify arg with
|
||||
[c1] ->
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(get 1)),
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" get)),
|
||||
[Nolabel, arr; Nolabel, c1]))
|
||||
| [c1;c2] ->
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(get 2)),
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" get)),
|
||||
[Nolabel, arr; Nolabel, c1; Nolabel, c2]))
|
||||
| [c1;c2;c3] ->
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(get 3)),
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" get)),
|
||||
[Nolabel, arr; Nolabel, c1; Nolabel, c2; Nolabel, c3]))
|
||||
| coords ->
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(get 0)),
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "get")),
|
||||
[Nolabel, arr; Nolabel, ghexp(Pexp_array coords)]))
|
||||
|
||||
let bigarray_set arr arg newval =
|
||||
let set order = bigarray_function order true in
|
||||
let set = if !Clflags.fast then "unsafe_set" else "set" in
|
||||
match bigarray_untuplify arg with
|
||||
[c1] ->
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(set 1)),
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" set)),
|
||||
[Nolabel, arr; Nolabel, c1; Nolabel, newval]))
|
||||
| [c1;c2] ->
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(set 2)),
|
||||
[Nolabel, arr; Nolabel, c1; Nolabel, c2;
|
||||
Nolabel, newval]))
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" set)),
|
||||
[Nolabel, arr; Nolabel, c1;
|
||||
Nolabel, c2; Nolabel, newval]))
|
||||
| [c1;c2;c3] ->
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(set 3)),
|
||||
[Nolabel, arr; Nolabel, c1; Nolabel, c2; Nolabel, c3;
|
||||
Nolabel, newval]))
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" set)),
|
||||
[Nolabel, arr; Nolabel, c1;
|
||||
Nolabel, c2; Nolabel, c3; Nolabel, newval]))
|
||||
| coords ->
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(set 0)),
|
||||
mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "set")),
|
||||
[Nolabel, arr;
|
||||
Nolabel, ghexp(Pexp_array coords);
|
||||
Nolabel, newval]))
|
||||
|
|
|
@ -9,7 +9,7 @@
|
|||
(* under the terms of the Q Public License version 1.0. *)
|
||||
(* *)
|
||||
(***********************************************************************)
|
||||
open Bigarray
|
||||
|
||||
let f x = x.{2}
|
||||
|
||||
let () =
|
||||
|
|
Loading…
Reference in New Issue