From 4a8336022004d62d069afc344b01d55cec422ea5 Mon Sep 17 00:00:00 2001 From: Emile Rolley Date: Thu, 24 Feb 2022 17:58:24 +0100 Subject: [PATCH] refactor(clerk): change to_string to format functions --- build_system/clerk.ml | 8 ++++-- build_system/ninja_utils.ml | 53 +++++++++++++++++++++--------------- build_system/ninja_utils.mli | 23 ++++++++-------- 3 files changed, 47 insertions(+), 37 deletions(-) diff --git a/build_system/clerk.ml b/build_system/clerk.ml index e0d66502..caf55097 100644 --- a/build_system/clerk.ml +++ b/build_system/clerk.ml @@ -534,7 +534,7 @@ let collect_in_folder (ctx : ninja_building_context) (folder : string) (ninja_st last_valid_ninja = ninja_start; curr_ninja; all_file_names = folder :: ctx.all_file_names; - all_test_builds = ctx.all_test_builds ^ " $\n " ^ test_dir_name; + all_test_builds = ctx.all_test_builds ^ " $\n " ^ test_dir_name; } else { @@ -555,7 +555,7 @@ let collect_in_file (ctx : ninja_building_context) (tested_file : string) (ninja last_valid_ninja = ninja; curr_ninja = Some ninja; all_file_names = tested_file :: ctx.all_file_names; - all_test_builds = ctx.all_test_builds ^ " $\n " ^ test_file_name; + all_test_builds = ctx.all_test_builds ^ " $\n " ^ test_file_name; } | None -> { @@ -607,7 +607,9 @@ let driver (files_or_folders : string list) (command : string) (catala_exe : str else let out = open_out "build.ninja" in Cli.debug_print "writing build.ninja..."; - Nj.write out (add_root_test_build ninja ctx.all_file_names ctx.all_test_builds); + Nj.format + (Format.formatter_of_out_channel out) + (add_root_test_build ninja ctx.all_file_names ctx.all_test_builds); close_out out; Cli.debug_print "executing 'ninja test'..."; Sys.command "ninja test" diff --git a/build_system/ninja_utils.ml b/build_system/ninja_utils.ml index 35bf5eef..b86bf2d1 100644 --- a/build_system/ninja_utils.ml +++ b/build_system/ninja_utils.ml @@ -15,12 +15,17 @@ module Expr = struct type t = Lit of string | Var of string | Seq of t list - let rec to_string = function - | Lit s -> s - | Var s -> "$" ^ s - | Seq ls -> List.fold_left (fun acc s -> acc ^ " " ^ to_string s) "" ls + let rec format fmt = function + | Lit s -> Format.fprintf fmt "%s" s + | Var s -> Format.fprintf fmt "$%s" s + | Seq ls -> format_list fmt ls - let list_to_string ?(sep = " ") ls = ls |> List.map to_string |> String.concat sep + and format_list fmt = function + | hd :: tl -> + Format.fprintf fmt "%a%a" format hd + (fun fmt tl -> tl |> List.iter (fun s -> Format.fprintf fmt " %a" format s)) + tl + | [] -> () end module Rule = struct @@ -28,10 +33,13 @@ module Rule = struct let make name ~command ~description = { name; command; description = Option.some description } - let to_string rule = - Printf.sprintf "rule %s\n command =%s\n" rule.name (Expr.to_string rule.command) - ^ (rule.description - |> Option.fold ~some:(fun e -> " description =" ^ Expr.to_string e ^ "\n") ~none:"") + let format fmt rule = + let format_description fmt = function + | Some e -> Format.fprintf fmt " description = %a\n" Expr.format e + | None -> Format.fprintf fmt "\n" + in + Format.fprintf fmt "rule %s\n command = %a\n%a" rule.name Expr.format rule.command + format_description rule.description end module Build = struct @@ -56,13 +64,16 @@ module Build = struct let unpath ?(sep = "-") path = Re.Pcre.(substitute ~rex:(regexp "/") ~subst:(fun _ -> sep)) path - let to_string build = - Printf.sprintf "build %s: %s" (Expr.list_to_string build.outputs) build.rule - ^ (build.inputs |> Option.fold ~some:(fun ls -> " " ^ Expr.list_to_string ls) ~none:"") - ^ "\n" - ^ List.fold_left - (fun acc (name, exp) -> acc ^ Printf.sprintf " %s = %s\n" name (Expr.to_string exp)) - "" build.vars + let format fmt build = + let format_inputs fmt = function + | Some exs -> Format.fprintf fmt " %a" Expr.format_list exs + | None -> () + in + let format_vars fmt vars = + List.iter (fun (name, exp) -> Format.fprintf fmt " %s = %a\n" name Expr.format exp) vars + in + Format.fprintf fmt "build %a: %s%a\n%a" Expr.format_list build.outputs build.rule format_inputs + build.inputs format_vars build.vars end module RuleMap : Map.S with type key = String.t = Map.Make (String) @@ -73,9 +84,7 @@ type ninja = { rules : Rule.t RuleMap.t; builds : Build.t BuildMap.t } let empty = { rules = RuleMap.empty; builds = BuildMap.empty } -let write out ninja = - let write_for_all iter to_string = - iter (fun _name rule -> Printf.fprintf out "%s\n" (to_string rule)) - in - write_for_all RuleMap.iter Rule.to_string ninja.rules; - write_for_all BuildMap.iter Build.to_string ninja.builds +let format fmt ninja = + let format_for_all iter format = iter (fun _name rule -> Format.fprintf fmt "%a\n" format rule) in + format_for_all RuleMap.iter Rule.format ninja.rules; + format_for_all BuildMap.iter Build.format ninja.builds diff --git a/build_system/ninja_utils.mli b/build_system/ninja_utils.mli index 643799ca..75a35adb 100644 --- a/build_system/ninja_utils.mli +++ b/build_system/ninja_utils.mli @@ -47,13 +47,12 @@ module Expr : sig | Seq of t list (* Sequence of sub-expressions. *) + val format : Format.formatter -> t -> unit + (** [format fmt exp] outputs in [fmt] the string representation of the ninja expression [exp]. *) - val to_string : t -> string - (** [to_string exp] returns the string representation of an ninja expression [exp]. *) - - val list_to_string : ?sep:string -> t list -> string - (** [list_to_string ?sep ls] returns the string representation of a list [ls] of ninja expressions - concatenated with the separator [sep] -- by default ' '. *) + val format_list : Format.formatter -> t list -> unit + (** [format fmt ls] outputs in [fmt] the string representation of a list [ls] + of ninja expressions [exp] by adding a space between each expression. *) end (** {1 Ninja rules} *) @@ -75,8 +74,8 @@ rule val make : string -> command:Expr.t -> description:Expr.t -> t (** [make name ~command ~description] returns the corresponding ninja {!type: Rule.t}. *) - val to_string : t -> string - (** [to_string rule] returns the string representation of the [rule]. *) + val format : Format.formatter -> t -> unit + (** [format fmt rule] outputs in [fmt] the string representation of the ninja [rule]. *) end (** {1 Ninja builds} *) @@ -116,7 +115,8 @@ build : [] (** [unpath ~sep path] replaces all [/] occurences with [sep] in [path] to avoid ninja writing the corresponding file and use it as sub command. By default, [sep] is set to ["-"]. *) - val to_string : t -> string + val format : Format.formatter -> t -> unit + (** [format fmt build] outputs in [fmt] the string representation of the ninja [build]. *) end (** {1 Maps} *) @@ -133,6 +133,5 @@ type ninja = { rules : Rule.t RuleMap.t; builds : Build.t BuildMap.t } val empty : ninja (** [empty] returns the empty empty ninja structure. *) -val write : out_channel -> ninja -> unit -(** [write out ninja] writes in [out] the string representation of all [ninja.rules] and - [ninja.builds]. *) +val format : Format.formatter -> ninja -> unit +(** [format fmt build] outputs in [fmt] the string representation of all [ninja.rules] and [ninja.builds]. *)