diff --git a/build_system/clerk_driver.ml b/build_system/clerk_driver.ml index 468cb638..c8a38dd4 100644 --- a/build_system/clerk_driver.ml +++ b/build_system/clerk_driver.ml @@ -347,9 +347,7 @@ module Poll = struct let ocaml_link_flags : string list Lazy.t = lazy - (let link_libs = - ["yojson"; "ppx_yojson_conv_lib"; "zarith"; "dates_calc"] - in + (let link_libs = ["zarith"; "dates_calc"] in let link_libs_flags = List.concat_map (fun lib -> diff --git a/catala.opam b/catala.opam index 6314cfe8..f3d5c774 100644 --- a/catala.opam +++ b/catala.opam @@ -31,8 +31,6 @@ depends: [ "ocaml" {>= "4.14.0"} "ocamlfind" {!= "1.9.5"} "ocamlgraph" {>= "1.8.8"} - "yojson" {>= "2.0" } - "ppx_yojson_conv" {>= "0.14.0"} "re" {>= "1.9.0"} "sedlex" {>= "2.4"} "uutf" {>= "1.0.3"} diff --git a/compiler/lcalc/to_ocaml.ml b/compiler/lcalc/to_ocaml.ml index c1e94115..3fdeb7bc 100644 --- a/compiler/lcalc/to_ocaml.ml +++ b/compiler/lcalc/to_ocaml.ml @@ -462,7 +462,7 @@ let format_struct_embedding format_struct_name struct_name format_to_module_name (`Sname struct_name) else Format.fprintf fmt - "@[let embed_%a (x: %a.t) : runtime_value =@ Struct([\"%a\"],@ \ + "@[let embed_%a (x: %a.t) : runtime_value =@ Struct(\"%a\",@ \ @[[%a]@])@]@\n\ @\n" format_struct_name struct_name format_to_module_name (`Sname struct_name) @@ -485,7 +485,7 @@ let format_enum_embedding else Format.fprintf fmt "@[@[let embed_%a@ @[(x:@ %a.t)@]@ : runtime_value \ - =@]@ Enum([\"%a\"],@ @[match x with@ %a@])@]@\n\ + =@]@ Enum(\"%a\",@ @[match x with@ %a@])@]@\n\ @\n" format_enum_name enum_name format_to_module_name (`Ename enum_name) EnumName.format enum_name diff --git a/compiler/shared_ast/interpreter.ml b/compiler/shared_ast/interpreter.ml index 1e596e40..7824706d 100644 --- a/compiler/shared_ast/interpreter.ml +++ b/compiler/shared_ast/interpreter.ml @@ -994,7 +994,7 @@ let interpret_program_dcalc p s : (Uid.MarkedString.info * ('a, 'm) gexpr) list built-in interpreter does not have a way to retrieve input \ values from the command line, so it cannot execute this scope. \ Please create another scope that provides the input arguments \ - to this one and execute it instead. ") + to this one and execute it instead.") taus in let to_interpret = diff --git a/runtimes/jsoo/runtime.ml b/runtimes/jsoo/runtime.ml index 7854ce62..aaa35847 100644 --- a/runtimes/jsoo/runtime.ml +++ b/runtimes/jsoo/runtime.ml @@ -84,83 +84,75 @@ let event_manager : event_manager Js.t = method resetLog = Js.wrap_meth_callback R_ocaml.reset_log method retrieveEvents = - Js.wrap_meth_callback (fun () -> - Js.array - (Array.of_list - (R_ocaml.retrieve_log () - |> R_ocaml.EventParser.parse_raw_events - |> List.map (fun event -> - object%js - val mutable data = - event - |> R_ocaml.yojson_of_event - |> Yojson.Safe.to_string - |> Js.string - end)))) + Js.wrap_meth_callback + @@ fun () -> + R_ocaml.retrieve_log () + |> R_ocaml.EventParser.parse_raw_events + |> List.map (fun event -> + object%js + val mutable data = event |> R_ocaml.Json.event |> Js.string + end) + |> Array.of_list + |> Js.array method retrieveRawEvents = - Js.wrap_meth_callback (fun () -> - Js.array - (Array.of_list - (List.map - (fun evt -> - object%js - val mutable eventType = - Js.string - (match evt with - | R_ocaml.BeginCall _ -> "Begin call" - | EndCall _ -> "End call" - | VariableDefinition _ -> "Variable definition" - | DecisionTaken _ -> "Decision taken") + let evt_to_js evt = + (* FIXME: ideally this could be just a Json.parse (R_ocaml.Json.event + foo) ? *) + object%js + val mutable eventType = + (match evt with + | R_ocaml.BeginCall _ -> "Begin call" + | EndCall _ -> "End call" + | VariableDefinition _ -> "Variable definition" + | DecisionTaken _ -> "Decision taken") + |> Js.string - val mutable information = - Js.array - (Array.of_list - (match evt with - | BeginCall info - | EndCall info - | VariableDefinition (info, _, _) -> - List.map Js.string info - | DecisionTaken _ -> [])) + val mutable information = + (match evt with + | BeginCall info | EndCall info | VariableDefinition (info, _, _) -> + List.map Js.string info + | DecisionTaken _ -> []) + |> Array.of_list + |> Js.array - val mutable loggedIOJson = - match evt with - | VariableDefinition (_, io, _) -> - io - |> R_ocaml.yojson_of_io_log - |> Yojson.Safe.to_string - |> Js.string - | EndCall _ | BeginCall _ | DecisionTaken _ -> - "unavailable" |> Js.string + val mutable loggedIOJson = + match evt with + | VariableDefinition (_, io, _) -> + io |> R_ocaml.Json.io_log |> Js.string + | EndCall _ | BeginCall _ | DecisionTaken _ -> + "unavailable" |> Js.string - val mutable loggedValueJson = - (match evt with - | VariableDefinition (_, _, v) -> v - | EndCall _ | BeginCall _ | DecisionTaken _ -> - R_ocaml.unembeddable ()) - |> R_ocaml.yojson_of_runtime_value - |> Yojson.Safe.to_string - |> Js.string + val mutable loggedValueJson = + (match evt with + | VariableDefinition (_, _, v) -> v + | EndCall _ | BeginCall _ | DecisionTaken _ -> + R_ocaml.unembeddable ()) + |> R_ocaml.Json.runtime_value + |> Js.string - val mutable sourcePosition = - match evt with - | DecisionTaken pos -> - Js.def - (object%js - val mutable fileName = Js.string pos.filename - val mutable startLine = pos.start_line - val mutable endLine = pos.end_line - val mutable startColumn = pos.start_column - val mutable endColumn = pos.end_column + val mutable sourcePosition = + match evt with + | DecisionTaken pos -> + Js.def + (object%js + val mutable fileName = Js.string pos.filename + val mutable startLine = pos.start_line + val mutable endLine = pos.end_line + val mutable startColumn = pos.start_column + val mutable endColumn = pos.end_column - val mutable lawHeadings = - Js.array - (Array.of_list - (List.map Js.string pos.law_headings)) - end) - | _ -> Js.undefined - end) - (R_ocaml.retrieve_log ())))) + val mutable lawHeadings = + List.map Js.string pos.law_headings + |> Array.of_list + |> Js.array + end) + | _ -> Js.undefined + end + in + Js.wrap_meth_callback + @@ fun () -> + R_ocaml.retrieve_log () |> List.map evt_to_js |> Array.of_list |> Js.array end let execute_or_throw_error f = diff --git a/runtimes/ocaml/dune b/runtimes/ocaml/dune index 03c76b5c..ca18edc3 100644 --- a/runtimes/ocaml/dune +++ b/runtimes/ocaml/dune @@ -1,7 +1,5 @@ (library (name runtime_ocaml) (public_name catala.runtime_ocaml) - (preprocess - (pps ppx_yojson_conv)) (libraries dates_calc zarith zarith_stubs_js) (modules runtime)) diff --git a/runtimes/ocaml/runtime.ml b/runtimes/ocaml/runtime.ml index 0c642beb..e9592785 100644 --- a/runtimes/ocaml/runtime.ml +++ b/runtimes/ocaml/runtime.ml @@ -13,8 +13,6 @@ WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. *) -open Ppx_yojson_conv_lib.Yojson_conv.Primitives - type nonrec unit = unit type nonrec bool = bool @@ -30,8 +28,8 @@ module Eoption = struct type 'a t = ENone of unit | ESome of 'a end -type io_input = NoInput | OnlyInput | Reentrant [@@deriving yojson_of] -type io_log = { io_input : io_input; io_output : bool } [@@deriving yojson_of] +type io_input = NoInput | OnlyInput | Reentrant +type io_log = { io_input : io_input; io_output : bool } type source_position = { filename : string; @@ -41,7 +39,6 @@ type source_position = { end_column : int; law_headings : string list; } -[@@deriving yojson_of] exception EmptyError exception AssertionFailed of source_position @@ -190,12 +187,6 @@ let duration_to_string (d : duration) : string = let duration_to_years_months_days (d : duration) : int * int * int = Dates_calc.Dates.period_to_ymds d -let yojson_of_money (m : money) = `Float (money_to_float m) -let yojson_of_integer (i : integer) = `Int (integer_to_int i) -let yojson_of_decimal (d : decimal) = `Float (decimal_to_float d) -let yojson_of_date (d : date) = `String (date_to_string d) -let yojson_of_duration (d : duration) = `String (duration_to_string d) - type runtime_value = | Unit | Bool of bool @@ -204,11 +195,10 @@ type runtime_value = | Decimal of decimal | Date of date | Duration of duration - | Enum of string list * (string * runtime_value) - | Struct of string list * (string * runtime_value) list + | Enum of string * (string * runtime_value) + | Struct of string * (string * runtime_value) list | Array of runtime_value array | Unembeddable -[@@deriving yojson_of] let unembeddable _ = Unembeddable let embed_unit () = Unit @@ -220,7 +210,7 @@ let embed_date x = Date x let embed_duration x = Duration x let embed_array f x = Array (Array.map f x) -type information = string list [@@deriving yojson_of] +type information = string list type raw_event = | BeginCall of information @@ -236,7 +226,6 @@ type event = inputs : var_def list; body : event list; } -[@@deriving yojson_of] and var_def = { pos : source_position option; @@ -253,6 +242,108 @@ and fun_call = { output : var_def; } +module BufferedJson = struct + let rec list f buf = function + | [] -> () + | [x] -> f buf x + | x :: r -> + f buf x; + Buffer.add_char buf ','; + list f buf r + + let quote buf str = + Buffer.add_char buf '"'; + String.iter + (function + | ('"' | '\\') as c -> + Buffer.add_char buf '\\'; + Buffer.add_char buf c + | '\n' -> Buffer.add_string buf "\\n" + | '\t' -> Buffer.add_string buf "\\t" + | '\r' -> Buffer.add_string buf "\\r" + | '\x00' .. '\x1F' as c -> Printf.bprintf buf "\\u%04x" (int_of_char c) + | c -> Buffer.add_char buf c) + str; + Buffer.add_char buf '"' + + (* Note: the output format is made for transition with what Yojson gave us, + but we could change it to something nicer (e.g. objects for structures) *) + let rec runtime_value buf = function + | Unit -> Buffer.add_string buf {|"Unit"|} + | Bool b -> Buffer.add_string buf (string_of_bool b) + | Money m -> Buffer.add_string buf (money_to_string m) + | Integer i -> Buffer.add_string buf (integer_to_string i) + | Decimal d -> + Buffer.add_string buf (decimal_to_string ~max_prec_digits:10 d) + | Date d -> quote buf (date_to_string d) + | Duration d -> quote buf (duration_to_string d) + | Enum (name, (constr, v)) -> + Printf.bprintf buf {|[["%s"],["%s",%a]]|} name constr runtime_value v + | Struct (name, elts) -> + Printf.bprintf buf {|["%s",[%a]]|} name + (list (fun buf (cstr, v) -> + Printf.bprintf buf {|"%s":%a|} cstr runtime_value v)) + elts + | Array elts -> + Printf.bprintf buf "[%a]" (list runtime_value) (Array.to_list elts) + | Unembeddable -> Buffer.add_string buf {|"unembeddable"|} + + let information buf info = Printf.bprintf buf "[%a]" (list quote) info + + let source_position buf pos = + Printf.bprintf buf {|{"filename":%a|} quote pos.filename; + Printf.bprintf buf {|,"start_line":%d|} pos.start_line; + Printf.bprintf buf {|,"start_column":%d|} pos.start_column; + Printf.bprintf buf {|,"end_line":%d|} pos.end_line; + Printf.bprintf buf {|,"end_column":%d|} pos.end_column; + Printf.bprintf buf {|,"law_headings":[%a]}|} (list quote) pos.law_headings + + let io_input buf = function + | NoInput -> quote buf "NoInput" + | OnlyInput -> quote buf "OnlyInput" + | Reentrant -> quote buf "Reentrant" + + let io_log buf iol = + Printf.bprintf buf {|{"io_input":%a|} io_input iol.io_input; + Printf.bprintf buf {|,"io_output":%b}|} iol.io_output + + let rec event buf = function + | VarComputation vd -> + Printf.bprintf buf {|"VarComputation",%a]|} var_def vd + | FunCall fc -> Printf.bprintf buf {|"FunCall",%a]|} fun_call fc + | SubScopeCall { name; inputs; body } -> + Printf.bprintf buf {|{"name":%a,"inputs":[%a],"body":[%a]}|} information + name (list var_def) inputs (list event) body + + and var_def buf def = + Option.iter (Printf.bprintf buf {|{"pos":%a|} source_position) def.pos; + Printf.bprintf buf {|,"name":%a|} information def.name; + Printf.bprintf buf {|,"io":%a|} io_log def.io; + Printf.bprintf buf {|,"value":%a|} runtime_value def.value; + Option.iter + (Printf.bprintf buf {|,"fun_calls":[%a]}|} (list fun_call)) + def.fun_calls + + and fun_call buf fc = + Printf.bprintf buf {|{"fun_name":%a|} information fc.fun_name; + Printf.bprintf buf {|,"fun_inputs":[%a]|} (list var_def) fc.fun_inputs; + Printf.bprintf buf {|,"body":[%a]|} (list event) fc.body; + Printf.bprintf buf {|,"output":%a}|} var_def fc.output +end + +module Json = struct + let str f x = + let buf = Buffer.create 800 in + f buf x; + Buffer.contents buf + + open BufferedJson + + let runtime_value = str runtime_value + let io_log = str io_log + let event = str event +end + let log_ref : raw_event list ref = ref [] let reset_log () = log_ref := [] let retrieve_log () = List.rev !log_ref @@ -313,8 +404,7 @@ let rec pp_events ?(is_first_call = true) ppf events = | Duration x -> Format.fprintf ppf "%s" (duration_to_string x) | Enum (_, (name, _)) -> Format.fprintf ppf "%s" name | Struct (name, attrs) -> - Format.fprintf ppf "@[%s = {@ %a@;<1 -2>}@]" - (String.concat "." name) + Format.fprintf ppf "@[%s = {@ %a@;<1 -2>}@]" name (Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@,") (fun fmt (name, value) -> @@ -414,7 +504,7 @@ module EventParser = struct | VariableDefinition (name, io, value) -> Printf.sprintf "VariableDefinition([ %s ], %s, %s)" (String.concat ", " name) (io_log_to_string io) - (yojson_of_runtime_value value |> Yojson.Safe.to_string) + (Json.runtime_value value) | DecisionTaken pos -> Printf.sprintf "DecisionTaken(%s:%d.%d-%d.%d)" pos.filename pos.start_line pos.start_column pos.end_line pos.end_column diff --git a/runtimes/ocaml/runtime.mli b/runtimes/ocaml/runtime.mli index b5c4fa9f..7bc3a095 100644 --- a/runtimes/ocaml/runtime.mli +++ b/runtimes/ocaml/runtime.mli @@ -57,13 +57,11 @@ type io_input = | Reentrant (** For variables defined in the scope that can also be redefined by the caller as they appear in the input. *) -[@@deriving yojson_of] type io_log = { io_input : io_input; io_output : bool; (** [true] if the variable is an output *) } -[@@deriving yojson_of] (** {1 Exceptions} *) @@ -85,11 +83,10 @@ type runtime_value = | Decimal of decimal | Date of date | Duration of duration - | Enum of string list * (string * runtime_value) - | Struct of string list * (string * runtime_value) list + | Enum of string * (string * runtime_value) + | Struct of string * (string * runtime_value) list | Array of runtime_value Array.t | Unembeddable -[@@deriving yojson_of] val unembeddable : 'a -> runtime_value val embed_unit : unit -> runtime_value @@ -115,7 +112,7 @@ val embed_array : ('a -> runtime_value) -> 'a Array.t -> runtime_value (** {2 Data structures} *) -type information = string list [@@deriving yojson_of] +type information = string list (** Represents information about a name in the code -- i.e. variable name, subscope name, etc... @@ -188,7 +185,6 @@ type event = inputs : var_def list; body : event list; } -[@@deriving yojson_of] and var_def = { pos : source_position option; @@ -230,6 +226,16 @@ val log_decision_taken : source_position -> bool -> bool (** {3 Pretty printers} *) +(** {4 Conversions to JSON} *) +module Json : sig + (* val io_input: io_input -> string *) + val io_log : io_log -> string + val runtime_value : runtime_value -> string + + (* val information: information -> string *) + val event : event -> string +end + val pp_events : ?is_first_call:bool -> Format.formatter -> event list -> unit (** [pp_events ~is_first_call ppf events] pretty prints in [ppf] the string representation of [events].