From 53b23903eb70bf2af9c18cfd34e92785e10ea157 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Wed, 2 Aug 2023 17:22:33 +0200 Subject: [PATCH 1/4] contrib/kaitai-ocaml: OCaml library to describe Kaitai Struct files --- contrib/kaitai-ocaml/src/dune | 8 + contrib/kaitai-ocaml/src/parse.ml | 182 ++++++++++++++++++++ contrib/kaitai-ocaml/src/print.ml | 66 +++++++ contrib/kaitai-ocaml/src/types.ml | 268 +++++++++++++++++++++++++++++ contrib/kaitai-ocaml/test/basic.ml | 28 +++ contrib/kaitai-ocaml/test/dune | 10 ++ manifest/main.ml | 11 ++ 7 files changed, 573 insertions(+) create mode 100644 contrib/kaitai-ocaml/src/dune create mode 100644 contrib/kaitai-ocaml/src/parse.ml create mode 100644 contrib/kaitai-ocaml/src/print.ml create mode 100644 contrib/kaitai-ocaml/src/types.ml create mode 100644 contrib/kaitai-ocaml/test/basic.ml create mode 100644 contrib/kaitai-ocaml/test/dune diff --git a/contrib/kaitai-ocaml/src/dune b/contrib/kaitai-ocaml/src/dune new file mode 100644 index 000000000000..b2b88e8fff05 --- /dev/null +++ b/contrib/kaitai-ocaml/src/dune @@ -0,0 +1,8 @@ +; This file was automatically generated, do not edit. +; Edit file manifest/main.ml instead. + +(library + (name kaitai) + (instrumentation (backend bisect_ppx)) + (libraries + yaml)) diff --git a/contrib/kaitai-ocaml/src/parse.ml b/contrib/kaitai-ocaml/src/parse.ml new file mode 100644 index 000000000000..96642982b08e --- /dev/null +++ b/contrib/kaitai-ocaml/src/parse.ml @@ -0,0 +1,182 @@ +exception Error + +open Types +open Yaml + +let empty_doc = DocSpec.{summary = None; refs = []} + +let mapping = function `O m -> m | _ -> raise Error + +let scalar = function `Scalar {value; _} -> value | _ -> raise Error + +let sequence = function + | `A (m : Yaml.sequence) -> m.s_members + | _ -> raise Error + +let find_key_opt (m : Yaml.mapping) x : Yaml.yaml option = + List.find_map + (fun (k, v) -> + match k with + | `Scalar {value; _} -> if String.equal x value then Some v else None + | _ -> None) + m.m_members + +let find_key m x = + match find_key_opt m x with None -> raise Error | Some x -> x + +let keys m f = + List.map + (fun (k, v) -> + match k with `Scalar {value; _} -> f value v | _ -> raise Error) + m.m_members + +let parse ?file s = + let yaml = + match Yaml.yaml_of_string s with + | Ok x -> x + | Error (`Msg msg) -> failwith msg + in + let rec classSpec yaml = + let m = mapping yaml in + let meta = + let content = find_key m "meta" in + let m = mapping content in + let id = + match find_key_opt m "id" with + | None -> None + | Some i -> Some (scalar i) + in + MetaSpec. + { + path = []; + isOpaque = false; + id; + endian = None; + bitEndian = None; + encoding = None; + forceDebug = false; + opaqueTypes = None; + zeroCopySubstream = None; + imports = []; + } + in + let types = + match find_key_opt m "types" with + | None -> [] + | Some content -> + let m = mapping content in + keys m (fun k v -> (k, classSpec v)) + in + let instances = + match find_key_opt m "instances" with + | None -> [] + | Some content -> + let m = mapping content in + keys m (fun k v -> (k, instanceSpec v)) + in + let enums = + match find_key_opt m "enums" with + | None -> [] + | Some content -> + let m = mapping content in + keys m (fun k v -> (k, enumSpec v)) + in + let seq = + match find_key_opt m "seq" with + | None -> [] + | Some content -> + sequence content + |> List.map (fun x -> + let m = mapping x in + let id = find_key m "id" |> scalar in + let dataType = + match find_key_opt m "type" with + | None -> DataType.AnyType + | Some (`Scalar _) -> DataType.AnyType + | _ -> DataType.AnyType + in + let cond = + AttrSpec.ConditionalSpec.{ifExpr = None; repeat = NoRepeat} + in + let cond = + match find_key_opt m "if" with + | None -> cond + | Some v -> {cond with ifExpr = Some (expression v)} + in + let cond = + match find_key_opt m "repeat" with + | None -> cond + | Some v -> ( + match scalar v with + | "expr" -> + let e = find_key m "repeat-expr" in + {cond with repeat = RepeatExpr (expression e)} + | "until" -> + let e = find_key m "repeat-until" in + {cond with repeat = RepeatUntil (expression e)} + | "eos" -> {cond with repeat = RepeatEos} + | _ -> raise Error) + in + let valid = + match find_key_opt m "valid" with + | None -> None + | Some e -> + Some (ValidationSpec.ValidationExpr (expression e)) + in + AttrSpec. + {path = []; id; dataType; cond; valid; doc = empty_doc}) + in + + let doc = empty_doc in + let doc = + match find_key_opt m "doc" with + | None -> doc + | Some v -> + let value = scalar v in + {doc with summary = Some value} + in + let doc = + match find_key_opt m "doc-ref" with + | None -> doc + | Some v -> + let refs = + List.map (fun x -> DocSpec.TextRef (scalar x)) (sequence v) + in + {doc with refs} + in + + ClassSpec. + { + fileName = file; + path = + (match file with + | None -> [] + | Some file -> String.split_on_char '/' file); + meta; + doc; + toStringExpr = None; + params = []; + seq; + types; + instances; + enums; + } + and instanceSpec _ = InstanceSpec.{doc = empty_doc; descr = ParseInstanceSpec} + and enumSpec yaml = + let m = mapping yaml in + let map = keys m (fun k v -> (int_of_string k, enumValueSpec v)) in + {path = []; map} + and enumValueSpec yaml = + match yaml with + | `Scalar {value; _} -> EnumValueSpec.{name = value; doc = empty_doc} + | `O m -> + let id = find_key m "id" |> scalar in + let doc = + match find_key_opt m "doc" with + | None -> empty_doc + | Some _ -> empty_doc + in + EnumValueSpec.{name = id; doc} + | _ -> raise Error + and expression _ = Ast.Str "TODO" in + classSpec yaml diff --git a/contrib/kaitai-ocaml/src/print.ml b/contrib/kaitai-ocaml/src/print.ml new file mode 100644 index 000000000000..4c950bcaf94b --- /dev/null +++ b/contrib/kaitai-ocaml/src/print.ml @@ -0,0 +1,66 @@ +open Types +open Yaml + +let scalar value = + `Scalar + { + anchor = None; + tag = None; + value; + plain_implicit = true; + quoted_implicit = false; + style = `Any; + } + +let sequence l = + `A {s_anchor = None; s_tag = None; s_implicit = true; s_members = l} + +let mapping l = + `O + { + m_anchor = None; + m_tag = None; + m_implicit = true; + m_members = List.map (fun (k, v) -> (scalar k, v)) l; + } + +let metaSpec (t : MetaSpec.t) = + mapping + (List.filter_map + (fun x -> x) + [(match t.id with None -> None | Some id -> Some ("id", scalar id))]) + +let classSpec _ = mapping [("test", scalar "test")] + +let instanceSpec _ = mapping [("test", scalar "test")] + +let enumSpec _ = mapping [("test", scalar "test")] + +let if_not_empty = function [] -> false | _ -> true + +let to_yaml (t : ClassSpec.t) = + mapping + (List.filter_map + (fun (b, n, v) -> if b then Some (n, v) else None) + [ + (true, "meta", metaSpec t.meta); + ( if_not_empty t.types, + "types", + mapping (t.types |> List.map (fun (k, v) -> (k, classSpec v))) ); + ( if_not_empty t.instances, + "instances", + mapping (t.instances |> List.map (fun (k, v) -> (k, instanceSpec v))) + ); + ( if_not_empty t.enums, + "enums", + mapping (t.enums |> List.map (fun (k, v) -> (k, enumSpec v))) ); + ( if_not_empty t.seq, + "seq", + sequence + (t.seq + |> List.map (fun v -> mapping [("id", scalar v.AttrSpec.id)])) ); + ]) + +let print t = + let y = to_yaml t in + match Yaml.yaml_to_string y with Ok x -> x | Error (`Msg m) -> failwith m diff --git a/contrib/kaitai-ocaml/src/types.ml b/contrib/kaitai-ocaml/src/types.ml new file mode 100644 index 000000000000..079a00586cee --- /dev/null +++ b/contrib/kaitai-ocaml/src/types.ml @@ -0,0 +1,268 @@ +module Identifier = struct + type t = string +end + +module Ast = struct + (* https://github.com/kaitai-io/kaitai_struct_compiler/blob/master/shared/src/main/scala/io/kaitai/struct/exprlang/Ast.scala *) + type boolop = Or | And + + type typeId = {absolute : bool; names : string list; isArray : bool} + + type operator = + | Add + | Sub + | Mult + | Div + | Mod + | LShift + | RShift + | BitOr + | BitXor + | BitAnd + + type unaryop = + (* Bitwise negation operator. Applicable only to `IntNum`s *) + | Invert + (* Boolean negation operator. Applicable only to `Boolean`s *) + | Not + (* Arithmetic negation operator. Applicable only to `IntNum`s / `FloatNum`s *) + | Minus + + type cmpop = Eq | NotEq | Lt | LtE | Gt | GtE + + type t = + | Raw of string + (* Temporary: [Raw] So that we don't need to deal with parsing/printing of Ast.expr *) + | BoolOp of {op : boolop; values : t list} + | BinOp of {left : t; op : operator; right : t} + | UnaryOp of {op : unaryop; operand : t} + | IfExp of {condition : t; ifTrue : t; ifFalse : t} + | Dict of {keys : t list; values : t list} + (* Represents `X < Y`, `X > Y` and so on. *) + | Compare of {left : t; ops : cmpop; right : t} + | Call of {func : t; args : t list} + | IntNum of int (* BigInt *) + | FloatNum of float (* BigDecimal *) + | Str of string + | Bool of bool + | EnumByLabel of { + enumName : Identifier.t; + label : Identifier.t; + inType : typeId; + } + | EnumById of {enumName : Identifier.t; id : t; inType : typeId} + | Attribute of {value : t; attr : Identifier.t} + | CastToType of {value : t; typeName : typeId} + | ByteSizeOfType of {typeName : typeId} + | BitSizeOfType of {typeName : typeId} + (* Represents `X[Y]`. *) + | Subscript of {value : t; idx : t} + | Name of Identifier.t + | List of t list + + type expr = t +end + +type processExpr = + | ProcessZlib + | ProcessXor of {key : Ast.expr} + | ProcessRotate of {left : int; key : Ast.expr} + | ProcessCustom + +module BitEndianness = struct + type t = LittleBitEndian | BigBitEndidan +end + +module Endianness = struct + type fixed_endian = [`BE | `LE] + + type cases = (Ast.expr * fixed_endian) list + + type t = [fixed_endian | `Calc of Ast.expr * cases | `Inherited] +end + +module DataType = struct + type data_type = + | NumericType + | BooleanType + | BytesType of bytes_type + | StrType of str_type + | ComplexDataType of complex_data_type + | AnyType + + and int_width = W1 | W2 | W4 | W8 + + and int_type = + | CalcIntType + | Int1TYpe of {signed : bool} + | IntMultiType of { + signed : bool; + width : int_width; + endian : Endianness.fixed_endian option; + } + | BitsType of {width : int; bit_endian : BitEndianness.t} + + and float_type = + | CalcFloatType + | FloatMultiType of { + width : int_width; + endian : Endianness.fixed_endian option; + } + + and boolean_type = BitsType1 of BitEndianness.t | CalcBooleanType + + and bytes_type = + | CalcBytesType + | BytesEosType of { + terminator : int option; + include_ : bool; + padRight : int option; + mutable process : processExpr option; + } + | BytesLimitType of { + size : Ast.expr; + terminator : int option; + include_ : bool; + padRight : int option; + mutable process : processExpr option; + } + | BytesTerminatedType of { + terminator : int; + include_ : bool; + consume : bool; + eosError : bool; + mutable process : processExpr option; + } + + and str_type = + | CalcStrType + | StrFromBytesType of {bytes : bytes_type; encoding : string} + + and array_type = ArrayTypeInStream | CalcArrayType + + and complex_data_type = StructType | UserType | Array_Type of array_type + + and switch_type = { + on : Ast.expr; + cases : (Ast.expr * data_type) list; + isOwning : bool; + mutable isOwningInExpr : bool; + } + + type t = data_type +end + +module DocSpec = struct + (* https://github.com/kaitai-io/kaitai_struct_compiler/blob/master/shared/src/main/scala/io/kaitai/struct/format/DocSpec.scala *) + type refspec = TextRef of string | UrlRef of {url : string; text : string} + + type t = {summary : string option; refs : refspec list} +end + +module InstanceIdentifier = struct + type t = string +end + +module RepeatSpec = struct + (* https://github.com/kaitai-io/kaitai_struct_compiler/blob/master/shared/src/main/scala/io/kaitai/struct/format/RepeatSpec.scala *) + type t = + | RepeatExpr of Ast.expr + | RepeatUntil of Ast.expr + | RepeatEos + | NoRepeat +end + +module ValidationSpec = struct + (* https://github.com/kaitai-io/kaitai_struct_compiler/blob/master/shared/src/main/scala/io/kaitai/struct/format/ValidationSpec.scala *) + type t = + | ValidationEq of Ast.expr + | ValidationMin of Ast.expr + | ValidationMax of Ast.expr + | ValidationRange of {min : Ast.expr; max : Ast.expr} + | ValidationAnyOf of Ast.expr list + | ValidationExpr of Ast.expr +end + +module AttrSpec = struct + (* https://github.com/kaitai-io/kaitai_struct_compiler/blob/master/shared/src/main/scala/io/kaitai/struct/format/AttrSpec.scala *) + module ConditionalSpec = struct + type t = {ifExpr : Ast.expr option; repeat : RepeatSpec.t} + end + + type t = { + path : string list; + id : Identifier.t; + dataType : DataType.t; + cond : ConditionalSpec.t; + valid : ValidationSpec.t option; + doc : DocSpec.t; + } +end + +module EnumValueSpec = struct + (* https://github.com/kaitai-io/kaitai_struct_compiler/blob/master/shared/src/main/scala/io/kaitai/struct/format/EnumValueSpec.scala *) + type t = {name : string; doc : DocSpec.t} +end + +module EnumSpec = struct + (* https://github.com/kaitai-io/kaitai_struct_compiler/blob/master/shared/src/main/scala/io/kaitai/struct/format/EnumSpec.scala *) + type t = {path : string list; map : (int * EnumValueSpec.t) list} +end + +module InstanceSpec = struct + (* https://github.com/kaitai-io/kaitai_struct_compiler/blob/master/shared/src/main/scala/io/kaitai/struct/format/InstanceSpec.scala *) + type t = {doc : DocSpec.t; descr : descr} + + and descr = + | ValueInstanceSpec of { + id : InstanceIdentifier.t; + path : string list; + value : Ast.expr; + ifExpr : Ast.expr option; + dataTypeOpt : DataType.t option; + } + | ParseInstanceSpec (* TODO *) +end + +module ParamDefSpec = struct + (* https://github.com/kaitai-io/kaitai_struct_compiler/blob/master/shared/src/main/scala/io/kaitai/struct/format/ParamDefSpec.scala *) + type t = { + path : string list; + id : Identifier.t; + dataType : DataType.t; + doc : DocSpec.t; + } +end + +module MetaSpec = struct + (* https://github.com/kaitai-io/kaitai_struct_compiler/blob/master/shared/src/main/scala/io/kaitai/struct/format/MetaSpec.scala *) + type t = { + path : string list; + isOpaque : bool; + id : string option; + endian : Endianness.t option; + bitEndian : BitEndianness.t option; + mutable encoding : string option; + forceDebug : bool; + opaqueTypes : bool option; + zeroCopySubstream : bool option; + imports : string list; + } +end + +module ClassSpec = struct + (* https://github.com/kaitai-io/kaitai_struct_compiler/blob/master/shared/src/main/scala/io/kaitai/struct/format/ClassSpec.scala *) + type t = { + fileName : string option; + path : string list; + (* isTopLevel : bool; *) + meta : MetaSpec.t; + doc : DocSpec.t; + toStringExpr : Ast.expr option; + params : ParamDefSpec.t list; + seq : AttrSpec.t list; + types : (string * t) list; + instances : (InstanceIdentifier.t * InstanceSpec.t) list; + enums : (string * EnumSpec.t) list; + } +end diff --git a/contrib/kaitai-ocaml/test/basic.ml b/contrib/kaitai-ocaml/test/basic.ml new file mode 100644 index 000000000000..65553a26f11d --- /dev/null +++ b/contrib/kaitai-ocaml/test/basic.ml @@ -0,0 +1,28 @@ +let%expect_test _ = + let s = + {| +meta: + id: bytes_with_io + title: Byte array with an `_io` member + license: MIT +doc: | + Helper type to work around Kaitai Struct not providing an `_io` member for plain byte arrays. +seq: + - id: data + size-eos: true + doc: The actual data. +|} + in + let k = Kaitai.Parse.parse s in + print_endline "Parsing ok" ; + let s = Kaitai.Print.print k in + print_endline "Serialization ok" ; + print_endline s ; + [%expect + {| + Parsing ok + Serialization ok + meta: + id: bytes_with_io + seq: + - id: data |}] diff --git a/contrib/kaitai-ocaml/test/dune b/contrib/kaitai-ocaml/test/dune new file mode 100644 index 000000000000..2da41d4d5ebb --- /dev/null +++ b/contrib/kaitai-ocaml/test/dune @@ -0,0 +1,10 @@ +; This file was automatically generated, do not edit. +; Edit file manifest/main.ml instead. + +(library + (name kaitai_test) + (instrumentation (backend bisect_ppx)) + (libraries + kaitai) + (inline_tests (flags -verbose) (modes native)) + (preprocess (pps ppx_expect))) diff --git a/manifest/main.ml b/manifest/main.ml index 9f6387eb5716..10521f8e37cd 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -8004,6 +8004,17 @@ let octez_scoru_wasm_regressions = ] ~preprocess:[staged_pps [ppx_import; ppx_deriving_show]] +let kaitai = + private_lib ~opam:"" "kaitai" ~path:"contrib/kaitai-ocaml/src" ~deps:[yaml] + +let _kaitai_test = + private_lib + ~opam:"" + "kaitai_test" + ~path:"contrib/kaitai-ocaml/test" + ~inline_tests:ppx_expect + ~deps:[kaitai] + (* Add entries to this function to declare that some dune and .opam files are not generated by the manifest on purpose. -- GitLab From 88e5df7a88b198750d3d27f80c5404ef27fac6c4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Wed, 23 Aug 2023 09:56:16 +0200 Subject: [PATCH 2/4] contrib/kaitai: add missing LICENSE headers --- contrib/kaitai-ocaml/src/parse.ml | 26 ++++++++++++++++++++++++++ contrib/kaitai-ocaml/src/print.ml | 26 ++++++++++++++++++++++++++ contrib/kaitai-ocaml/src/types.ml | 26 ++++++++++++++++++++++++++ contrib/kaitai-ocaml/test/basic.ml | 26 ++++++++++++++++++++++++++ 4 files changed, 104 insertions(+) diff --git a/contrib/kaitai-ocaml/src/parse.ml b/contrib/kaitai-ocaml/src/parse.ml index 96642982b08e..6244bcee409c 100644 --- a/contrib/kaitai-ocaml/src/parse.ml +++ b/contrib/kaitai-ocaml/src/parse.ml @@ -1,3 +1,29 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Nomadic Labs, *) +(* Copyright (c) 2023 Marigold, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + exception Error open Types diff --git a/contrib/kaitai-ocaml/src/print.ml b/contrib/kaitai-ocaml/src/print.ml index 4c950bcaf94b..91fde364bc67 100644 --- a/contrib/kaitai-ocaml/src/print.ml +++ b/contrib/kaitai-ocaml/src/print.ml @@ -1,3 +1,29 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Nomadic Labs, *) +(* Copyright (c) 2023 Marigold, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + open Types open Yaml diff --git a/contrib/kaitai-ocaml/src/types.ml b/contrib/kaitai-ocaml/src/types.ml index 079a00586cee..0470cc5e88d8 100644 --- a/contrib/kaitai-ocaml/src/types.ml +++ b/contrib/kaitai-ocaml/src/types.ml @@ -1,3 +1,29 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Nomadic Labs, *) +(* Copyright (c) 2023 Marigold, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + module Identifier = struct type t = string end diff --git a/contrib/kaitai-ocaml/test/basic.ml b/contrib/kaitai-ocaml/test/basic.ml index 65553a26f11d..05d7aeb096be 100644 --- a/contrib/kaitai-ocaml/test/basic.ml +++ b/contrib/kaitai-ocaml/test/basic.ml @@ -1,3 +1,29 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2023 Nomadic Labs, *) +(* Copyright (c) 2023 Marigold, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + let%expect_test _ = let s = {| -- GitLab From 5fc9f31e2237bd9619cd38ef416aece338ed04f8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Thu, 24 Aug 2023 13:51:08 +0200 Subject: [PATCH 3/4] Manifest: add comment to explain inline-test private-lib --- manifest/main.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/manifest/main.ml b/manifest/main.ml index 10521f8e37cd..77f435f88790 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -8007,6 +8007,9 @@ let octez_scoru_wasm_regressions = let kaitai = private_lib ~opam:"" "kaitai" ~path:"contrib/kaitai-ocaml/src" ~deps:[yaml] +(* We use a private-lib with inline-tests in order to run the tests normally, + but without placing all the code for the tests within the main kaitai + library. *) let _kaitai_test = private_lib ~opam:"" -- GitLab From 6b083abe8df33c0361272f6bc14f37857eb4d67d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= Date: Thu, 24 Aug 2023 13:51:40 +0200 Subject: [PATCH 4/4] contrib/kaitai: small fixes and improvements --- contrib/kaitai-ocaml/src/parse.ml | 17 +++++++---------- contrib/kaitai-ocaml/src/types.ml | 5 +++-- 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/contrib/kaitai-ocaml/src/parse.ml b/contrib/kaitai-ocaml/src/parse.ml index 6244bcee409c..32d3d7793e60 100644 --- a/contrib/kaitai-ocaml/src/parse.ml +++ b/contrib/kaitai-ocaml/src/parse.ml @@ -56,12 +56,7 @@ let keys m f = match k with `Scalar {value; _} -> f value v | _ -> raise Error) m.m_members -let parse ?file s = - let yaml = - match Yaml.yaml_of_string s with - | Ok x -> x - | Error (`Msg msg) -> failwith msg - in +let parse ?file ?(path = []) s = let rec classSpec yaml = let m = mapping yaml in let meta = @@ -174,10 +169,7 @@ let parse ?file s = ClassSpec. { fileName = file; - path = - (match file with - | None -> [] - | Some file -> String.split_on_char '/' file); + path; meta; doc; toStringExpr = None; @@ -205,4 +197,9 @@ let parse ?file s = EnumValueSpec.{name = id; doc} | _ -> raise Error and expression _ = Ast.Str "TODO" in + let yaml = + match Yaml.yaml_of_string s with + | Ok x -> x + | Error (`Msg msg) -> failwith msg + in classSpec yaml diff --git a/contrib/kaitai-ocaml/src/types.ml b/contrib/kaitai-ocaml/src/types.ml index 0470cc5e88d8..1e0f13f456e9 100644 --- a/contrib/kaitai-ocaml/src/types.ml +++ b/contrib/kaitai-ocaml/src/types.ml @@ -63,7 +63,7 @@ module Ast = struct | BinOp of {left : t; op : operator; right : t} | UnaryOp of {op : unaryop; operand : t} | IfExp of {condition : t; ifTrue : t; ifFalse : t} - | Dict of {keys : t list; values : t list} + (* | Dict of {keys : t list; values : t list} *) (* Represents `X < Y`, `X > Y` and so on. *) | Compare of {left : t; ops : cmpop; right : t} | Call of {func : t; args : t list} @@ -108,6 +108,7 @@ module Endianness = struct end module DataType = struct + (* https://github.com/kaitai-io/kaitai_struct_compiler/blob/master/shared/src/main/scala/io/kaitai/struct/datatype/DataType.scala *) type data_type = | NumericType | BooleanType @@ -120,7 +121,7 @@ module DataType = struct and int_type = | CalcIntType - | Int1TYpe of {signed : bool} + | Int1Type of {signed : bool} | IntMultiType of { signed : bool; width : int_width; -- GitLab