diff --git a/build_system/clerk_driver.ml b/build_system/clerk_driver.ml index dc9d8b0b..fde83c61 100644 --- a/build_system/clerk_driver.ml +++ b/build_system/clerk_driver.ml @@ -410,7 +410,7 @@ let collect_inline_ninja_builds let test_name = tested_file |> (if reset_test_outputs then Printf.sprintf "reset_file_%s" - else Printf.sprintf "test_file_%s") + else Printf.sprintf "test_file_%s") |> Nj.Build.unpath in Some @@ -479,7 +479,7 @@ let collect_all_ninja_build let test_name = tested_file |> (if reset_test_outputs then Printf.sprintf "reset_file_%s" - else Printf.sprintf "test_file_%s") + else Printf.sprintf "test_file_%s") |> Nj.Build.unpath in Some diff --git a/build_system/ninja_utils.mli b/build_system/ninja_utils.mli index 314ec7a5..af7781d0 100644 --- a/build_system/ninja_utils.mli +++ b/build_system/ninja_utils.mli @@ -63,8 +63,8 @@ end (** {1 Ninja rules} *) -(** Helper module to build {{:https://ninja-build.org/manual.html#_rules} ninja - rules}. *) +(** Helper module to build + {{:https://ninja-build.org/manual.html#_rules} ninja rules}. *) module Rule : sig type t = { name : string; command : Expr.t; description : Expr.t option } (** Represents the minimal ninja rule representation for Clerk: diff --git a/compiler/catala_utils/mark.mli b/compiler/catala_utils/mark.mli index 56763421..95a5ace5 100644 --- a/compiler/catala_utils/mark.mli +++ b/compiler/catala_utils/mark.mli @@ -43,45 +43,39 @@ val equal : ('a -> 'a -> bool) -> ('a, 'm) ed -> ('a, 'm) ed -> bool (** Visitors *) -class ['self] marked_map : - object ('self) - constraint - 'self = < visit_marked : - 'a. ('env -> 'a -> 'a) -> 'env -> ('a, 'm) ed -> ('a, 'm) ed - ; .. > +class ['self] marked_map : object ('self) + constraint + 'self = < visit_marked : + 'a. ('env -> 'a -> 'a) -> 'env -> ('a, 'm) ed -> ('a, 'm) ed + ; .. > - method visit_marked : - 'a. ('env -> 'a -> 'a) -> 'env -> ('a, 'm) ed -> ('a, 'm) ed - end + method visit_marked : + 'a. ('env -> 'a -> 'a) -> 'env -> ('a, 'm) ed -> ('a, 'm) ed +end -class ['self] marked_iter : - object ('self) - constraint - 'self = < visit_marked : - 'a. ('env -> 'a -> unit) -> 'env -> ('a, 'm) ed -> unit - ; .. > +class ['self] marked_iter : object ('self) + constraint + 'self = < visit_marked : + 'a. ('env -> 'a -> unit) -> 'env -> ('a, 'm) ed -> unit + ; .. > - method visit_marked : - 'a. ('env -> 'a -> unit) -> 'env -> ('a, 'm) ed -> unit - end + method visit_marked : 'a. ('env -> 'a -> unit) -> 'env -> ('a, 'm) ed -> unit +end -class ['self] pos_map : - object ('self) - constraint - 'self = < visit_pos : - 'a. ('env -> 'a -> 'a) -> 'env -> ('a, 'm) ed -> ('a, 'm) ed - ; .. > +class ['self] pos_map : object ('self) + constraint + 'self = < visit_pos : + 'a. ('env -> 'a -> 'a) -> 'env -> ('a, 'm) ed -> ('a, 'm) ed + ; .. > - method visit_pos : - 'a. ('env -> 'a -> 'a) -> 'env -> ('a, 'm) ed -> ('a, 'm) ed - end + method visit_pos : + 'a. ('env -> 'a -> 'a) -> 'env -> ('a, 'm) ed -> ('a, 'm) ed +end -class ['self] pos_iter : - object ('self) - constraint - 'self = < visit_pos : - 'a. ('env -> 'a -> unit) -> 'env -> ('a, 'm) ed -> unit - ; .. > +class ['self] pos_iter : object ('self) + constraint + 'self = < visit_pos : 'a. ('env -> 'a -> unit) -> 'env -> ('a, 'm) ed -> unit + ; .. > - method visit_pos : 'a. ('env -> 'a -> unit) -> 'env -> ('a, 'm) ed -> unit - end + method visit_pos : 'a. ('env -> 'a -> unit) -> 'env -> ('a, 'm) ed -> unit +end diff --git a/compiler/catala_utils/pos.mli b/compiler/catala_utils/pos.mli index efce5f71..ac8181d4 100644 --- a/compiler/catala_utils/pos.mli +++ b/compiler/catala_utils/pos.mli @@ -53,7 +53,7 @@ val to_string_short : t -> string This function is compliant with the {{:https://www.gnu.org/prep/standards/standards.html#Errors} GNU coding - standards}. *) + standards}. *) val format_loc_text : Format.formatter -> t -> unit (** Open the file corresponding to the position and retrieves the text concerned diff --git a/compiler/desugared/dependency.ml b/compiler/desugared/dependency.ml index 6cc72798..79b664ef 100644 --- a/compiler/desugared/dependency.ml +++ b/compiler/desugared/dependency.ml @@ -14,8 +14,8 @@ License for the specific language governing permissions and limitations under the License. *) -(** Scope dependencies computations using {{:http://ocamlgraph.lri.fr/} - OCamlgraph} *) +(** Scope dependencies computations using + {{:http://ocamlgraph.lri.fr/} OCamlgraph} *) open Catala_utils open Shared_ast diff --git a/compiler/desugared/dependency.mli b/compiler/desugared/dependency.mli index aee2f7b7..d475b629 100644 --- a/compiler/desugared/dependency.mli +++ b/compiler/desugared/dependency.mli @@ -14,8 +14,8 @@ License for the specific language governing permissions and limitations under the License. *) -(** Scope dependencies computations using {{:http://ocamlgraph.lri.fr/} - OCamlgraph} *) +(** Scope dependencies computations using + {{:http://ocamlgraph.lri.fr/} OCamlgraph} *) open Catala_utils open Shared_ast diff --git a/compiler/desugared/from_surface.ml b/compiler/desugared/from_surface.ml index d62d2eb7..7f420e6b 100644 --- a/compiler/desugared/from_surface.ml +++ b/compiler/desugared/from_surface.ml @@ -902,7 +902,7 @@ and disambiguate_match_and_build_expression List.fold_left bind_match_cases (EnumConstructor.Map.empty, None, 0) cases in naked_expr, Option.get e_name - [@@ocamlformat "wrap-comments=false"] +[@@ocamlformat "wrap-comments=false"] (** {1 Translating scope definitions} *) @@ -988,7 +988,8 @@ let process_rule_parameters in local_vars, Some (params, pos_def) -(** Translates a surface definition into condition into a desugared {!type: +(** Translates a surface definition into condition into a desugared + {!type: Ast.rule} *) let process_default (ctxt : Name_resolution.context) diff --git a/compiler/desugared/linting.ml b/compiler/desugared/linting.ml index 53271445..52aa2bc9 100644 --- a/compiler/desugared/linting.ml +++ b/compiler/desugared/linting.ml @@ -94,7 +94,7 @@ let detect_identical_rules (p : program) : unit = "These %s have identical justifications and consequences; is \ it a mistake?" (if scope_def.scope_def_is_condition then "rules" - else "definitions")) + else "definitions")) rules_seen) scope.scope_defs) p.program_scopes diff --git a/compiler/driver.ml b/compiler/driver.ml index b04d4500..86274c24 100644 --- a/compiler/driver.ml +++ b/compiler/driver.ml @@ -570,7 +570,7 @@ module Commands = struct (fun ((var, _), result) -> Message.emit_result "@[%s@ =@ %a@]" var (if options.Cli.debug then Print.expr ~debug:false () - else Print.UserFacing.value (get_lang options options.input_file)) + else Print.UserFacing.value (get_lang options options.input_file)) result) results diff --git a/compiler/lcalc/closure_conversion.ml b/compiler/lcalc/closure_conversion.ml index e12cfcd3..918d6ff0 100644 --- a/compiler/lcalc/closure_conversion.ml +++ b/compiler/lcalc/closure_conversion.ml @@ -46,7 +46,7 @@ let rec transform_closures_expr : e | EVar v -> ( (if Var.Set.mem v ctx.globally_bound_vars then Var.Set.empty - else Var.Set.singleton v), + else Var.Set.singleton v), (Bindlib.box_var v, m) ) | EMatch { e; cases; name } -> let free_vars, new_e = (transform_closures_expr ctx) e in @@ -148,13 +148,13 @@ let rec transform_closures_expr : (Mark.get e)) [ (if extra_vars_list = [] then Expr.elit LUnit binder_mark - else - Expr.etuple - (List.map - (fun extra_var -> - Bindlib.box_var extra_var, binder_mark) - extra_vars_list) - m); + else + Expr.etuple + (List.map + (fun extra_var -> + Bindlib.box_var extra_var, binder_mark) + extra_vars_list) + m); ] (Mark.get e); ]) diff --git a/compiler/literate/html.ml b/compiler/literate/html.ml index 5a378498..53366ef2 100644 --- a/compiler/literate/html.ml +++ b/compiler/literate/html.ml @@ -188,9 +188,9 @@ let rec law_structure_to_html href=\"https://legifrance.gouv.fr/%s/id/%s\" \ target=\"_blank\">Voir le texte sur Légifrance.gouv.fr" (if String.starts_with ~prefix:"LEGIARTI" id then "codes" - else if String.starts_with ~prefix:"JORFARTI" id then "jorf" - else if String.starts_with ~prefix:"CETATEXT" id then "ceta" - else raise Not_found) + else if String.starts_with ~prefix:"JORFARTI" id then "jorf" + else if String.starts_with ~prefix:"CETATEXT" id then "ceta" + else raise Not_found) id with Not_found -> "") | _ -> "") diff --git a/compiler/plugins/explain.ml b/compiler/plugins/explain.ml index 6fa22cf2..7e64a718 100644 --- a/compiler/plugins/explain.ml +++ b/compiler/plugins/explain.ml @@ -1219,15 +1219,15 @@ let to_dot lang ppf ctx env base_vars g ~base_src_url = in `Label (vertex_label v (* ^ "\n" ^ loc_text *)) :: `Comment loc_text - (* :: `Url - * ("http://localhost:8080/fr/examples/housing-benefits#" - * ^ Re.( - * replace_string - * (compile - * (seq [char '/'; rep1 (diff any (char '/')); str "/../"])) - * ~by:"/" (Pos.get_file pos)) - * ^ "-" - * ^ string_of_int (Pos.get_start_line pos)) *) + (* :: `Url + * ("http://localhost:8080/fr/examples/housing-benefits#" + * ^ Re.( + * replace_string + * (compile + * (seq [char '/'; rep1 (diff any (char '/')); str "/../"])) + * ~by:"/" (Pos.get_file pos)) + * ^ "-" + * ^ string_of_int (Pos.get_start_line pos)) *) :: `Url (base_src_url ^ "/" diff --git a/compiler/scalc/to_python.ml b/compiler/scalc/to_python.ml index 43430f7e..5601fdf2 100644 --- a/compiler/scalc/to_python.ml +++ b/compiler/scalc/to_python.ml @@ -498,21 +498,21 @@ let format_ctx format_typ struct_field_type)) fields (if StructField.Map.is_empty struct_fields then fun fmt _ -> - Format.fprintf fmt " pass" - else - Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n") - (fun fmt (struct_field, _) -> - Format.fprintf fmt " self.%a = %a" format_struct_field_name - struct_field format_struct_field_name struct_field)) + Format.fprintf fmt " pass" + else + Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n") + (fun fmt (struct_field, _) -> + Format.fprintf fmt " self.%a = %a" format_struct_field_name + struct_field format_struct_field_name struct_field)) fields format_struct_name struct_name (if not (StructField.Map.is_empty struct_fields) then - Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.fprintf fmt " and@ ") - (fun fmt (struct_field, _) -> - Format.fprintf fmt "self.%a == other.%a" format_struct_field_name - struct_field format_struct_field_name struct_field) - else fun fmt _ -> Format.fprintf fmt "True") + Format.pp_print_list + ~pp_sep:(fun fmt () -> Format.fprintf fmt " and@ ") + (fun fmt (struct_field, _) -> + Format.fprintf fmt "self.%a == other.%a" format_struct_field_name + struct_field format_struct_field_name struct_field) + else fun fmt _ -> Format.fprintf fmt "True") fields format_struct_name struct_name (Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt ",") diff --git a/compiler/scalc/to_r.ml b/compiler/scalc/to_r.ml index 9204d7cd..41609f0e 100644 --- a/compiler/scalc/to_r.ml +++ b/compiler/scalc/to_r.ml @@ -36,9 +36,9 @@ let format_lit (fmt : Format.formatter) (l : lit Mark.pos) : unit = | LRat i -> Format.fprintf fmt "catala_decimal_from_fraction(%s,%s)" (if Z.fits_nativeint (Q.num i) then Z.to_string (Q.num i) - else "\"" ^ Z.to_string (Q.num i) ^ "\"") + else "\"" ^ Z.to_string (Q.num i) ^ "\"") (if Z.fits_nativeint (Q.den i) then Z.to_string (Q.den i) - else "\"" ^ Z.to_string (Q.den i) ^ "\"") + else "\"" ^ Z.to_string (Q.den i) ^ "\"") | LMoney e -> if Z.fits_nativeint e then Format.fprintf fmt "catala_money_from_cents(%s)" diff --git a/compiler/scopelang/dependency.ml b/compiler/scopelang/dependency.ml index f1aac70a..6ca56c77 100644 --- a/compiler/scopelang/dependency.ml +++ b/compiler/scopelang/dependency.ml @@ -327,29 +327,29 @@ let check_type_cycles (structs : struct_ctx) (enums : enum_ctx) : TVertex.t list cardinality > 1 *) let sccs = TSCC.scc_list g in (if List.length sccs < TDependencies.nb_vertex g then - let scc = List.find (fun scc -> List.length scc > 1) sccs in - let spans = - List.flatten - (List.map - (fun v -> - let var_str, var_info = - Format.asprintf "%a" TVertex.format v, TVertex.get_info v - in - let succs = TDependencies.succ_e g v in - let _, edge_pos, succ = - List.find (fun (_, _, succ) -> List.mem succ scc) succs - in - let succ_str = Format.asprintf "%a" TVertex.format succ in - [ - Some ("Cycle type " ^ var_str ^ ", declared:"), Mark.get var_info; - ( Some - ("Used here in the definition of another cycle type " - ^ succ_str - ^ ":"), - edge_pos ); - ]) - scc) - in - Message.raise_multispanned_error spans - "Cyclic dependency detected between types!"); + let scc = List.find (fun scc -> List.length scc > 1) sccs in + let spans = + List.flatten + (List.map + (fun v -> + let var_str, var_info = + Format.asprintf "%a" TVertex.format v, TVertex.get_info v + in + let succs = TDependencies.succ_e g v in + let _, edge_pos, succ = + List.find (fun (_, _, succ) -> List.mem succ scc) succs + in + let succ_str = Format.asprintf "%a" TVertex.format succ in + [ + Some ("Cycle type " ^ var_str ^ ", declared:"), Mark.get var_info; + ( Some + ("Used here in the definition of another cycle type " + ^ succ_str + ^ ":"), + edge_pos ); + ]) + scc) + in + Message.raise_multispanned_error spans + "Cyclic dependency detected between types!"); List.rev (TTopologicalTraversal.fold (fun v acc -> v :: acc) g []) diff --git a/compiler/scopelang/print.ml b/compiler/scopelang/print.ml index 6c6e3daa..96c77896 100644 --- a/compiler/scopelang/print.ml +++ b/compiler/scopelang/print.ml @@ -61,9 +61,9 @@ let scope ?debug ctx fmt (name, (decl, _pos)) = | OnlyInput -> "input" | Reentrant -> "context") (if Mark.remove vis.Desugared.Ast.io_output then fun fmt () -> - Format.fprintf fmt "%a@,%a" Print.punctuation "|" Print.keyword - "output" - else fun fmt () -> Format.fprintf fmt "@<0>") + Format.fprintf fmt "%a@,%a" Print.punctuation "|" Print.keyword + "output" + else fun fmt () -> Format.fprintf fmt "@<0>") () Print.punctuation ")")) (ScopeVar.Map.bindings decl.scope_sig) Print.punctuation "=" diff --git a/compiler/shared_ast/print.ml b/compiler/shared_ast/print.ml index fad413b4..60514f62 100644 --- a/compiler/shared_ast/print.ml +++ b/compiler/shared_ast/print.ml @@ -27,7 +27,7 @@ let uid_list (fmt : Format.formatter) (infos : Uid.MarkedString.info list) : (fun fmt info -> Format.fprintf fmt (if String.begins_with_uppercase (Mark.remove info) then "@{%s@}" - else "%s") + else "%s") (Uid.MarkedString.to_string info)) fmt infos @@ -988,7 +988,7 @@ module UserFacing = struct in aux 0 (if Z.equal int_part Z.zero then None - else Some (Cli.globals.max_prec_digits - ndigits int_part)) + else Some (Cli.globals.max_prec_digits - ndigits int_part)) rem (* It would be nice to print ratios as % but that's impossible to guess. Trying would lead to inconsistencies where some comparable numbers are in % diff --git a/compiler/shared_ast/scope.ml b/compiler/shared_ast/scope.ml index fa9a204e..0791472f 100644 --- a/compiler/shared_ast/scope.ml +++ b/compiler/shared_ast/scope.ml @@ -51,7 +51,7 @@ let map_exprs_in_lets : scope_let_expr; scope_let_typ = (if reset_types then Mark.copy scope_let.scope_let_typ TAny - else scope_let.scope_let_typ); + else scope_let.scope_let_typ); }) (Bindlib.bind_var (varf var_next) acc) (Expr.Box.lift (f scope_let.scope_let_expr))) diff --git a/compiler/surface/ast.ml b/compiler/surface/ast.ml index 6bdc8e9f..e98fc962 100644 --- a/compiler/surface/ast.ml +++ b/compiler/surface/ast.ml @@ -23,10 +23,11 @@ open Catala_utils (** {1 Visitor classes for programs} *) (** To allow for quick traversal and/or modification of this AST structure, we - provide a {{:https://en.wikipedia.org/wiki/Visitor_pattern} visitor design - pattern}. This feature is implemented via + provide a + {{:https://en.wikipedia.org/wiki/Visitor_pattern} visitor design pattern}. + This feature is implemented via {{:https://gitlab.inria.fr/fpottier/visitors} François Pottier's OCaml - visitors library}. *) + visitors library}. *) (** {1 Type definitions} *) diff --git a/compiler/surface/lexer_common.ml b/compiler/surface/lexer_common.ml index 40748ef7..5f8e2265 100644 --- a/compiler/surface/lexer_common.ml +++ b/compiler/surface/lexer_common.ml @@ -106,6 +106,6 @@ module type LocalisedLexer = sig val lexer : Sedlexing.lexbuf -> Tokens.token (** Entry point of the lexer, distributes to {!val: lex_code} or - {!val:lex_law} depending of the current {!val: - Surface.Lexer_common.context}. *) + {!val:lex_law} depending of the current + {!val:Surface.Lexer_common.context}. *) end diff --git a/compiler/surface/parser_driver.ml b/compiler/surface/parser_driver.ml index 5e37c614..538f4684 100644 --- a/compiler/surface/parser_driver.ml +++ b/compiler/surface/parser_driver.ml @@ -15,8 +15,8 @@ License for the specific language governing permissions and limitations under the License. *) -(** Wrapping module around parser and lexer that offers the {!: - Parser_driver.parse_source_file} API. *) +(** Wrapping module around parser and lexer that offers the + {!:Parser_driver.parse_source_file} API. *) open Sedlexing open Catala_utils diff --git a/compiler/verification/conditions.ml b/compiler/verification/conditions.ml index 258946c7..aa2994dc 100644 --- a/compiler/verification/conditions.ml +++ b/compiler/verification/conditions.ml @@ -99,7 +99,7 @@ let disjunction (args : vc_return list) (mark : typed mark) : vc_return = mark )) acc list -(** [half_product \[a1,...,an\] \[b1,...,bm\] returns \[(a1,b1),...(a1,bn),...(an,b1),...(an,bm)\]] *) +(** [half_product [a1,...,an] [b1,...,bm] returns [(a1,b1),...(a1,bn),...(an,b1),...(an,bm)]] *) let half_product (l1 : 'a list) (l2 : 'b list) : ('a * 'b) list = l1 |> List.mapi (fun i ei -> diff --git a/french_law/catala_legifrance/api.mli b/french_law/catala_legifrance/api.mli index aacd3ca7..d7ed8629 100644 --- a/french_law/catala_legifrance/api.mli +++ b/french_law/catala_legifrance/api.mli @@ -27,8 +27,8 @@ val get_token : string -> string -> access_token Lwt.t (** [get_token cliend_id client_secret] retrieves the access token from the LegiFrance API. You have to register on the {{:https://developer.aife.economie.gouv.fr/} the official website of the - French government} to get your OAuth client ID and Secret for the LegiFrance - API *) + French government} to get your OAuth client ID and Secret for the + LegiFrance API *) type article type article_id diff --git a/runtimes/jsoo/runtime.ml b/runtimes/jsoo/runtime.ml index a414a667..7854ce62 100644 --- a/runtimes/jsoo/runtime.ml +++ b/runtimes/jsoo/runtime.ml @@ -17,36 +17,32 @@ open Js_of_ocaml module R_ocaml = Runtime_ocaml.Runtime -class type source_position = - object - method fileName : Js.js_string Js.t Js.prop - method startLine : int Js.prop - method endLine : int Js.prop - method startColumn : int Js.prop - method endColumn : int Js.prop - method lawHeadings : Js.js_string Js.t Js.js_array Js.t Js.prop - end +class type source_position = object + method fileName : Js.js_string Js.t Js.prop + method startLine : int Js.prop + method endLine : int Js.prop + method startColumn : int Js.prop + method endColumn : int Js.prop + method lawHeadings : Js.js_string Js.t Js.js_array Js.t Js.prop +end -class type raw_event = - object - method eventType : Js.js_string Js.t Js.prop - method information : Js.js_string Js.t Js.js_array Js.t Js.prop - method sourcePosition : source_position Js.t Js.optdef Js.prop - method loggedIOJson : Js.js_string Js.t Js.prop - method loggedValueJson : Js.js_string Js.t Js.prop - end +class type raw_event = object + method eventType : Js.js_string Js.t Js.prop + method information : Js.js_string Js.t Js.js_array Js.t Js.prop + method sourcePosition : source_position Js.t Js.optdef Js.prop + method loggedIOJson : Js.js_string Js.t Js.prop + method loggedValueJson : Js.js_string Js.t Js.prop +end -class type event = - object - method data : Js.js_string Js.t Js.prop - end +class type event = object + method data : Js.js_string Js.t Js.prop +end -class type duration = - object - method years : int Js.readonly_prop - method months : int Js.readonly_prop - method days : int Js.readonly_prop - end +class type duration = object + method years : int Js.readonly_prop + method months : int Js.readonly_prop + method days : int Js.readonly_prop +end let duration_of_jsoo d = R_ocaml.duration_of_numbers d##.years d##.months d##.days @@ -73,16 +69,15 @@ let date_of_jsoo d = let date_to_jsoo d = Js.string @@ R_ocaml.date_to_string d -class type event_manager = - object - method resetLog : (unit, unit) Js.meth_callback Js.meth +class type event_manager = object + method resetLog : (unit, unit) Js.meth_callback Js.meth - method retrieveEvents : - (unit, event Js.t Js.js_array Js.t) Js.meth_callback Js.meth + method retrieveEvents : + (unit, event Js.t Js.js_array Js.t) Js.meth_callback Js.meth - method retrieveRawEvents : - (unit, raw_event Js.t Js.js_array Js.t) Js.meth_callback Js.meth - end + method retrieveRawEvents : + (unit, raw_event Js.t Js.js_array Js.t) Js.meth_callback Js.meth +end let event_manager : event_manager Js.t = object%js diff --git a/runtimes/jsoo/runtime.mli b/runtimes/jsoo/runtime.mli index da699e96..17d7fd93 100644 --- a/runtimes/jsoo/runtime.mli +++ b/runtimes/jsoo/runtime.mli @@ -22,74 +22,69 @@ open Js_of_ocaml (** {1 Log events} *) (** Information about the position of the log inside the Catala source file. *) -class type source_position = - object - method fileName : Js.js_string Js.t Js.prop - method startLine : int Js.prop - method endLine : int Js.prop - method startColumn : int Js.prop - method endColumn : int Js.prop - method lawHeadings : Js.js_string Js.t Js.js_array Js.t Js.prop - end +class type source_position = object + method fileName : Js.js_string Js.t Js.prop + method startLine : int Js.prop + method endLine : int Js.prop + method startColumn : int Js.prop + method endColumn : int Js.prop + method lawHeadings : Js.js_string Js.t Js.js_array Js.t Js.prop +end (** Wrapper for the {!type: Runtime_ocaml.Runtime.raw_event} -- directly collected during the program execution.*) -class type raw_event = - object - method eventType : Js.js_string Js.t Js.prop - (** There is four type of raw log events: +class type raw_event = object + method eventType : Js.js_string Js.t Js.prop + (** There is four type of raw log events: - - 'BeginCall' is emitted when a function or a subscope is called. - - 'EndCall' is emitted when a function or a subscope is exited. - - 'VariableDefinition' is emitted when a variable or a function is - defined. - - 'DecisionTaken' stores the information about the source position of - the event. *) + - 'BeginCall' is emitted when a function or a subscope is called. + - 'EndCall' is emitted when a function or a subscope is exited. + - 'VariableDefinition' is emitted when a variable or a function is + defined. + - 'DecisionTaken' stores the information about the source position of the + event. *) - method information : Js.js_string Js.t Js.js_array Js.t Js.prop - (** Represents information about a name in the code -- i.e. variable name, - subscope name, etc... + method information : Js.js_string Js.t Js.js_array Js.t Js.prop + (** Represents information about a name in the code -- i.e. variable name, + subscope name, etc... - It's a list of strings with a length varying from 2 to 3, where: + It's a list of strings with a length varying from 2 to 3, where: - - the first string is the name of the current scope -- starting with a - capitalized letter [Scope_name], - - the second string is either: the name of a scope variable or, the name - of a subscope input variable -- [a_subscope_var.input_var] - - the third string is either: a subscope name (starting with a - capitalized letter [Subscope_name] or, the [input] (resp. [output]) - string -- which corresponds to the input (resp. the output) of a - function. *) + - the first string is the name of the current scope -- starting with a + capitalized letter [Scope_name], + - the second string is either: the name of a scope variable or, the name + of a subscope input variable -- [a_subscope_var.input_var] + - the third string is either: a subscope name (starting with a capitalized + letter [Subscope_name] or, the [input] (resp. [output]) string -- which + corresponds to the input (resp. the output) of a function. *) - method sourcePosition : source_position Js.t Js.optdef Js.prop + method sourcePosition : source_position Js.t Js.optdef Js.prop - method loggedIOJson : Js.js_string Js.t Js.prop - (** Serialzed [Runtime_ocaml.Runtime.io_log] corresponding to a - `VariableDefinition` raw event. *) + method loggedIOJson : Js.js_string Js.t Js.prop + (** Serialzed [Runtime_ocaml.Runtime.io_log] corresponding to a + `VariableDefinition` raw event. *) - method loggedValueJson : Js.js_string Js.t Js.prop - (** Serialized [Runtime_ocaml.Runtime.runtime_value] corresponding to a - 'VariableDefinition' raw event. *) - end + method loggedValueJson : Js.js_string Js.t Js.prop + (** Serialized [Runtime_ocaml.Runtime.runtime_value] corresponding to a + 'VariableDefinition' raw event. *) +end (** Wrapper for the {!type: Runtime_ocaml.Runtime.event} -- structured log event parsed from the {!raw_event} ones. *) -class type event = - object - method data : Js.js_string Js.t Js.prop - (** Serialized [Runtime_ocaml.Runtime.event]. *) - end +class type event = object + method data : Js.js_string Js.t Js.prop + (** Serialized [Runtime_ocaml.Runtime.event]. *) +end -class type event_manager = - object - method resetLog : (unit, unit) Js.meth_callback Js.meth +class type event_manager = object + method resetLog : (unit, unit) Js.meth_callback Js.meth - method retrieveEvents : - (unit, event Js.t Js.js_array Js.t) Js.meth_callback Js.meth + method retrieveEvents : + (unit, event Js.t Js.js_array Js.t) Js.meth_callback Js.meth - method retrieveRawEvents : - (unit, raw_event Js.t Js.js_array Js.t) Js.meth_callback Js.meth - end + method retrieveRawEvents : + (unit, raw_event Js.t Js.js_array Js.t) Js.meth_callback Js.meth +end val event_manager : event_manager Js.t (** JS object usable to retrieve and reset log events. *) @@ -97,12 +92,11 @@ val event_manager : event_manager Js.t (** {1 Duration} *) (** Simple JSOO wrapper around {!type: Runtime_ocaml.Runtime.duration}.*) -class type duration = - object - method years : int Js.readonly_prop - method months : int Js.readonly_prop - method days : int Js.readonly_prop - end +class type duration = object + method years : int Js.readonly_prop + method months : int Js.readonly_prop + method days : int Js.readonly_prop +end val duration_of_jsoo : duration Js.t -> Runtime_ocaml.Runtime.duration val duration_to_jsoo : Runtime_ocaml.Runtime.duration -> duration Js.t diff --git a/runtimes/ocaml/runtime.ml b/runtimes/ocaml/runtime.ml index 94dc46bf..24b3ece1 100644 --- a/runtimes/ocaml/runtime.ml +++ b/runtimes/ocaml/runtime.ml @@ -109,7 +109,7 @@ let decimal_to_string ~(max_prec_digits : int) (i : decimal) : string = (fun fmt digit -> Format.fprintf fmt "%a" Z.pp_print digit)) (List.rev !digits) (if List.length !digits - leading_zeroes !digits = max_prec_digits then "…" - else "") + else "") let decimal_round (q : decimal) : decimal = (* Implements the workaround by