The following commit has been merged in the upstream branch: commit e8b28d80da697580fc7946a0ccc9a5f603acc103 Author: Stephane Glondu <st...@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@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@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 _______________________________________________ Pkg-ocaml-maint-commits mailing list Pkg-ocaml-maint-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits