[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:14 UTC 2013
The following commit has been merged in the upstream branch:
commit e8b28d80da697580fc7946a0ccc9a5f603acc103
Author: Stephane Glondu <steph at glondu.net>
Date: Sun Jun 23 22:03:39 2013 +0200
Imported Upstream version 108.07.00
diff --git a/README.txt b/README.txt
index c99578c..5d3ec57 100644
--- a/README.txt
+++ b/README.txt
@@ -107,7 +107,7 @@ price differences:
let use op = fun field ->
op (Field.get field a) (Field.get field b)
in
- let price_equal p1 p2 = abs_float (p1 -. p2) < 0.001 in
+ let price_equal p1 p2 = Float.abs (p1 -. p2) < 0.001 in
Fields.for_all
~dir:(use (=)) ~quantity:(use (=))
~price:(use price_equal) ~cancelled:(use (=))
diff --git a/THIRD-PARTY.txt b/THIRD-PARTY.txt
index 2d00db2..da8a772 100644
--- a/THIRD-PARTY.txt
+++ b/THIRD-PARTY.txt
@@ -2,8 +2,8 @@ The repository contains 3rd-party code in the following locations and
under the following licenses:
- type_conv, sexplib and bin_prot: based on Tywith, by Martin
- Sandin. License can be found in base/sexplib/LICENSE.Tywith,
- base/type_conv/LICENSE.Tywith, and base/bin_prot/LICENSE.Tywith.
+ Sandin. License can be found in base/sexplib/LICENSE-Tywith.txt,
+ base/type_conv/LICENSE-Tywith.txt, and base/bin_prot/LICENSE-Tywith.txt.
- Core's implementation of union-find: based on an implementation by
Henry Matthew Fluet, Suresh Jagannathan, and Stephen Weeks. License
diff --git a/_oasis b/_oasis
index c1260b3..e920d4a 100644
--- a/_oasis
+++ b/_oasis
@@ -2,7 +2,7 @@
OASISFormat: 0.3
OCamlVersion: >= 3.12.1
Name: fieldslib
-Version: 108.00.02
+Version: 108.07.00
Synopsis: OCaml record fields as first class values.
Authors: Jane street capital
Copyrights: (C) 2009-2011 Jane Street Capital LLC
diff --git a/lib/META b/lib/META
index 6efa429..0565a72 100644
--- a/lib/META
+++ b/lib/META
@@ -1,6 +1,6 @@
# OASIS_START
-# DO NOT EDIT (digest: 6418aa3af91f18a74730d709ce8ea16b)
-version = "108.00.02"
+# DO NOT EDIT (digest: 1c5fae1fd197461ceef16312c983cfa5)
+version = "108.07.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 = "108.00.02"
+ version = "108.07.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 1f5daaa..f31da07 100644
--- a/lib_test/fields_test.ml
+++ b/lib_test/fields_test.ml
@@ -1 +1,15 @@
-type t = {x:int;w:int} with fields
+module Simple = struct
+ type t = {x:int;w:int} with fields
+ let _ = x
+ let _ = w
+end
+
+module Rec = struct
+ type a = {
+ something1 : b;
+ }
+ and b = A of a
+ with fields
+
+ let _ = something1
+end
diff --git a/myocamlbuild.ml b/myocamlbuild.ml
index 4cb4364..79fe327 100644
--- a/myocamlbuild.ml
+++ b/myocamlbuild.ml
@@ -1,7 +1,7 @@
(* OASIS_START *)
-(* DO NOT EDIT (digest: 7068fb54fba0422d669e85990e116476) *)
+(* DO NOT EDIT (digest: 14c30b8858baa68e5c490dd451e7c56b) *)
module OASISGettext = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISGettext.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISGettext.ml" *)
let ns_ str =
str
@@ -24,7 +24,7 @@ module OASISGettext = struct
end
module OASISExpr = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISExpr.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISExpr.ml" *)
@@ -116,7 +116,7 @@ end
# 117 "myocamlbuild.ml"
module BaseEnvLight = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseEnvLight.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseEnvLight.ml" *)
module MapString = Map.Make(String)
@@ -214,7 +214,7 @@ end
# 215 "myocamlbuild.ml"
module MyOCamlbuildFindlib = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
(** OCamlbuild extension, copied from
* http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild
@@ -323,7 +323,7 @@ module MyOCamlbuildFindlib = struct
end
module MyOCamlbuildBase = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
(** Base functions for writing myocamlbuild.ml
@author Sylvain Le Gall
@@ -339,7 +339,7 @@ module MyOCamlbuildBase = struct
type name = string
type tag = string
-(* # 56 "/tmp/oasis-0.3.0~rc5/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
+(* # 56 "/tmp/oasis-0.3.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
type t =
{
@@ -395,78 +395,6 @@ module MyOCamlbuildBase = struct
Options.ext_dll, "ext_dll";
]
- | Before_rules ->
- (* TODO: move this into its own file and conditionnaly include it, if
- * needed.
- *)
- (* OCaml cmxs rules: cmxs available in ocamlopt but not ocamlbuild.
- Copied from ocaml_specific.ml in ocamlbuild sources. *)
- let has_native_dynlink =
- try
- bool_of_string (BaseEnvLight.var_get "native_dynlink" env)
- with Not_found ->
- false
- in
- if has_native_dynlink && String.sub Sys.ocaml_version 0 4 = "3.11" then
- begin
- let ext_lib = !Options.ext_lib in
- let ext_obj = !Options.ext_obj in
- let ext_dll = !Options.ext_dll in
- let x_o = "%"-.-ext_obj in
- let x_a = "%"-.-ext_lib in
- let x_dll = "%"-.-ext_dll in
- let x_p_o = "%.p"-.-ext_obj in
- let x_p_a = "%.p"-.-ext_lib in
- let x_p_dll = "%.p"-.-ext_dll in
-
- rule "ocaml: mldylib & p.cmx* & p.o* -> p.cmxs & p.so"
- ~tags:["ocaml"; "native"; "profile"; "shared"; "library"]
- ~prods:["%.p.cmxs"; x_p_dll]
- ~dep:"%.mldylib"
- (OC.native_profile_shared_library_link_mldylib
- "%.mldylib" "%.p.cmxs");
-
- rule "ocaml: mldylib & cmx* & o* -> cmxs & so"
- ~tags:["ocaml"; "native"; "shared"; "library"]
- ~prods:["%.cmxs"; x_dll]
- ~dep:"%.mldylib"
- (OC.native_shared_library_link_mldylib
- "%.mldylib" "%.cmxs");
-
- rule "ocaml: p.cmx & p.o -> p.cmxs & p.so"
- ~tags:["ocaml"; "native"; "profile"; "shared"; "library"]
- ~prods:["%.p.cmxs"; x_p_dll]
- ~deps:["%.p.cmx"; x_p_o]
- (OC.native_shared_library_link ~tags:["profile"]
- "%.p.cmx" "%.p.cmxs");
-
- rule "ocaml: p.cmxa & p.a -> p.cmxs & p.so"
- ~tags:["ocaml"; "native"; "profile"; "shared"; "library"]
- ~prods:["%.p.cmxs"; x_p_dll]
- ~deps:["%.p.cmxa"; x_p_a]
- (OC.native_shared_library_link ~tags:["profile"; "linkall"]
- "%.p.cmxa" "%.p.cmxs");
-
- rule "ocaml: cmx & o -> cmxs"
- ~tags:["ocaml"; "native"; "shared"; "library"]
- ~prods:["%.cmxs"]
- ~deps:["%.cmx"; x_o]
- (OC.native_shared_library_link "%.cmx" "%.cmxs");
-
- rule "ocaml: cmx & o -> cmxs & so"
- ~tags:["ocaml"; "native"; "shared"; "library"]
- ~prods:["%.cmxs"; x_dll]
- ~deps:["%.cmx"; x_o]
- (OC.native_shared_library_link "%.cmx" "%.cmxs");
-
- rule "ocaml: cmxa & a -> cmxs & so"
- ~tags:["ocaml"; "native"; "shared"; "library"]
- ~prods:["%.cmxs"; x_dll]
- ~deps:["%.cmxa"; x_a]
- (OC.native_shared_library_link ~tags:["linkall"]
- "%.cmxa" "%.cmxs");
- end
-
| After_rules ->
(* Declare OCaml libraries *)
List.iter
@@ -507,7 +435,7 @@ module MyOCamlbuildBase = struct
(* When ocaml link something that use the C library, then one
need that file to be up to date.
*)
- dep ["link"; "ocaml"; "program"; tag_libstubs lib]
+ dep ["link"; "ocaml"; "program"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
dep ["compile"; "ocaml"; "program"; tag_libstubs lib]
@@ -545,7 +473,7 @@ module MyOCamlbuildBase = struct
end
-# 548 "myocamlbuild.ml"
+# 476 "myocamlbuild.ml"
open Ocamlbuild_plugin;;
let package_default =
{
@@ -559,7 +487,7 @@ let package_default =
let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;;
-# 563 "myocamlbuild.ml"
+# 491 "myocamlbuild.ml"
(* OASIS_STOP *)
@@ -567,6 +495,19 @@ let protectx x ~f ~finally =
let r = try f x with exn -> finally x; raise exn in
finally x; r
+let rm_rf dir =
+ ignore (Printf.ksprintf Sys.command "/bin/rm -rf %S" dir : int)
+
+let temp_dir ?(in_dir = Filename.temp_dir_name) prefix suffix =
+ let base = Filename.concat in_dir prefix in
+ let rec loop i =
+ let dir = base ^ string_of_int i ^ suffix in
+ let ret = Printf.ksprintf Sys.command "/bin/mkdir %S 2>/dev/null" dir in
+ if ret = 0 then dir
+ else if Sys.file_exists dir then loop (i + 1)
+ else failwith ("mkdir failed on " ^ dir)
+ in loop 0
+
let read_lines ic =
let rec loop acc =
match try Some (input_line ic) with End_of_file -> None with
diff --git a/sample/test.ml b/sample/test.ml
index bfbcc03..501d62e 100644
--- a/sample/test.ml
+++ b/sample/test.ml
@@ -1,6 +1,3 @@
-open Fieldslib
-open Printf
-open StdLabels
type ('a,'b) t = {
dir : 'a * 'b;
diff --git a/setup.ml b/setup.ml
index c7398b7..9b6dc39 100644
--- a/setup.ml
+++ b/setup.ml
@@ -1,14 +1,14 @@
-(* setup.ml generated for the first time by OASIS v0.3.0~rc5 *)
+(* setup.ml generated for the first time by OASIS v0.3.0 *)
(* OASIS_START *)
-(* DO NOT EDIT (digest: 28bd53de529beb7f3824c9db7cfe453c) *)
+(* DO NOT EDIT (digest: db2b0894d90ed4080b091edb46b8d3e1) *)
(*
- Regenerated by OASIS v0.3.0~rc5
+ Regenerated by OASIS v0.3.0
Visit http://oasis.forge.ocamlcore.org for more information and
documentation about functions used in this file.
*)
module OASISGettext = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISGettext.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISGettext.ml" *)
let ns_ str =
str
@@ -31,7 +31,7 @@ module OASISGettext = struct
end
module OASISContext = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISContext.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISContext.ml" *)
open OASISGettext
@@ -92,7 +92,7 @@ module OASISContext = struct
end
module OASISString = struct
-(* # 1 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISString.ml" *)
+(* # 1 "/tmp/oasis-0.3.0/src/oasis/OASISString.ml" *)
@@ -217,7 +217,7 @@ module OASISString = struct
end
module OASISUtils = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISUtils.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISUtils.ml" *)
open OASISGettext
@@ -312,7 +312,7 @@ module OASISUtils = struct
end
module PropList = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/PropList.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/PropList.ml" *)
open OASISGettext
@@ -352,7 +352,7 @@ module PropList = struct
let clear t =
Hashtbl.clear t
-(* # 71 "/tmp/oasis-0.3.0~rc5/src/oasis/PropList.ml" *)
+(* # 71 "/tmp/oasis-0.3.0/src/oasis/PropList.ml" *)
end
module Schema =
@@ -593,7 +593,7 @@ module PropList = struct
end
module OASISMessage = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISMessage.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISMessage.ml" *)
open OASISGettext
@@ -632,7 +632,7 @@ module OASISMessage = struct
end
module OASISVersion = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISVersion.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISVersion.ml" *)
open OASISGettext
@@ -811,7 +811,7 @@ module OASISVersion = struct
end
module OASISLicense = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISLicense.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISLicense.ml" *)
(** License for _oasis fields
@author Sylvain Le Gall
@@ -851,7 +851,7 @@ module OASISLicense = struct
end
module OASISExpr = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISExpr.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISExpr.ml" *)
@@ -941,7 +941,7 @@ module OASISExpr = struct
end
module OASISTypes = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISTypes.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISTypes.ml" *)
@@ -1018,7 +1018,7 @@ module OASISTypes = struct
type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list
-(* # 102 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISTypes.ml" *)
+(* # 102 "/tmp/oasis-0.3.0/src/oasis/OASISTypes.ml" *)
type 'a conditional = 'a OASISExpr.choices
@@ -1176,7 +1176,7 @@ module OASISTypes = struct
end
module OASISUnixPath = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISUnixPath.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISUnixPath.ml" *)
type unix_filename = string
type unix_dirname = string
@@ -1188,8 +1188,11 @@ module OASISUnixPath = struct
let parent_dir_name = ".."
+ let is_current_dir fn =
+ fn = current_dir_name || fn = ""
+
let concat f1 f2 =
- if f1 = current_dir_name || f1 = "" then
+ if is_current_dir f1 then
f2
else
let f1' =
@@ -1257,7 +1260,7 @@ module OASISUnixPath = struct
end
module OASISHostPath = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISHostPath.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISHostPath.ml" *)
open Filename
@@ -1290,7 +1293,7 @@ module OASISHostPath = struct
end
module OASISSection = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISSection.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISSection.ml" *)
open OASISTypes
@@ -1369,12 +1372,12 @@ module OASISSection = struct
end
module OASISBuildSection = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISBuildSection.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISBuildSection.ml" *)
end
module OASISExecutable = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISExecutable.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISExecutable.ml" *)
open OASISTypes
@@ -1405,7 +1408,7 @@ module OASISExecutable = struct
end
module OASISLibrary = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISLibrary.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISLibrary.ml" *)
open OASISTypes
open OASISUtils
@@ -1556,11 +1559,13 @@ module OASISLibrary = struct
add_pack_header ([cs.cs_name^".cma"] :: acc)
in
let native acc =
- let acc = [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc in
- add_pack_header
- (if has_native_dynlink then
- [cs.cs_name^".cmxs"] :: acc
- else acc)
+ let acc =
+ add_pack_header
+ (if has_native_dynlink then
+ [cs.cs_name^".cmxs"] :: acc
+ else acc)
+ in
+ [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc
in
match bs.bs_compiled_object with
| Native ->
@@ -1836,38 +1841,54 @@ module OASISLibrary = struct
end
module OASISFlag = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISFlag.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISFlag.ml" *)
end
module OASISPackage = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISPackage.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISPackage.ml" *)
end
module OASISSourceRepository = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISSourceRepository.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISSourceRepository.ml" *)
end
module OASISTest = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISTest.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISTest.ml" *)
end
module OASISDocument = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISDocument.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISDocument.ml" *)
end
module OASISExec = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISExec.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISExec.ml" *)
open OASISGettext
open OASISUtils
open OASISMessage
- let run ~ctxt ?f_exit_code cmd args =
+ (* TODO: I don't like this quote, it is there because $(rm) foo expands to
+ * 'rm -f' foo...
+ *)
+ let run ~ctxt ?f_exit_code ?(quote=true) cmd args =
+ let cmd =
+ if quote then
+ if Sys.os_type = "Win32" then
+ if String.contains cmd ' ' then
+ (* Double the 1st double quote... win32... sigh *)
+ "\""^(Filename.quote cmd)
+ else
+ cmd
+ else
+ Filename.quote cmd
+ else
+ cmd
+ in
let cmdline =
String.concat " " (cmd :: args)
in
@@ -1923,7 +1944,7 @@ module OASISExec = struct
end
module OASISFileUtil = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/oasis/OASISFileUtil.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/oasis/OASISFileUtil.ml" *)
open OASISGettext
@@ -2118,9 +2139,9 @@ module OASISFileUtil = struct
end
-# 2121 "setup.ml"
+# 2142 "setup.ml"
module BaseEnvLight = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseEnvLight.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseEnvLight.ml" *)
module MapString = Map.Make(String)
@@ -2216,9 +2237,9 @@ module BaseEnvLight = struct
end
-# 2219 "setup.ml"
+# 2240 "setup.ml"
module BaseContext = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseContext.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseContext.ml" *)
open OASISContext
@@ -2229,7 +2250,7 @@ module BaseContext = struct
end
module BaseMessage = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseMessage.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseMessage.ml" *)
(** Message to user, overrid for Base
@author Sylvain Le Gall
@@ -2248,7 +2269,7 @@ module BaseMessage = struct
end
module BaseEnv = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseEnv.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseEnv.ml" *)
open OASISGettext
open OASISUtils
@@ -2708,7 +2729,7 @@ module BaseEnv = struct
end
module BaseArgExt = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseArgExt.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseArgExt.ml" *)
open OASISUtils
open OASISGettext
@@ -2736,7 +2757,7 @@ module BaseArgExt = struct
end
module BaseCheck = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseCheck.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseCheck.ml" *)
open BaseEnv
open BaseMessage
@@ -2862,7 +2883,7 @@ module BaseCheck = struct
end
module BaseOCamlcConfig = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseOCamlcConfig.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseOCamlcConfig.ml" *)
open BaseEnv
@@ -2978,7 +2999,7 @@ module BaseOCamlcConfig = struct
end
module BaseStandardVar = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseStandardVar.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseStandardVar.ml" *)
open OASISGettext
@@ -3053,6 +3074,23 @@ module BaseStandardVar = struct
let default_executable_name = c "default_executable_name"
let systhread_supported = c "systhread_supported"
+ let flexlink =
+ BaseCheck.prog "flexlink"
+
+ let flexdll_version =
+ var_define
+ ~short_desc:(fun () -> "FlexDLL version (Win32)")
+ "flexdll_version"
+ (fun () ->
+ let lst =
+ OASISExec.run_read_output ~ctxt:!BaseContext.default
+ (flexlink ()) ["-help"]
+ in
+ match lst with
+ | line :: _ ->
+ Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver)
+ | [] ->
+ raise Not_found)
(**/**)
let p name hlp dflt =
@@ -3274,23 +3312,47 @@ module BaseStandardVar = struct
"native_dynlink"
(fun () ->
let res =
- if bool_of_string (is_native ()) then
- begin
- let ocamlfind = ocamlfind () in
- try
- let fn =
- OASISExec.run_read_one_line
- ~ctxt:!BaseContext.default
- ocamlfind
- ["query"; "-predicates"; "native"; "dynlink";
- "-format"; "%d/%a"]
- in
- Sys.file_exists fn
- with _ ->
- false
- end
- else
- false
+ let ocaml_lt_312 () =
+ OASISVersion.comparator_apply
+ (OASISVersion.version_of_string (ocaml_version ()))
+ (OASISVersion.VLesser
+ (OASISVersion.version_of_string "3.12.0"))
+ in
+ let flexdll_lt_030 () =
+ OASISVersion.comparator_apply
+ (OASISVersion.version_of_string (flexdll_version ()))
+ (OASISVersion.VLesser
+ (OASISVersion.version_of_string "0.30"))
+ in
+ let has_native_dynlink =
+ let ocamlfind = ocamlfind () in
+ try
+ let fn =
+ OASISExec.run_read_one_line
+ ~ctxt:!BaseContext.default
+ ocamlfind
+ ["query"; "-predicates"; "native"; "dynlink";
+ "-format"; "%d/%a"]
+ in
+ Sys.file_exists fn
+ with _ ->
+ false
+ in
+ if not has_native_dynlink then
+ false
+ else if ocaml_lt_312 () then
+ false
+ else if (os_type () = "Win32" || os_type () = "Cygwin")
+ && flexdll_lt_030 () then
+ begin
+ BaseMessage.warning
+ (f_ ".cmxs generation disabled because FlexDLL needs to be \
+ at least 0.30. Please upgrade FlexDLL from %s to 0.30.")
+ (flexdll_version ());
+ false
+ end
+ else
+ true
in
string_of_bool res)
@@ -3301,7 +3363,7 @@ module BaseStandardVar = struct
end
module BaseFileAB = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseFileAB.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseFileAB.ml" *)
open BaseEnv
open OASISGettext
@@ -3349,7 +3411,7 @@ module BaseFileAB = struct
end
module BaseLog = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseLog.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseLog.ml" *)
open OASISUtils
@@ -3468,7 +3530,7 @@ module BaseLog = struct
end
module BaseBuilt = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseBuilt.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseBuilt.ml" *)
open OASISTypes
open OASISGettext
@@ -3615,7 +3677,7 @@ module BaseBuilt = struct
end
module BaseCustom = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseCustom.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseCustom.ml" *)
open BaseEnv
open BaseMessage
@@ -3623,7 +3685,7 @@ module BaseCustom = struct
open OASISGettext
let run cmd args extra_args =
- OASISExec.run ~ctxt:!BaseContext.default
+ OASISExec.run ~ctxt:!BaseContext.default ~quote:false
(var_expand cmd)
(List.map
var_expand
@@ -3665,7 +3727,7 @@ module BaseCustom = struct
end
module BaseDynVar = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseDynVar.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseDynVar.ml" *)
open OASISTypes
@@ -3712,7 +3774,7 @@ module BaseDynVar = struct
end
module BaseTest = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseTest.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseTest.ml" *)
open BaseEnv
open BaseMessage
@@ -3802,7 +3864,7 @@ module BaseTest = struct
end
module BaseDoc = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseDoc.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseDoc.ml" *)
open BaseEnv
open BaseMessage
@@ -3837,7 +3899,7 @@ module BaseDoc = struct
end
module BaseSetup = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/base/BaseSetup.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/base/BaseSetup.ml" *)
open BaseEnv
open BaseMessage
@@ -4415,9 +4477,9 @@ module BaseSetup = struct
end
-# 4418 "setup.ml"
+# 4480 "setup.ml"
module InternalConfigurePlugin = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/plugins/internal/InternalConfigurePlugin.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/plugins/internal/InternalConfigurePlugin.ml" *)
(** Configure using internal scheme
@author Sylvain Le Gall
@@ -4595,6 +4657,17 @@ module InternalConfigurePlugin = struct
()
end;
+ (* FlexDLL *)
+ if BaseStandardVar.os_type () = "Win32" ||
+ BaseStandardVar.os_type () = "Cygwin" then
+ begin
+ try
+ var_ignore_eval BaseStandardVar.flexlink
+ with e ->
+ warn_exception e;
+ add_errors (f_ "Cannot find 'flexlink'")
+ end;
+
(* Check build depends *)
List.iter
(function
@@ -4648,7 +4721,7 @@ module InternalConfigurePlugin = struct
end
module InternalInstallPlugin = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/plugins/internal/InternalInstallPlugin.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/plugins/internal/InternalInstallPlugin.ml" *)
(** Install using internal scheme
@author Sylvain Le Gall
@@ -4680,6 +4753,71 @@ module InternalInstallPlugin = struct
let install_findlib_ev =
"install-findlib"
+ let win32_max_command_line_length = 8000
+
+ let split_install_command ocamlfind findlib_name meta files =
+ if Sys.os_type = "Win32" then
+ (* Arguments for the first command: *)
+ let first_args = ["install"; findlib_name; meta] in
+ (* Arguments for remaining commands: *)
+ let other_args = ["install"; findlib_name; "-add"] in
+ (* Extract as much files as possible from [files], [len] is
+ the current command line length: *)
+ let rec get_files len acc files =
+ match files with
+ | [] ->
+ (List.rev acc, [])
+ | file :: rest ->
+ let len = len + 1 + String.length file in
+ if len > win32_max_command_line_length then
+ (List.rev acc, files)
+ else
+ get_files len (file :: acc) rest
+ in
+ (* Split the command into several commands. *)
+ let rec split args files =
+ match files with
+ | [] ->
+ []
+ | _ ->
+ (* Length of "ocamlfind install <lib> [META|-add]" *)
+ let len =
+ List.fold_left
+ (fun len arg ->
+ len + 1 (* for the space *) + String.length arg)
+ (String.length ocamlfind)
+ args
+ in
+ match get_files len [] files with
+ | ([], _) ->
+ failwith (s_ "Command line too long.")
+ | (firsts, others) ->
+ let cmd = args @ firsts in
+ (* Use -add for remaining commands: *)
+ let () =
+ let findlib_ge_132 =
+ OASISVersion.comparator_apply
+ (OASISVersion.version_of_string
+ (BaseStandardVar.findlib_version ()))
+ (OASISVersion.VGreaterEqual
+ (OASISVersion.version_of_string "1.3.2"))
+ in
+ if not findlib_ge_132 then
+ failwithf
+ (f_ "Installing the library %s require to use the flag \
+ '-add' of ocamlfind because the command line is too \
+ long. This flag is only available for findlib 1.3.2. \
+ Please upgrade findlib from %s to 1.3.2")
+ findlib_name (BaseStandardVar.findlib_version ())
+ in
+ let cmds = split other_args others in
+ cmd :: cmds
+ in
+ (* The first command does not use -add: *)
+ split first_args files
+ else
+ ["install" :: findlib_name :: meta :: files]
+
let install pkg argv =
let in_destdir =
@@ -4912,8 +5050,17 @@ module InternalInstallPlugin = struct
info
(f_ "Installing findlib library '%s'")
findlib_name;
- OASISExec.run ~ctxt:!BaseContext.default
- (ocamlfind ()) ("install" :: findlib_name :: meta :: files);
+ let ocamlfind = ocamlfind () in
+ let commands =
+ split_install_command
+ ocamlfind
+ findlib_name
+ meta
+ files
+ in
+ List.iter
+ (OASISExec.run ~ctxt:!BaseContext.default ocamlfind)
+ commands;
BaseLog.register install_findlib_ev findlib_name
end;
@@ -4948,7 +5095,7 @@ module InternalInstallPlugin = struct
cs.cs_name
(fun () fn ->
install_file
- ~tgt_fn:cs.cs_name
+ ~tgt_fn:(cs.cs_name ^ ext_program ())
fn
bindir)
();
@@ -5083,9 +5230,9 @@ module InternalInstallPlugin = struct
end
-# 5086 "setup.ml"
+# 5233 "setup.ml"
module OCamlbuildCommon = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
(** Functions common to OCamlbuild build and doc plugin
*)
@@ -5187,7 +5334,7 @@ module OCamlbuildCommon = struct
end
module OCamlbuildPlugin = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *)
(** Build using ocamlbuild
@author Sylvain Le Gall
@@ -5360,7 +5507,7 @@ module OCamlbuildPlugin = struct
end
module OCamlbuildDocPlugin = struct
-(* # 21 "/tmp/oasis-0.3.0~rc5/src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" *)
+(* # 21 "/tmp/oasis-0.3.0/src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" *)
(* Create documentation using ocamlbuild .odocl files
@author Sylvain Le Gall
@@ -5408,7 +5555,7 @@ module OCamlbuildDocPlugin = struct
end
-# 5411 "setup.ml"
+# 5558 "setup.ml"
open OASISTypes;;
let setup_t =
@@ -5431,7 +5578,7 @@ let setup_t =
ocaml_version = Some (OASISVersion.VGreaterEqual "3.12.1");
findlib_version = None;
name = "fieldslib";
- version = "108.00.02";
+ version = "108.07.00";
license =
OASISLicense.DEP5License
(OASISLicense.DEP5Unit
@@ -5590,8 +5737,8 @@ let setup_t =
plugin_data = [];
};
oasis_fn = Some "_oasis";
- oasis_version = "0.3.0~rc5";
- oasis_digest = Some "'\1310\005,%\018\204uU\189lFZ\203{";
+ oasis_version = "0.3.0";
+ oasis_digest = Some "G\028w\231Z\018*\249vm\017c!F\213:";
oasis_exec = None;
oasis_setup_args = [];
setup_update = false;
@@ -5599,6 +5746,6 @@ let setup_t =
let setup () = BaseSetup.setup setup_t;;
-# 5603 "setup.ml"
+# 5750 "setup.ml"
(* OASIS_STOP *)
let () = setup ();;
diff --git a/syntax/pa_fields_conv.ml b/syntax/pa_fields_conv.ml
index 1f11c4f..15f7e7c 100644
--- a/syntax/pa_fields_conv.ml
+++ b/syntax/pa_fields_conv.ml
@@ -1,3 +1,8 @@
+(* Generated code should depend on the environment in scope as little as
+ possible. E.g. rather than [foo = []] do [match foo with [] ->], to eliminate the
+ use of [=]. It is especially important to not use polymorphic comparisons, since we
+ are moving more and more to code that doesn't have them in scope. *)
+
module List = ListLabels
open Printf
open Camlp4.PreCast
@@ -37,8 +42,30 @@ module Inspect = struct
let fields ty = List.map (Ast.list_of_ctyp ty []) ~f:field
end
+let generate_at_least_once rec_ ~f ~combine typedefs =
+ if not rec_ then
+ failwith "nonrec is not compatible with the `fields' preprocessor";
+ let rec aux = function
+ | Ast.TyDcl (_loc, ty_name, tps, rhs, _) -> f _loc ~ty_name ~tps ~rhs
+ | Ast.TyAnd (_loc, td1, td2) -> (
+ match aux td1, aux td2 with
+ | `Ok str1, `Ok str2 -> `Ok (combine _loc str1 str2)
+ | `Ok str1, `Error _ -> `Ok str1
+ | `Error _, `Ok str2 -> `Ok str2
+ | `Error _, `Error _ ->
+ `Error "'with fields' can only be applied on type definitions in which at \
+ least one type definition is a record"
+ )
+ | Ast.TyNil _loc ->
+ `Error "'with fields': unexpected TyNil without a TyAnd somewhere around!!"
+ | _ -> assert false in
+
+ match aux typedefs with
+ | `Ok res -> res
+ | `Error s -> failwith s
+
let raise_unsupported () =
- failwith "Unsupported use of fields (you can only use it on records)."
+ `Error "Unsupported use of fields (you can only use it on records)."
module Gen_sig = struct
let apply_type _loc ~ty_name ~tps =
@@ -239,23 +266,30 @@ module Gen_sig = struct
>>
;;
+ 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:unsupported
+ ~mani:(fun (_:Loc.t) _tp1 tp2 -> mani ~ty_name ~tps tp2)
~nil:(fun _ -> raise_unsupported ())
- ~record:(record ~ty_name ~tps)
+ ~record:(fun loc ty -> `Ok (record ~ty_name ~tps loc ty))
rhs
- let generate = function
- | Ast.TyDcl (_loc, ty_name, tps, rhs, _) -> fields_of_ty_sig _loc ~ty_name ~tps ~rhs
- | Ast.TyAnd (_loc, _, _) as tds ->
- ignore (_loc, tds);
- failwith "Not supported"
- | _ -> assert false
+ let generate rec_ typedefs =
+ generate_at_least_once
+ rec_
+ ~f:fields_of_ty_sig
+ ~combine:(fun _loc item1 item2 -> <:sig_item< $item1$; $item2$; >>)
+ typedefs
+
end
module Gen_struct = struct
@@ -351,7 +385,6 @@ module Gen_struct = struct
let f = Create.lambda _loc (patterns @ [ <:patt< compile_acc__ >> ]) body in
<:str_item<
value make_creator = $f$;
- value _ = make_creator
>>
;;
@@ -366,7 +399,6 @@ module Gen_struct = struct
let f = Create.lambda _loc patterns f in
<:str_item<
value create = $f$;
- value _ = create
>>
;;
@@ -382,7 +414,6 @@ module Gen_struct = struct
( init :: patterns ) body in
<:str_item<
value fold = $lambda$;
- value _ = fold
>>
;;
@@ -396,7 +427,6 @@ module Gen_struct = struct
let lambda = Create.lambda _loc patterns body in
<:str_item<
value for_all = $lambda$;
- value _ = for_all
>>
;;
@@ -410,7 +440,6 @@ module Gen_struct = struct
let lambda = Create.lambda _loc patterns body in
<:str_item<
value exists = $lambda$;
- value _ = exists
>>
;;
@@ -427,7 +456,6 @@ module Gen_struct = struct
(patterns) body in
<:str_item<
value iter = $lambda$;
- value _ = iter
>>
;;
@@ -446,7 +474,6 @@ module Gen_struct = struct
let lambda = Create.lambda _loc ( <:patt< record__ >> :: patterns) body in
<:str_item<
value iter = $lambda$;
- value _ = iter
>>
;;
@@ -465,7 +492,6 @@ module Gen_struct = struct
( <:patt< record__ >> :: init :: patterns ) body in
<:str_item<
value fold = $lambda$;
- value _ = fold
>>
;;
@@ -478,7 +504,6 @@ module Gen_struct = struct
let f = Create.lambda _loc patterns body in
<:str_item<
value map = $f$;
- value _ = map
>>
;;
@@ -492,7 +517,6 @@ module Gen_struct = struct
let f = Create.lambda _loc patterns body in
<:str_item<
value to_list = $f$;
- value _ = to_list
>>
;;
@@ -509,7 +533,6 @@ module Gen_struct = struct
in
<:str_item<
value map_poly record__ = $body$;
- value _ = map_poly
>>
;;
@@ -535,7 +558,6 @@ module Gen_struct = struct
$getter_and_setters$ ;
module Fields = struct
value names = $names$ ;
- value _ = names ;
$fields$ ;
$create$ ; $simple_create$ ; $iter$ ; $fold$ ; $map$ ; $map_poly$ ; $andf$ ; $orf$ ; $to_list$ ;
module Direct = struct
@@ -556,10 +578,10 @@ module Gen_struct = struct
let mani ~record_name ty =
match ty with
| <:ctyp at loc< { $x$ } >> ->
- record ~record_name loc x
- | _ -> failwith "the right hand side of the manifest must be a record"
+ `Ok (record ~record_name loc x)
+ | _ -> `Error "the right hand side of the manifest must be a record"
- let fields_of_ty _loc ~record_name ~tps:_ ~rhs =
+ let fields_of_ty _loc ~ty_name:record_name ~tps:_ ~rhs =
let unsupported = (fun _ _ -> raise_unsupported ()) in
Gen.switch_tp_def
~alias: unsupported
@@ -567,15 +589,15 @@ module Gen_struct = struct
~variants: unsupported
~mani: (fun (_:Loc.t) _tp1 tp2 -> mani ~record_name tp2)
~nil: (fun _ -> raise_unsupported ())
- ~record: (record ~record_name)
+ ~record: (fun loc ty -> `Ok (record ~record_name loc ty))
rhs
- let generate = function
- | Ast.TyDcl (_loc, name, tps, rhs, _) -> fields_of_ty _loc ~record_name:name ~tps ~rhs
- | Ast.TyAnd (_loc, _, _) as tds ->
- ignore (_loc, tds);
- failwith "Not supported"
- | _ -> assert false
+ let generate rec_ typedefs =
+ generate_at_least_once
+ rec_
+ ~f:fields_of_ty
+ ~combine:(fun _loc item1 item2 -> <:str_item< $item1$; $item2$; >>)
+ typedefs
end
let () = add_generator "fields" Gen_struct.generate
diff --git a/syntax/run.sh b/syntax/run.sh
deleted file mode 100755
index 1f73581..0000000
--- a/syntax/run.sh
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/usr/bin/env bash
-set -e -u
-jomake --command=camlp4orf -I "$(hg root)/lib" pa_type_conv.cmo pa_fields_conv.cmo $@
--
fieldslib packaging
More information about the Pkg-ocaml-maint-commits
mailing list