From 320954996e921d7b34eb61f462799b5c6ab8ee09 Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Sat, 26 Sep 2026 22:09:11 -0300 Subject: new shrunk API for RNT on sakura --- lib/condition.ml | 49 ++++++++++++------------------------------------- 1 file changed, 12 insertions(+), 37 deletions(-) (limited to 'lib/condition.ml') diff --git a/lib/condition.ml b/lib/condition.ml index c565b59..e4d4384 100644 --- a/lib/condition.ml +++ b/lib/condition.ml @@ -1,56 +1,31 @@ -class type serializable = object - method as_sexp : Sexplib.Sexp.t - method as_string : string -end +type properties = (string, Value.t) BatMap.t +type ps = properties -> properties -class literal (expr : Sexplib.Sexp.t) : serializable = - object - method as_sexp = expr - method as_string = Sexplib.Sexp.to_string_hum expr - end +type condition = + {name: string; message: string; backtrace: Printexc.raw_backtrace; properties: properties} -let of_sexp (expr : Sexplib.Sexp.t) = new literal expr -let of_string (s : string) = new literal (Sexplib.Sexp.Atom s) -let of_int (n : int) = of_string (Int.to_string n) - -let of_list (f : 'a -> serializable) (l : 'a list) : serializable = - new literal (Sexplib.Sexp.List (List.map (fun e -> (f e)#as_sexp) l)) - -type t = - { name: string; - message: string; - backtrace: Printexc.raw_backtrace; - properties: (string, serializable) BatMap.t } +let ( |=| ) name value = fun p -> BatMap.add name value p +let ( & ) l r = fun p -> r (l p) +let empty = fun p -> p let condition name message ?parent props = { name; message; - backtrace= Printexc.get_callstack 64; + backtrace= Printexc.get_callstack 256; properties= parent |> Option.map (fun {properties; _} -> properties) |> Option.value ~default:BatMap.empty |> props } -let ( |=| ) name value = fun p -> BatMap.add name value p -let ( & ) l r = fun p -> r (l p) -let empty = fun p -> p - -let to_sexp {name; message; properties; _} = - let open Sexplib.Sexp in - let properties' = - properties - |> BatMap.to_seq - |> BatSeq.map (fun (k, v) -> List [Atom k; v#as_sexp]) - |> BatList.of_seq - in - List (Atom name :: Atom message :: properties') +let complement props ({properties; _} as condition) = {condition with properties= props properties} -let to_string {name; message; properties; backtrace} = +let to_string_hum {name; message; properties; backtrace} = let properties' = properties |> BatMap.to_seq - |> BatSeq.to_string ~first:"" ~last:"" ~sep:"\n" (fun (k, v) -> "\t" ^ k ^ ": " ^ v#as_string) + |> BatSeq.to_string ~first:"" ~last:"" ~sep:"\n" (fun (k, v) -> + "\t" ^ k ^ ": " ^ Value.to_string v ) in let backtrace' = Printexc.raw_backtrace_to_string backtrace in name ^ ": " ^ message ^ "\n" ^ properties' ^ "\n\nBacktrace:\n" ^ backtrace' -- cgit v1.2.3