Translate src-core-utils-msg into iml

fix-engine/src-core-pp/parser_utils.iml

@@ -12,9 +12,9 @@
     a stream of key=value pairs and then into a stream of messages.
 *)
 [@@@program]
+[@@@import "../src-core-utils-msg/parse_message_util.iml"]
+[@@@import "../src-core-utils-msg/parser_combinators.iml"]
 [@@@import "parse_base_types.iml"]
-[@@@require "fix-engine.util-msg"]
-
 
 (** Split [str] into pairs of [key/value] separated by [sep],
      each pair being a [key=value] pair. *)

fix-engine/src-core-utils-msg/dune

@@ -5,4 +5,4 @@
  (modules message parse_message_util parser_combinators)
  (preprocess
   (pps ppx_deriving.std))
- (libraries))
+ (libraries imandra-prelude))

fix-engine/src-core-utils-msg/message.ml → fix-engine/src-core-utils-msg/message.iml

@@ -1,20 +1,24 @@
+[@@@program]
+
+open Caml
+
 type t = (string * string) list [@@deriving show]
 
-let checksum_string (s : string) : int =
-  let n = ref 0 in
-  for i = String.length s - 1 downto 0 do
+let checksum_string (s : string) : Int.t =
+  let n = ref 0i in
+  for i = String.length s - 1i downto 0i do
     n := !n + Char.code (String.unsafe_get s i)
   done;
   !n
 
 let checksum (msg : t) =
   let rec scan n msg =
     match msg with
-    | ("10", _v) :: _tl -> n mod 256
-    | (k, v) :: tl -> scan (checksum_string k + checksum_string v + 62 + n) tl
-    | [] -> n mod 256
+    | ("10", _v) :: _tl -> n mod 256i
+    | (k, v) :: tl -> scan (checksum_string k + checksum_string v + 62i + n) tl
+    | [] -> n mod 256i
   in
-  scan 0 msg
+  scan 0i msg
 
 let do_check_checksum = ref true
 
@@ -44,13 +48,15 @@ let valid_body_length (msg : (string * string) list) : bool =
         match msg with
         | ("8", _) :: tl | ("9", _) :: tl -> scan n tl
         | ("10", _) :: _tl -> n
-        | (k, v) :: tl -> n + scan String.(length k + length v + 2) tl
+        | (k, v) :: tl -> n + scan String.(length k + length v + 2i) tl
         | [] -> n
       in
-      scan 0 msg
+      scan 0i msg
     in
     match msg with
     | ("8", _) :: ("9", bl) :: _ ->
       (try body_length = int_of_string bl with _ -> false)
     | _ -> false
   )
+
+[@@@logic]

fix-engine/src-core-utils-msg/parse_message_util.ml → fix-engine/src-core-utils-msg/parse_message_util.iml

@@ -1,6 +1,10 @@
+[@@@program]
+
+open Caml
+
 let split_into_key_value (sep : char) (str : string) : (string * string) Seq.t =
   (* find the next split char in the internal buffer *)
-  let next_split i : int option =
+  let next_split i : Int.t option =
     match String.index_from_opt str i sep with
     | Some n when n >= String.length str -> None
     | r -> r
@@ -20,12 +24,12 @@ let split_into_key_value (sep : char) (str : string) : (string * string) Seq.t =
       match String.index_from_opt str i '=' with
       | Some idx_eq when idx_eq < end_of_kv ->
         let k = String.sub str i (idx_eq - i) in
-        let v = String.sub str (idx_eq + 1) (end_of_kv - idx_eq - 1) in
-        Seq.Cons ((k, v), loop ~is_done ~i:(end_of_kv + 1))
+        let v = String.sub str (idx_eq + 1i) (end_of_kv - idx_eq - 1i) in
+        Seq.Cons ((k, v), loop ~is_done ~i:(end_of_kv + 1i))
       | _ -> Seq.Nil
     )
   in
-  loop ~is_done:false ~i:0
+  loop ~is_done:false ~i:0i
 
 let split_into_messages (seq : (string * string) Seq.t) :
     (string * string) list Seq.t =
@@ -40,3 +44,5 @@ let split_into_messages (seq : (string * string) Seq.t) :
         loop ((k, v) :: acc) tail ()
   in
   loop [] seq
+
+[@@@logic]

fix-engine/src-core-utils-msg/parser_combinators.ml → fix-engine/src-core-utils-msg/parser_combinators.iml

@@ -1,4 +1,28 @@
 (* rewriting of Parser_utils *)
+(** Parser combinators for FIX messages.
+
+
+    Each combinator has access to the message and can query key/values.
+
+    A typical message parser would look like this.
+
+    {[
+      let parse_message = Parser_combinators.(
+        let* group = repeating "1" parse_rg in
+        let* () = check_duplicate_tags msg in
+        let* block = block parse_blk
+        and* x = req "2" parse_int
+        and* y = opt "3" parse_string
+        and* z = req "4" parse_int in
+        let+ () = check_unknown_tags in
+        \{ block; group; x; y; z \}
+      )
+    ]}
+*)
+[@@@program]
+[@@@import "message.iml"]
+
+open Caml
 
 module Str_set = Set.Make (String)
 
@@ -37,7 +61,6 @@ let pp_error fmt e =
 type nonrec 'a result = ('a, error) result
 (** Result of parsing *)
 
-open struct
   (* Extract a value given a tag, returns a pair with the value and the rest of the list.*)
   let take (key : string) (lst : (string * string) list) =
     let rec take accu = function
@@ -71,7 +94,6 @@ open struct
       | [] -> List.rev accu, []
     in
     split [] msg
-end
 
 (* internal state during parsing *)
 type state_ = { mutable msg: Message.t }
@@ -230,7 +252,7 @@ let check_unknown_tags : _ t =
         ));
   }
 
-let parse_int = int_of_string_opt
+let parse_int s = int_of_string_opt s |> Option.map Z.of_int
 
 let repeating tag ~(block_parser : 'a t) : (_ * 'a list) t =
   {
@@ -251,7 +273,7 @@ let repeating tag ~(block_parser : 'a t) : (_ * 'a list) t =
           (* Break the list into a list of lists using the separator *)
           let groups : msg list = cut_on_separator groups_msg in
           (* Check that the length is correct *)
-          if List.length groups <> numInGroup then
+          if List.length groups <> Z.to_int numInGroup then
             fail_ (IncorrectNumInGroupCount tag)
           else (
             (* Pass each list into the block parser ( reverses the list ) *)
@@ -285,3 +307,5 @@ let repeating tag ~(block_parser : 'a t) : (_ * 'a list) t =
 let run (self : _ t) (msg : msg) : _ result =
   let st = { msg } in
   try Ok (self.run st) with Fail e -> Error e
+
+[@@@logic]

fix-engine/src-protocol-pp/encode_full_messages.iml

@@ -7,8 +7,6 @@
     parse_full_messages.ml
 *)
 
-[@@@require "fix-engine.util-msg"]
-
 [@@@import "encode_full_tags.iml"]
 
 [@@@import "encode_admin_messages.iml"]
@@ -17,6 +15,8 @@
 
 [@@@import "../src-core-pp/encode_base_types.iml"]
 
+[@@@import "../src-core-utils-msg/message.iml"]
+
 [@@@program]
 
 open Full_messages

fix-engine/src-protocol-pp/parse_admin_enums.iml

@@ -7,7 +7,7 @@
 *)
 [@@@import "../src-protocol/full_admin_enums.iml"]
 
-[@@@require "fix-engine.util-msg"]
+[@@@import "../src-core-utils-msg/parser_combinators.iml"]
 
 [@@@program]
 

fix-engine/src-protocol-pp/parse_admin_messages.iml

@@ -7,14 +7,14 @@
     parse_admin_messages.ml
 
 *)
-[@@@require "fix-engine.util-msg"]
 [@@@import "../src-protocol/full_admin_tags.iml"]
 [@@@import "../src-protocol/full_admin_messages.iml"]
 [@@@import "../src-core-pp/parse_base_types.iml"]
 [@@@import "../src-core-pp/parse_datetime.iml"]
 [@@@import "parse_admin_enums.iml"]
 [@@@import "parse_full_tags.iml"]
 [@@@import "../src-core/datetime.iml"]
+[@@@import "../src-core-utils-msg/parser_combinators.iml"]
 [@@@program]
 open Full_admin_tags;;
 open Full_admin_messages;;

fix-engine/src-protocol-pp/parse_admin_tags.iml

@@ -8,7 +8,7 @@
 
 *)
 [@@@import "../src-protocol/full_admin_tags.iml"]
-[@@@require "fix-engine.util-msg"]
+[@@@import "../src-core-utils-msg/parser_combinators.iml"]
 
 [@@@program]
 open Full_admin_tags;;

fix-engine/src-protocol-pp/parse_full_messages.iml

@@ -7,14 +7,14 @@
     parse_full_messages.ml
 *)
 
-[@@@require "fix-engine.util-msg"]
-
 [@@@import "../src-protocol/full_message_tags.iml"]
 
 [@@@import "../src-protocol/full_messages.iml"]
 
 [@@@import "../src-core-pp/parse_base_types.iml"]
 
+[@@@import "../src-core-utils-msg/parser_combinators.iml"]
+
 [@@@import "parse_full_tags.iml"]
 
 [@@@import "parse_admin_messages.iml"]