[Pkg-ocaml-maint-commits] [SCM] fieldslib packaging branch, upstream, updated. upstream/107.01-24-gf6cfb28
Stephane Glondu
steph at glondu.net
Sun Jun 23 21:06:18 UTC 2013
The following commit has been merged in the upstream branch:
commit 14aef22b000a8a386426a97d4086234c0e71458f
Author: Stephane Glondu <steph at glondu.net>
Date: Sun Jun 23 22:12:46 2013 +0200
Imported Upstream version 109.10.00
diff --git a/_oasis b/_oasis
index 5261bdd..6c05c08 100644
--- a/_oasis
+++ b/_oasis
@@ -2,7 +2,7 @@ OASISFormat: 0.3
OCamlVersion: >= 4.00.0
FindlibVersion: >= 1.3.2
Name: fieldslib
-Version: 109.09.00
+Version: 109.10.00
Synopsis: OCaml record fields as first class values.
Authors: Jane Street Capital LLC <opensource at janestreet.com>
Copyrights: (C) 2009-2013 Jane Street Capital LLC <opensource at janestreet.com>
diff --git a/lib/META b/lib/META
index eebae0a..02aba77 100644
--- a/lib/META
+++ b/lib/META
@@ -1,6 +1,6 @@
# OASIS_START
-# DO NOT EDIT (digest: 3489a6cc526ce23c7e04efbd37efc77a)
-version = "109.09.00"
+# DO NOT EDIT (digest: 3790065eaf29ddfe430fb3b01c1af42c)
+version = "109.10.00"
description = "OCaml record fields as first class values."
archive(byte) = "fieldslib.cma"
archive(byte, plugin) = "fieldslib.cma"
@@ -8,7 +8,7 @@ archive(native) = "fieldslib.cmxa"
archive(native, plugin) = "fieldslib.cmxs"
exists_if = "fieldslib.cma"
package "syntax" (
- version = "109.09.00"
+ version = "109.10.00"
description = "Syntax extension for Fieldslib"
requires = "camlp4 type_conv fieldslib"
archive(syntax, preprocessor) = "pa_fields_conv.cma"
diff --git a/lib_test/fields_test.ml b/lib_test/fields_test.ml
index f31da07..14a18a1 100644
--- a/lib_test/fields_test.ml
+++ b/lib_test/fields_test.ml
@@ -13,3 +13,12 @@ module Rec = struct
let _ = something1
end
+
+module Private : sig
+ type t = private { a : int; mutable b : int }
+ with fields
+end = struct
+ type u = { a : int; mutable b : int }
+ type t = u = private { a : int; mutable b : int }
+ with fields
+end
diff --git a/sample/test.ml b/sample/test.ml
index 501d62e..a03aae2 100644
--- a/sample/test.ml
+++ b/sample/test.ml
@@ -6,3 +6,13 @@ type ('a,'b) t = {
mutable cancelled : bool;
(* symbol : string; *)
} with fields
+
+module Private = struct
+ type ('a,'b) t = private {
+ dir : 'a * 'b;
+ quantity : ('a , 'b) t;
+ price : int * 'a;
+ mutable cancelled : bool;
+ (* symbol : string; *)
+ } with fields
+end
diff --git a/sample/test.mli b/sample/test.mli
index 5d69752..f3fdbe0 100644
--- a/sample/test.mli
+++ b/sample/test.mli
@@ -22,3 +22,13 @@ type ('a,'b) t = {
mutable cancelled : bool;
(* symbol : string; *)
} with fields
+
+module Private : sig
+ type ('a,'b) t = private {
+ dir : 'a * 'b;
+ quantity : ('a , 'b) t;
+ price : int * 'a;
+ mutable cancelled : bool;
+ (* symbol : string; *)
+ } with fields
+end
diff --git a/setup.ml b/setup.ml
index fa5c926..9483114 100644
--- a/setup.ml
+++ b/setup.ml
@@ -1,5 +1,5 @@
(* OASIS_START *)
-(* DO NOT EDIT (digest: 25a76d0205b43555bf81a80ccaf4445a) *)
+(* DO NOT EDIT (digest: 74d4cbc90a4a30ee0733f256d371d338) *)
(*
Regenerated by OASIS v0.3.0
Visit http://oasis.forge.ocamlcore.org for more information and
@@ -5576,7 +5576,7 @@ let setup_t =
ocaml_version = Some (OASISVersion.VGreaterEqual "4.00.0");
findlib_version = Some (OASISVersion.VGreaterEqual "1.3.2");
name = "fieldslib";
- version = "109.09.00";
+ version = "109.10.00";
license =
OASISLicense.DEP5License
(OASISLicense.DEP5Unit
@@ -5746,7 +5746,7 @@ let setup_t =
};
oasis_fn = Some "_oasis";
oasis_version = "0.3.0";
- oasis_digest = Some "w\129\219\031b\017\225ci\199\221\t\002y\172F";
+ oasis_digest = Some "\167\190\209\011\229F\030\178 lM\234\206\140V\243";
oasis_exec = None;
oasis_setup_args = [];
setup_update = false;
diff --git a/syntax/pa_fields_conv.ml b/syntax/pa_fields_conv.ml
index 15f7e7c..236f384 100644
--- a/syntax/pa_fields_conv.ml
+++ b/syntax/pa_fields_conv.ml
@@ -211,7 +211,7 @@ module Gen_sig = struct
- let record ~ty_name ~tps _loc ty =
+ let record ~private_ ~ty_name ~tps _loc ty =
let fields = Inspect.fields ty in
let record_ty = apply_type _loc ~ty_name ~tps in
let conv_field (res_getset, res_fields) (name, m, ty) =
@@ -219,12 +219,13 @@ module Gen_sig = struct
let field =
<:sig_item< value $lid:name$ : Fieldslib.Field.t $record_ty$ $ty$ >>
in
- match m with
- | `Immutable ->
+ match m, private_ with
+ | `Immutable, _
+ | `Mutable, true ->
( <:sig_item< $getter$ ; $res_getset$ >> ,
<:sig_item< $field$ ; $res_fields$ >>
)
- | `Mutable ->
+ | `Mutable, false ->
let setter =
<:sig_item< value $lid:"set_" ^ name$ : $record_ty$ -> $ty$ -> unit >> in
( <:sig_item< $getter$ ; $setter$ ; $res_getset$ >> ,
@@ -249,39 +250,56 @@ module Gen_sig = struct
<:sig_item< $getters_and_setters$ ;
module Fields : sig
value names : list string ;
- $fields$ ;
- $fold$ ;
- $create_fun$ ; $simple_create_fun$ ; $iter$ ; $map$ ; $map_poly$ ; $and_f$ ; $or_f$ ; $to_list$ ;
- module Direct : sig
- $direct_iter$ ;
- $direct_fold$ ;
- end ;
+ $ if private_
+ (* Even though the [set] function in the first-class fields will be None
+ if the type is declared private in the implementation, we still can't
+ give any access to them here:
+
+ First class fields usually contain the [set] function anyway because the
+ type is usually private in the interface but not in the
+ implementation. And even if they didn't or if the record was non mutable,
+ first class fields would still expose the [fset] functions which also
+ break the purpose of private types. So first class fields can never be
+ exposed and any function using them (ie everything in the else branch
+ here) can't be exposed either.
+ *)
+ then <:sig_item< >>
+ else <:sig_item<
+ $fields$ ;
+ $fold$ ;
+ $create_fun$ ; $simple_create_fun$ ; $iter$ ; $map$ ; $map_poly$ ;
+ $and_f$ ; $or_f$ ; $to_list$ ;
+ module Direct : sig
+ $direct_iter$ ;
+ $direct_fold$ ;
+ end ;
+ >>
+ $ ;
end
>>
else
- <:sig_item< $getters_and_setters$ ;
- module Fields : sig
- $fields$
- end
+ <:sig_item<
+ $getters_and_setters$ ;
+ $ if private_
+ then <:sig_item< >>
+ else <:sig_item<
+ module Fields : sig
+ $fields$
+ end;
+ >>
+ $ ;
>>
;;
- let mani ~ty_name ~tps ty =
- match ty with
- | <:ctyp at loc< { $x$ } >> ->
- `Ok (record ~ty_name ~tps loc x)
- | _ -> `Error "the right hand side of the manifest must be a record"
-
let fields_of_ty_sig _loc ~ty_name ~tps ~rhs =
- let unsupported = (fun _ _ -> raise_unsupported ()) in
- Gen.switch_tp_def
- ~alias:unsupported
- ~sum:unsupported
- ~variants:unsupported
- ~mani:(fun (_:Loc.t) _tp1 tp2 -> mani ~ty_name ~tps tp2)
- ~nil:(fun _ -> raise_unsupported ())
- ~record:(fun loc ty -> `Ok (record ~ty_name ~tps loc ty))
- rhs
+ match rhs with
+ | <:ctyp at loc< $_$ == private { $flds$ } >>
+ | <:ctyp at loc< private { $flds$ } >> ->
+ `Ok (record ~ty_name ~private_:true ~tps loc flds)
+ | <:ctyp at loc< $_$ == { $flds$ } >>
+ | <:ctyp at loc< { $flds$ } >> ->
+ `Ok (record ~ty_name ~private_:false ~tps loc flds)
+ | _ -> raise_unsupported ()
let generate rec_ typedefs =
generate_at_least_once
@@ -293,7 +311,7 @@ module Gen_sig = struct
end
module Gen_struct = struct
- let fields _loc ty =
+ let fields ~private_ _loc ty =
let fields = Inspect.fields ty in
let rec_id =
match fields with
@@ -303,8 +321,8 @@ module Gen_struct = struct
let conv_field (res_getset, res_fields) (name, m, field_ty) =
let getter = <:str_item< value $lid:name$ _r__ = _r__.$lid:name$ >> in
let setter, setter_field =
- match m with
- | `Mutable ->
+ match m, private_ with
+ | `Mutable, false ->
let setter =
<:str_item<
value $lid:"set_" ^ name$ _r__ v__ = _r__.$lid:name$ := v__
@@ -312,7 +330,8 @@ module Gen_struct = struct
in
let setter_field = <:expr< Some $lid:"set_" ^ name$ >> in
setter, setter_field
- | `Immutable -> <:str_item< >>, <:expr< None >>
+ | `Mutable, true
+ | `Immutable, _ -> <:str_item< >>, <:expr< None >>
in
let field =
let e =
@@ -536,8 +555,8 @@ module Gen_struct = struct
>>
;;
- let record ~record_name _loc ty =
- let getter_and_setters, fields = fields _loc ty in
+ let record ~private_ ~record_name _loc ty =
+ let getter_and_setters, fields = fields ~private_ _loc ty in
let create = creation_fun _loc record_name ty in
let simple_create = simple_creation_fun _loc record_name ty in
let names =
@@ -558,39 +577,42 @@ module Gen_struct = struct
$getter_and_setters$ ;
module Fields = struct
value names = $names$ ;
- $fields$ ;
- $create$ ; $simple_create$ ; $iter$ ; $fold$ ; $map$ ; $map_poly$ ; $andf$ ; $orf$ ; $to_list$ ;
- module Direct = struct
- $direct_iter$ ;
- $direct_fold$ ;
- end ;
+ $ if private_
+ then <:str_item< >>
+ else <:str_item<
+ $fields$ ; $create$ ; $simple_create$ ; $iter$ ; $fold$ ; $map$ ;
+ $map_poly$ ; $andf$ ; $orf$ ; $to_list$ ;
+ module Direct = struct
+ $direct_iter$ ;
+ $direct_fold$ ;
+ end ;
+ >>
+ $ ;
end
>>
else
<:str_item<
$getter_and_setters$ ;
- module Fields = struct
- $fields$ ;
- end
+ $ if private_
+ then <:str_item< >>
+ else <:str_item<
+ module Fields = struct
+ $fields$ ;
+ end
+ >>
+ $ ;
>>
;;
- let mani ~record_name ty =
- match ty with
- | <:ctyp at loc< { $x$ } >> ->
- `Ok (record ~record_name loc x)
- | _ -> `Error "the right hand side of the manifest must be a record"
-
let fields_of_ty _loc ~ty_name:record_name ~tps:_ ~rhs =
- let unsupported = (fun _ _ -> raise_unsupported ()) in
- Gen.switch_tp_def
- ~alias: unsupported
- ~sum: unsupported
- ~variants: unsupported
- ~mani: (fun (_:Loc.t) _tp1 tp2 -> mani ~record_name tp2)
- ~nil: (fun _ -> raise_unsupported ())
- ~record: (fun loc ty -> `Ok (record ~record_name loc ty))
- rhs
+ match rhs with
+ | <:ctyp at loc< $_$ == private { $flds$ } >>
+ | <:ctyp at loc< private { $flds$ } >> ->
+ `Ok (record ~record_name ~private_:true loc flds)
+ | <:ctyp at loc< $_$ == { $flds$ } >>
+ | <:ctyp at loc< { $flds$ } >> ->
+ `Ok (record ~record_name ~private_:false loc flds)
+ | _ -> raise_unsupported ()
let generate rec_ typedefs =
generate_at_least_once
--
fieldslib packaging
More information about the Pkg-ocaml-maint-commits
mailing list