diff --git a/CHANGES b/CHANGES index b9fbd4b8..7fc544ab 100644 --- a/CHANGES +++ b/CHANGES @@ -1,4 +1,8 @@ -0.8.0 (13-Oct-2013): +0.8.1 (trunk): +* Trailing semicolons are allowed in cstruct field definitions +* Buffer elements can be any primitive integer, not just uint8 + +0.8.0 (2013-10-13): * Improved ocamldoc for BE/LE modules. * Add Travis-CI test scripts and fix `test.sh` script compilation. * Support int32/int64 constant values in cenum like `VAL = 0xffffffffl`, useful for 32-bit hosts. @@ -8,26 +12,24 @@ * Add `Cstruct.hexdump_to_buffer` to make spooling hexdump output easier. * Generate `hexdump_foo` and `hexdump_foo_to_buffer` prettyprinting functions for a `cstruct foo`. -0.7.1 (06-Mar-2013): +0.7.1 (2013-03-06): * Add `Async_cstruct.Pipe` to map pipes of `Cstruct` buffers to strings or `Bigsubstring`. -0.7.0 (25-Feb-2013): - +0.7.0 (2013-02-25): * Add zero-copy conversion functions to/from the Core `Bigsubstring`. * Add an `of_string` function to simplify the construction from OCaml values. * Add Async interface to interoperate with Jane Street Core code. -0.6.2 (08-Feb-2013): - +0.6.2 (2013-02-08): * Add experimental `cstruct.obuild` for the `obuild` build tool. * Use bounds checked version of all functions in the external interface. * Expose the `Cstruct.debug` to dump internal state of a buffer to a string. * Add `set_len` and `add_len` to manipulate the total-length field directly. -0.6.1 (20-Dec-2012): +0.6.1 (2012-12-20): * Add `sendto`, `read` and `recvfrom` functions to the Lwt subpackage. -0.6.0 (20-Dec-2012): +0.6.0 (2012-12-20): * Add fast bigarray<->string functions to replace byte-by-byte copies. * Add an Lwt sub-package to expose a write call. * Depend on ocplib-endian for fast low-level parsing of integers. @@ -36,25 +38,25 @@ on the minor heap rather than forcing a major heap allocation. It does alter the external API, so previous users of cstruct wont work. -0.5.3 (16-Dec-2012): +0.5.3 (2012-12-16): * No functional changes, just OASIS packaging fix to right version. -0.5.2 (11-Dec-2012): +0.5.2 (2012-12-11): * Remove the separate `xen` and `unix` subdirectories, as the portable `Bigarray` is now provided by the `xenbigarray` package. -0.5.1 (28-Sep-2012): +0.5.1 (2012-09-28): * Add `string_to_` function to match the `_to_string`, primarily to help with command-line parsing of enum arguments. -0.5.0 (20-Sep-2012): +0.5.0 (2012-09-20): * Add a signature generator for cstruct and cenum to permit their use in `.mli` files. * Use the more reliable revised syntax camlp4 quotation expander, to avoid broken AST output from antiquotations. * Switch the `xen/` version over to using OASIS also. -0.4.0 (02-Sep-2012): +0.4.0 (2012-09-02): * Fix META file for use with Xen -0.3 (25-Aug-2012): +0.3 (2012-08-25): * Initial public release diff --git a/syntax/pa_cstruct.ml b/syntax/pa_cstruct.ml index 78513a94..7d67290f 100644 --- a/syntax/pa_cstruct.ml +++ b/syntax/pa_cstruct.ml @@ -22,12 +22,15 @@ open Ast type mode = Big_endian | Little_endian | Host_endian +type prim = + | UInt8 + | UInt16 + | UInt32 + | UInt64 + type ty = - |UInt8 - |UInt16 - |UInt32 - |UInt64 - |Buffer of int + | Prim of prim + | Buffer of prim * int type field = { field: string; @@ -51,22 +54,24 @@ let ty_of_string = |_ -> None let width_of_field f = - match f.ty with - |UInt8 -> 1 - |UInt16 -> 2 - |UInt32 -> 4 - |UInt64 -> 8 - |Buffer len -> len + let rec width = function + |Prim UInt8 -> 1 + |Prim UInt16 -> 2 + |Prim UInt32 -> 4 + |Prim UInt64 -> 8 + |Buffer (prim, len) -> (width (Prim prim)) * len + in + width f.ty let field_to_string f = - sprintf "%s %s" - (match f.ty with - |UInt8 -> "uint8_t" - |UInt16 -> "uint16_t" - |UInt32 -> "uint32_t" - |UInt64 -> "uint64_t" - |Buffer len -> sprintf "uint8_t[%d]" len - ) f.field + let rec string = function + |Prim UInt8 -> "uint8_t" + |Prim UInt16 -> "uint16_t" + |Prim UInt32 -> "uint32_t" + |Prim UInt64 -> "uint64_t" + |Buffer (prim, len) -> sprintf "%s[%d]" (string (Prim prim)) len + in + sprintf "%s %s" (string f.ty) f.field let to_string t = sprintf "cstruct[%d] %s { %s }" t.len t.name @@ -79,9 +84,8 @@ let parse_field _loc field field_type sz = |None -> loc_err _loc (sprintf "Unknown type %s" field_type) |Some ty -> begin let ty = match ty,sz with - |_,None -> ty - |UInt8,Some sz -> Buffer (int_of_string sz) - |_,Some sz -> loc_err _loc "only uint8_t buffers supported" + |_,None -> Prim ty + |prim,Some sz -> Buffer (prim, int_of_string sz) in let off = -1 in { field; ty; off } @@ -118,69 +122,67 @@ let output_get _loc s f = let m = mode_mod _loc s.endian in let num x = <:expr< $int:string_of_int x$ >> in match f.ty with - |Buffer len -> + |Buffer (_, _) -> + let len = width_of_field f in <:str_item< value $lid:op_name "get" s f$ src = Cstruct.sub src $num f.off$ $num len$ ; value $lid:op_name "copy" s f$ src = Cstruct.copy src $num f.off$ $num len$ >> - |ty -> + |Prim prim -> <:str_item< value $lid:getter_name s f$ v = - $match f.ty with + $match prim with |UInt8 -> <:expr< Cstruct.get_uint8 v $num f.off$ >> |UInt16 -> <:expr< $m$.get_uint16 v $num f.off$ >> |UInt32 -> <:expr< $m$.get_uint32 v $num f.off$ >> |UInt64 -> <:expr< $m$.get_uint64 v $num f.off$ >> - |Buffer len -> assert false $ >> -let type_of_int_field _loc f = - match f.ty with +let type_of_int_field _loc = function |UInt8 -> <:ctyp> |UInt16 -> <:ctyp> |UInt32 -> <:ctyp> |UInt64 -> <:ctyp> - |Buffer _ -> assert false let output_get_sig _loc s f = match f.ty with - |Buffer len -> + |Buffer (_,_) -> <:sig_item< value $lid:op_name "get" s f$ : Cstruct.t -> Cstruct.t ; value $lid:op_name "copy" s f$ : Cstruct.t -> string >> - |ty -> - let retf = type_of_int_field _loc f in + |Prim prim -> + let retf = type_of_int_field _loc prim in <:sig_item< value $lid:getter_name s f$ : Cstruct.t -> $retf$ ; >> let output_set _loc s f = let m = mode_mod _loc s.endian in let num x = <:expr< $int:string_of_int x$ >> in match f.ty with - |Buffer len -> + |Buffer (_,_) -> + let len = width_of_field f in <:str_item< value $lid:setter_name s f$ src srcoff dst = Cstruct.blit_from_string src srcoff dst $num f.off$ $num len$ ; value $lid:op_name "blit" s f$ src srcoff dst = Cstruct.blit src srcoff dst $num f.off$ $num len$ >> - |ty -> + |Prim prim -> <:str_item< - value $lid:setter_name s f$ v x = $match f.ty with + value $lid:setter_name s f$ v x = $match prim with |UInt8 -> <:expr< Cstruct.set_uint8 v $num f.off$ x >> |UInt16 -> <:expr< $m$.set_uint16 v $num f.off$ x >> |UInt32 -> <:expr< $m$.set_uint32 v $num f.off$ x >> |UInt64 -> <:expr< $m$.set_uint64 v $num f.off$ x >> - |Buffer len -> assert false $ >> let output_set_sig _loc s f = match f.ty with - |Buffer len -> + |Buffer (_,_) -> <:sig_item< value $lid:setter_name s f$ : string -> int -> Cstruct.t -> unit ; value $lid:op_name "blit" s f$ : Cstruct.t -> int -> Cstruct.t -> unit >> - |ty -> - let retf = type_of_int_field _loc f in + |Prim prim -> + let retf = type_of_int_field _loc prim in <:sig_item< value $lid:setter_name s f$ : Cstruct.t -> $retf$ -> unit >> let output_sizeof _loc s = @@ -199,10 +201,16 @@ let output_hexdump _loc s = <:expr< $a$; Buffer.add_string _buf $str:" "^f.field^" = "$; $match f.ty with - |UInt8 |UInt16 -> <:expr< Printf.bprintf _buf "0x%x\n" ($lid:getter_name s f$ v) >> - |UInt32 -> <:expr< Printf.bprintf _buf "0x%lx\n" ($lid:getter_name s f$ v) >> - |UInt64 -> <:expr< Printf.bprintf _buf "0x%Lx\n" ($lid:getter_name s f$ v) >> - |Buffer len -> <:expr< Printf.bprintf _buf "" $int:string_of_int len$; Cstruct.hexdump_to_buffer _buf ($lid:getter_name s f$ v) >> + |Prim (UInt8|UInt16) -> + <:expr< Printf.bprintf _buf "0x%x\n" ($lid:getter_name s f$ v) >> + |Prim UInt32 -> + <:expr< Printf.bprintf _buf "0x%lx\n" ($lid:getter_name s f$ v) >> + |Prim UInt64 -> + <:expr< Printf.bprintf _buf "0x%Lx\n" ($lid:getter_name s f$ v) >> + |Buffer (_,_) -> + <:expr< Printf.bprintf _buf "" + $str: field_to_string f$; + Cstruct.hexdump_to_buffer _buf ($lid:getter_name s f$ v) >> $ >> ) <:expr< >> s.fields in @@ -248,7 +256,7 @@ let output_struct_sig _loc s = let output_enum _loc name fields width = let intfn,pattfn = match ty_of_string width with |None -> loc_err _loc ("enum: unknown width specifier " ^ width) - |Some UInt8 |Some UInt16 -> + |Some (UInt8 | UInt16) -> (fun i -> <:expr< $int:Int64.to_string i$ >>), (fun i -> <:patt< $int:Int64.to_string i$ >>) |Some UInt32 -> @@ -257,7 +265,6 @@ let output_enum _loc name fields width = |Some UInt64 -> (fun i -> <:expr< $int64:Printf.sprintf "0x%Lx" i$ >>), (fun i -> <:patt< $int64:Printf.sprintf "0x%Lx" i$ >>) - |Some (Buffer _) -> loc_err _loc "enum: array types not allowed" in let decls = tyOr_of_list (List.map (fun (f,_) -> <:ctyp< $uid:f$ >>) fields) in @@ -286,10 +293,9 @@ let output_enum _loc name fields width = let output_enum_sig _loc name fields width = let oty = match ty_of_string width with |None -> loc_err _loc ("enum: unknown width specifier " ^ width) - |Some UInt8|Some UInt16 -> <:ctyp> + |Some (UInt8|UInt16) -> <:ctyp> |Some UInt32 -> <:ctyp> |Some UInt64 -> <:ctyp> - |Some (Buffer _) -> loc_err _loc "enum: array types not allowed" in let decls = tyOr_of_list (List.map (fun (f,_) -> <:ctyp< $uid:f$ >>) fields) in @@ -316,10 +322,14 @@ EXTEND Gram ] ]; + constr_field_decl: [ + [ field = constr_field -> [field] + | field = constr_field; ";"; rest = constr_field_decl -> field::rest + | field = constr_field; ";" -> [field] ] + ]; + constr_fields: [ - [ "{"; fields = LIST0 constr_field SEP ";"; "}" -> - fields - ] + [ "{"; fields = constr_field_decl; "}" -> fields ] ]; constr_enum: [ @@ -330,12 +340,22 @@ EXTEND Gram | f = UIDENT; "="; i = INT -> (f, Some (Int64.of_string i)) ] ]; + constr_enum_decl: [ + [ enum = constr_enum -> [enum] + | enum = constr_enum; ";"; rest = constr_enum_decl -> enum::rest + | enum = constr_enum; ";" -> [enum] ] + ]; + + constr_enums: [ + [ "{"; enums = constr_enum_decl; "}" -> enums ] + ]; + sig_item: [ [ "cstruct"; name = LIDENT; fields = constr_fields; "as"; endian = LIDENT -> output_struct_sig _loc (create_struct _loc endian name fields) ] | - [ "cenum"; name = LIDENT; "{"; fields = LIST0 [ constr_enum ] SEP ";"; "}"; + [ "cenum"; name = LIDENT; fields = constr_enums; "as"; width = LIDENT -> let n = ref Int64.minus_one in let incr_n () = n := Int64.succ !n in @@ -353,7 +373,7 @@ EXTEND Gram "as"; endian = LIDENT -> output_struct _loc (create_struct _loc endian name fields) ] | - [ "cenum"; name = LIDENT; "{"; fields = LIST0 [ constr_enum ] SEP ";"; "}"; + [ "cenum"; name = LIDENT; fields = constr_enums; "as"; width = LIDENT -> let n = ref Int64.minus_one in let incr_n () = n := Int64.succ !n in