Skip to content

Commit

Permalink
merge
Browse files Browse the repository at this point in the history
  • Loading branch information
ysulsky committed May 14, 2012
2 parents b8a9aa3 + 73fb33f commit e8bbaa4
Show file tree
Hide file tree
Showing 36 changed files with 876 additions and 925 deletions.
2 changes: 2 additions & 0 deletions .hgignore
Expand Up @@ -257,6 +257,7 @@ glob:base/sexplib/_build
glob:base/sexplib/_oasis
glob:base/sexplib/_tags
glob:base/sexplib/configure
glob:base/sexplib/conv_test.byte
glob:base/sexplib/lib/META
glob:base/sexplib/lib/lexer.ml
glob:base/sexplib/lib/parser.ml
Expand All @@ -269,6 +270,7 @@ glob:base/sexplib/myocamlbuild.ml
glob:base/sexplib/setup.data
glob:base/sexplib/setup.log
glob:base/sexplib/setup.ml
glob:base/sexplib/sexp_test.byte
glob:base/sexplib/syntax/pa_sexp_conv.mllib
glob:base/sexplib/top/sexplib_top.mllib
glob:base/type_conv/INSTALL
Expand Down
34 changes: 18 additions & 16 deletions base/async/unix/lib/reader.ml
Expand Up @@ -418,40 +418,42 @@ let space = Bigstring.of_string " "

let gen_read_sexp ?parse_pos t parse =
Deferred.create (fun result ->
let rec loop ~ws_only parse_fun =
let rec loop ~cont_state parse_fun =
nonempty_buffer t (function
| `Eof ->
if ws_only then Ivar.fill result `Eof
else begin
(* The sexp parser doesn't know that a token ends at EOF, so we add a space to
be sure. *)
begin
(* The sexp parser doesn't know that a token ends at EOF, so we
add a space to be sure. *)
match parse_fun ~pos:0 ~len:1 space with
| Sexp.Done (sexp, parse_pos) ->
Ivar.fill result (`Ok (sexp, parse_pos))
Ivar.fill result (`Ok (sexp, parse_pos))
| Sexp.Cont (Sexp.Cont_state.Parsing_whitespace, _) ->
Ivar.fill result `Eof
| Sexp.Cont _ ->
failwiths "Reader.read_sexp got unexpected eof" t <:sexp_of< t >>
failwiths "Reader.read_sexp got unexpected eof"
t <:sexp_of< t >>
end
| `Ok ->
match parse_fun ~pos:t.pos ~len:t.available t.buf with
| Sexp.Done (sexp, parse_pos) ->
consume t (parse_pos.Sexp.Parse_pos.buf_pos - t.pos);
Ivar.fill result (`Ok (sexp, parse_pos));
| Sexp.Cont (ws_only, parse_fun) ->
t.available <- 0;
loop ~ws_only parse_fun)
consume t (parse_pos.Sexp.Parse_pos.buf_pos - t.pos);
Ivar.fill result (`Ok (sexp, parse_pos));
| Sexp.Cont (cont_state, parse_fun) ->
t.available <- 0;
loop ~cont_state parse_fun)
in
let parse ~pos ~len buf =
(* [parse_pos] will be threaded through the entire reading process by the sexplib
code. Every occurrence of [parse_pos] above will be identical to the [parse_pos]
defined here. *)
(* [parse_pos] will be threaded through the entire reading process by
the sexplib code. Every occurrence of [parse_pos] above will be
identical to the [parse_pos] defined here. *)
let parse_pos =
match parse_pos with
| None -> Sexp.Parse_pos.create ~buf_pos:pos ()
| Some parse_pos -> Sexp.Parse_pos.with_buf_pos parse_pos pos
in
parse ?parse_pos:(Some parse_pos) ?len:(Some len) buf
in
loop ~ws_only:true parse)
loop ~cont_state:Sexp.Cont_state.Parsing_whitespace parse)
;;

type 'a read = ?parse_pos : Sexp.Parse_pos.t -> 'a
Expand Down
18 changes: 18 additions & 0 deletions base/bin_prot/lib/bin_prot.odocl
@@ -0,0 +1,18 @@
# OASIS_START
# DO NOT EDIT (digest: 587ff1270b3446e9490aea8b3ff16a98)
Binable
Nat0
Common
Unsafe_common
Unsafe_write_c
Unsafe_read_c
Size
Write_ml
Read_ml
Write_c
Read_c
Std
Type_class
Map_to_safe
Utils
# OASIS_STOP
2 changes: 2 additions & 0 deletions base/bin_prot/oasis.sh
Expand Up @@ -142,6 +142,8 @@ Ocamlbuild_plugin.dispatch
flag ["compile"; "ocaml"; "cpp"] cpp;
flag ["compile"; "ocaml"] (S [A "-w"; A "@Ae" ]);
let cflags =
let flags =
[
Expand Down
6 changes: 3 additions & 3 deletions base/core/extended/lib/command.ml
Expand Up @@ -323,8 +323,8 @@ end = struct
| `Ok tbl -> (fun flag ->
match partial_match tbl flag with
| `Exact (_, v)
| `Partial (_, ({full_flag_required = false} as v)) -> Some v.spec
| `Partial (_, ({full_flag_required = true} as v)) ->
| `Partial (_, ({full_flag_required = false; _} as v)) -> Some v.spec
| `Partial (_, ({full_flag_required = true; _} as v)) ->
eprintf "Note: cannot abbreviate flag \"%s\".\n%!" v.name; None
| `Ambiguous l ->
eprintf "Note: flag \"%s\" is an ambiguous prefix: %s\n%!"
Expand All @@ -333,7 +333,7 @@ end = struct
| `None -> None)
;;

let help { name = name; doc = doc; aliases = aliases} =
let help { name = name; doc = doc; aliases = aliases; _} =
if String.is_prefix doc ~prefix:" " then
(name, String.lstrip doc) ::
List.map aliases
Expand Down
2 changes: 1 addition & 1 deletion base/core/extended/lib/core_command.ml
Expand Up @@ -128,7 +128,7 @@ module Flag = struct
(x ^ " " ^ arg, sprintf "same as \"%s\"" name))
end

let align {name; doc; aliases; action = _} =
let align {name; doc; aliases; _} =
let (name, doc) =
match String.lsplit2 doc ~on:' ' with
| None | Some ("", _) -> (name, String.strip doc)
Expand Down
2 changes: 1 addition & 1 deletion base/core/extended/lib/documented_match_statement.ml
Expand Up @@ -51,7 +51,7 @@ let prepend ~specific_cases t =

let match_ t x =
match List.filter t.specific_cases
~f:(fun { pattern = x' } -> List.exists x' ~f:(fun y -> x = y)) with
~f:(fun { pattern = x'; _ } -> List.exists x' ~f:(fun y -> x = y)) with
| case1::case2::_ -> failwithf "pattern appears twice in documented_match (%s,%s)"
case1.documentation case2.documentation ()
| [case] -> case.value ()
Expand Down
2 changes: 1 addition & 1 deletion base/core/extended/lib/exception_check.ml
Expand Up @@ -30,7 +30,7 @@ let create ?(listen_port = 65100) exns =
U.set_nonblock s;
while true do
try
let { U.Select_fds.read = rd } =
let { U.Select_fds.read = rd; _ } =
U.select ~read:(s :: !clients) ~write:[] ~except:[]
~timeout:(- 1.0) ()
in
Expand Down
2 changes: 1 addition & 1 deletion base/core/extended/lib/loggers.ml
Expand Up @@ -68,7 +68,7 @@ module MakeChannelSpec (ChannelSpec : CHANNEL_SPEC) : SPEC = struct
let
{
tm_year = m_year; tm_mon = m_month; tm_mday = m_mday;
tm_hour = m_hour; tm_min = m_min; tm_sec = m_sec;
tm_hour = m_hour; tm_min = m_min; tm_sec = m_sec; _
} = localtime mtime in
let m_sec = float m_sec +. mod_float mtime 1. in
sprintf "%04d-%02d-%02d/%02d:%02d:%05.2f"
Expand Down
4 changes: 2 additions & 2 deletions base/core/extended/lib/sys_utils.ml
Expand Up @@ -205,7 +205,7 @@ module Cpu_use = struct

let sample_exn pid =
let module P = Procfs.Process in
let {P.Stat.utime; stime} = (Procfs.with_pid_exn pid).P.stat in
let {P.Stat.utime; stime; _} = (Procfs.with_pid_exn pid).P.stat in
{ jiffies = Big_int.add_big_int utime stime;
time = Time.now () }

Expand All @@ -219,7 +219,7 @@ module Cpu_use = struct
t.s0 <- t.s1;
t.s1 <- sample_exn t.pid

let cpu_use {jps; s0={jiffies=j0;time=t0}; s1={jiffies=j1;time=t1}} =
let cpu_use {jps; s0={jiffies=j0;time=t0}; s1={jiffies=j1;time=t1}; _} =
let my_jps =
Big_int.float_of_big_int (Big_int.sub_big_int j1 j0)
/. Time.Span.to_sec (Time.diff t1 t0)
Expand Down
1 change: 1 addition & 0 deletions base/core/extended/oasis.sh
Expand Up @@ -153,6 +153,7 @@ let dispatch = function
List.concat (List.map f flags)
in
flag ["compile"; "c"] (S cflags);
flag ["compile"; "ocaml"] (S [A "-w"; A "@Ae" ]);
dispatch_default e
| e -> dispatch_default e
Expand Down
2 changes: 1 addition & 1 deletion base/core/lib/bigstring_stubs.c
Expand Up @@ -253,7 +253,7 @@ CAMLprim value bigstring_recvfrom_assume_fd_is_nonblocking_stub(

typedef off_t file_offset;

#define IO_BUFFER_SIZE 4096
#define IO_BUFFER_SIZE 65536

struct channel {
int fd; /* Unix file descriptor */
Expand Down
4 changes: 2 additions & 2 deletions base/core/lib/in_channel.ml
Expand Up @@ -35,8 +35,8 @@ let unsafe_input_value t = may_eof (fun () -> Pervasives.input_value t)
let set_binary_mode = Pervasives.set_binary_mode_in

let input_all t =
(* We use 4096 because that is the size of OCaml's IO buffers. *)
let buf_size = 4096 in
(* We use 65536 because that is the size of OCaml's IO buffers. *)
let buf_size = 65536 in
let buf = String.create buf_size in
let buffer = Buffer.create buf_size in
let rec loop () =
Expand Down
2 changes: 1 addition & 1 deletion base/core/lib/misc.c
Expand Up @@ -176,7 +176,7 @@ WRAP_TIME_FUN(gmtime, "gmtime")
/* Fix the broken close_(in/out) function which does not release the
caml lock. */

#define IO_BUFFER_SIZE 4096
#define IO_BUFFER_SIZE 65536

typedef long file_offset;

Expand Down
1 change: 1 addition & 0 deletions base/core/oasis.sh
Expand Up @@ -140,6 +140,7 @@ let dispatch = function
List.concat (List.map f flags)
in
flag ["compile"; "c"] (S cflags);
flag ["compile"; "ocaml"] (S [A "-w"; A "@Ae" ]);
dispatch_default e
| e -> dispatch_default e
Expand Down
2 changes: 2 additions & 0 deletions base/sexplib/.hgignore.in
Expand Up @@ -13,3 +13,5 @@ _oasis
_build
_tags
lib/sexplib.odocl
conv_test.byte
sexp_test.byte
64 changes: 52 additions & 12 deletions base/sexplib/README
@@ -1,12 +1,12 @@


README: library "Sexplib"
*************************
Copyright (C) 2012 Jane Street Holding, LLC (1)
=====================================================
Author: Markus Mottl
======================
New York, 2012-03-20
New York, 2012-04-20
====================


Expand Down Expand Up @@ -138,15 +138,25 @@ using OCamlMakefile just add it to the 'PACKS'-variable.
4.1 Lexical conventions of S-expression
========================================

Whitespace, which consists of space, newline, carriage return, horizontal
tab and form feed, is ignored unless within an OCaml-string, where it is
treated according to OCaml-conventions. The semicolon introduces comments.
Comments are ignored, and range up to the next newline character. The left
parenthesis opens a new list, the right parenthesis closes it again. Lists can
be empty. The double quote denotes the beginning and end of a string following
the lexical conventions of OCaml (see OCaml-manual for details). All
characters other than double quotes, left- and right parentheses, and
whitespace are considered part of a contiguous string.
Whitespace, which consists of space, newline, horizontal tab, and form feed,
is ignored unless within an OCaml-string, where it is treated according to
OCaml-conventions. The left parenthesis opens a new list, the right one closes
it again. Lists can be empty. The double quote denotes the beginning and end
of a string following the lexical conventions of OCaml (see the OCaml-manual
for details). All characters other than double quotes, left- and right
parentheses, whitespace, carriage return, and comment-introducing characters
or sequences (see next paragraph) are considered part of a contiguous string.

A line comment is introduced using a semicolon, which comments out all text
up to the end of the next newline character. The sequence '%;' introduces an
S-expression comment. This means that the next S-expression, which must be
syntactically correct and may be an atom (quoted or unquoted) or list,
following this two-character sequence will be ignored. Whitespace or other
comments between this sequence and the subsequent S-expression are ignored.
Block comments are opened with '#|' and closed with '|#'. They can be nested
and require that double-quotes within the block balance and contain
syntactically correct OCaml-strings, similar to quoted atoms. These
OCaml-strings may contain comment characters without causing parsing problems.


4.2 Grammar of S-expressions
Expand Down Expand Up @@ -222,7 +232,7 @@ which indicates that a record field should be optional. E.g.:
{
x : int option;
y : int sexp_option;
}
} with sexp
>>

The type 'sexp_option' is equivalent to ordinary options, but is treated
Expand Down Expand Up @@ -263,6 +273,36 @@ field should be defined.
similar to the type 'sexp_option'. They assume the empty list, empty array,
and false value respectively as default values.

More complex default values can be specified explicitly using several
constructs, e.g.:
<< let z_test v = v > 42

type t =
{
x : int with default(42);
y : int with default(3), sexp_drop_default;
z : int with default(3), sexp_drop_if(z_test);
} with sexp
>>

The 'default' record field extension above is supported by the underlying
preprocessor library 'type_conv' and specifies the intended default value for
a record field in its argument. Sexplib will use this information to generate
code which will set this record field to the default value if an S-expression
omits this field. If a record is converted to an S-expression, record fields
with default values will be emitted as usual. Specifying 'sexp_drop_default'
will add a test for polymorphic equality to the generated code such that a
record field containing its default value will be suppressed in the resulting
S-expression. This option requires the presence of a default value.
'sexp_drop_if' on the other hand does not require a default. Its argument must
be a function, which will receive the current record value. If the result of
this function is 'true', then the record field will be suppressed in the
resulting S-expression.

The above extensions can be quite creatively used together with manifest
types, functors, and first-class modules to make the emission of record fields
or the definition of their default values configurable at runtime.


4.7 Conversion of sum types
============================
Expand Down

0 comments on commit e8bbaa4

Please sign in to comment.