From 3f4f0cc4acde1fb9dc6a9480a5fcc57b6b2a67f8 Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Tue, 20 Oct 2020 11:41:56 -0700 Subject: [PATCH] [sledge] Switch from Base.String to Containers.String Reviewed By: ngorogiannis Differential Revision: D24306041 fbshipit-source-id: a413de9ec --- sledge/cli/frontend.ml | 19 +++++++++--------- sledge/cli/sledge_buck.ml | 13 ++++++------- sledge/cli/sledge_cli.ml | 3 +-- sledge/nonstdlib/string.ml | 35 ++++++++++++++++++++++++++++++---- sledge/nonstdlib/string.mli | 17 ++++++++++++++++- sledge/report/sledge_report.ml | 7 +++---- sledge/src/exec.ml | 2 +- 7 files changed, 68 insertions(+), 28 deletions(-) diff --git a/sledge/cli/frontend.ml b/sledge/cli/frontend.ml index ffd244e9b..c674d3956 100644 --- a/sledge/cli/frontend.ml +++ b/sledge/cli/frontend.ml @@ -43,7 +43,8 @@ exception Invalid_llvm of string let invalid_llvm : string -> 'a = fun msg -> let first_line = - Option.value_map ~default:msg ~f:(String.prefix msg) + Option.value_map ~default:msg + ~f:(fun i -> String.take i msg) (String.index msg '\n') in Format.printf "@\n%s@\n" msg ; @@ -136,8 +137,8 @@ open struct fname ^ ".void" | Some count -> String.Tbl.set void_tbl ~key:fname ~data:(count + 1) ; - String.concat_array - [|fname; ".void."; Int.to_string count|] ) + String.concat ~sep:"" + [fname; ".void."; Int.to_string count] ) | _ -> ( match Llvm.value_name llv with | "" -> @@ -149,7 +150,7 @@ open struct match Int.of_string name with | _ -> (* escape to avoid clash with names of anonymous values *) - String.concat_array [|"\""; name; "\""|] + String.concat ~sep:"" ["\""; name; "\""] | exception _ -> name ) ) in SymTbl.set sym_tbl ~key:llv ~data:(name, loc) @@ -308,7 +309,7 @@ and xlate_type_opt : x -> Llvm.lltype -> Typ.t option = let i32 x = xlate_type x (Llvm.i32_type x.llcontext) let suffix_after_last_space : string -> string = - fun str -> String.drop_prefix str (String.rindex_exn str ' ' + 1) + fun str -> String.drop (String.rindex_exn str ' ' + 1) str let xlate_int : x -> Llvm.llvalue -> Exp.t = fun x llv -> @@ -1009,7 +1010,7 @@ let xlate_instr : match xlate_intrinsic_exp fname with | Some intrinsic -> inline_or_move (intrinsic x) | None -> ( - match String.split fname ~on:'.' with + match String.split_on_char fname ~by:'.' with | ["__llair_throw"] -> let pre, exc = xlate_value x (Llvm.operand instr 0) in emit_term ~prefix:(pop loc @ pre) (Term.throw ~exc ~loc) @@ -1136,7 +1137,7 @@ let xlate_instr : Array.length (Llvm.param_types (Llvm.element_type lltyp)) ) in (* intrinsics *) - match String.split fname ~on:'.' with + match String.split_on_char fname ~by:'.' with | _ when Option.is_some (xlate_intrinsic_exp fname) -> let prefix, dst, blocks = xlate_jump x instr return_blk loc [] in emit_term ~prefix (Term.goto ~dst ~loc) ~blocks @@ -1596,8 +1597,8 @@ let translate ~models ~fuzzer ~internalize : string list -> Llair.program = (fun functions llf -> let name = Llvm.value_name llf in if - String.is_prefix name ~prefix:"__llair_" - || String.is_prefix name ~prefix:"llvm." + String.prefix name ~pre:"__llair_" + || String.prefix name ~pre:"llvm." then functions else xlate_function x llf :: functions ) [] llmodule diff --git a/sledge/cli/sledge_buck.ml b/sledge/cli/sledge_buck.ml index c27ab1111..e4808b2e3 100644 --- a/sledge/cli/sledge_buck.ml +++ b/sledge/cli/sledge_buck.ml @@ -27,7 +27,7 @@ let cwd = Unix.getcwd () let buck_root = let open Process in lazy - (String.strip + (String.trim (eval (run "buck" ["root"; "@mode/" ^ Lazy.force mode] |- read_all))) (* use buck root for working directory *) @@ -111,11 +111,10 @@ let expand_arch_archive ~context archive_name = (* find bitcode module(s) in a linker arg *) let parse_linker_arg ~context rev_modules arg = - if String.is_suffix arg ~suffix:".o" then - add_module ~context arg rev_modules - else if String.is_suffix arg ~suffix:".a" then + if String.suffix arg ~suf:".o" then add_module ~context arg rev_modules + else if String.suffix arg ~suf:".a" then let thin_archive = - String.strip Process.(eval (run "head" ["-1"; arg] |- read_all)) + String.trim Process.(eval (run "head" ["-1"; arg] |- read_all)) in if String.equal thin_archive "!" then expand_thin_archive ~context arg rev_modules @@ -129,8 +128,8 @@ let parse_linker_arg ~context rev_modules arg = let bitcode_files_of ~target = let target = if - List.exists (Config.find_list "buck-target-patterns") - ~f:(fun substring -> String.is_substring target ~substring) + List.exists (Config.find_list "buck-target-patterns") ~f:(fun sub -> + String.mem target ~sub ) then target ^ "_sledge" else target in diff --git a/sledge/cli/sledge_cli.ml b/sledge/cli/sledge_cli.ml index 55b422385..bbd070a45 100644 --- a/sledge/cli/sledge_cli.ml +++ b/sledge/cli/sledge_cli.ml @@ -206,8 +206,7 @@ let llvm_grp = let translate_inputs = let expand_argsfile input = if Char.equal input.[0] '@' then - In_channel.with_file ~f:In_channel.input_lines - (String.subo ~pos:1 input) + In_channel.with_file ~f:In_channel.input_lines (String.drop 1 input) else [input] in let open Command.Param in diff --git a/sledge/nonstdlib/string.ml b/sledge/nonstdlib/string.ml index eb1753d23..50750f4db 100644 --- a/sledge/nonstdlib/string.ml +++ b/sledge/nonstdlib/string.ml @@ -6,7 +6,34 @@ *) open! NS0 -include Base.String -module Set = Set.Make (Base.String) -module Map = Map.Make (Base.String) -module Tbl = HashTable.Make (Base.String) +module String = ContainersLabels.String + +let rtake n s = + let l = String.length s in + if n >= l then s else String.sub s ~pos:(l - n) ~len:n + +let rdrop n s = + let l = String.length s in + if n >= l then "" else String.sub s ~pos:0 ~len:(l - n) + +let rtake_drop n s = (rtake n s, rdrop n s) + +module T = struct + type t = string [@@deriving compare, equal, hash, sexp] +end + +include T +include String + +let index_exn = index +let index = index_opt +let index_from_exn = index_from +let index_from = index_from_opt +let rindex_exn = rindex +let rindex = rindex_opt +let rindex_from_exn = rindex_from +let rindex_from = rindex_from_opt + +module Set = Set.Make (T) +module Map = Map.Make (T) +module Tbl = HashTable.Make (T) diff --git a/sledge/nonstdlib/string.mli b/sledge/nonstdlib/string.mli index 66fc4dc0b..0850e399a 100644 --- a/sledge/nonstdlib/string.mli +++ b/sledge/nonstdlib/string.mli @@ -6,7 +6,22 @@ *) open! NS0 -include module type of Base.String +include module type of ContainersLabels.String + +type t = string [@@deriving compare, equal, hash, sexp] + +val index : string -> char -> int option +val index_exn : string -> char -> int +val index_from : string -> int -> char -> int option +val index_from_exn : string -> int -> char -> int +val rindex : string -> char -> int option +val rindex_exn : string -> char -> int +val rindex_from : string -> int -> char -> int option +val rindex_from_exn : string -> int -> char -> int +val rtake : int -> string -> string +val rdrop : int -> string -> string +val rtake_drop : int -> string -> string * string + module Set : Set.S with type elt = string module Map : Map.S with type key = string module Tbl : HashTable.S with type key = string diff --git a/sledge/report/sledge_report.ml b/sledge/report/sledge_report.ml index 419b0b7f9..cfc43f6e3 100644 --- a/sledge/report/sledge_report.ml +++ b/sledge/report/sledge_report.ml @@ -306,9 +306,8 @@ let write_html ranges rows chan = let name = if String.length name <= max_name_length then name else - String.prefix name (max_name_length / 2) - ^ "…" - ^ String.suffix name (max_name_length / 2) + let len = max_name_length / 2 in + String.take len name ^ "…" ^ String.rtake len name in let time ppf t = Printf.fprintf ppf @@ -332,7 +331,7 @@ let write_html ranges rows chan = let peakd = delta ranges.max_peak ranges.pct_peak in let pf_status ppf s = let status_to_string = Format.asprintf "%a" Report.pp_status in - Printf.fprintf ppf "%s" (String.prefix (status_to_string s) 50) + Printf.fprintf ppf "%s" (String.take 50 (status_to_string s)) in let stat ppf = function | [] -> diff --git a/sledge/src/exec.ml b/sledge/src/exec.ml index e667f949a..a5e47b368 100644 --- a/sledge/src/exec.ml +++ b/sledge/src/exec.ml @@ -739,7 +739,7 @@ let intrinsic ~skip_throw : fun pre areturn intrinsic actuals -> let name = let n = Var.name intrinsic in - match String.index n '.' with None -> n | Some i -> String.prefix n i + match String.index n '.' with None -> n | Some i -> String.take i n in let skip pre = Some (Some pre) in ( match (areturn, name, actuals) with