[sledge] Switch from Base.String to Containers.String

Reviewed By: ngorogiannis

Differential Revision: D24306041

fbshipit-source-id: a413de9ec

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
+                    String.concat ~sep:""
-                      [|fname; ".void."; Int.to_string count|] )
+                      [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.prefix name ~pre:"__llair_"
-          || String.is_prefix name ~prefix:"llvm."
+          || String.prefix name ~pre:"llvm."
         then functions
         else xlate_function x llf :: functions )
       [] llmodule

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
+  if String.suffix arg ~suf:".o" then add_module ~context arg rev_modules
-    add_module ~context arg rev_modules
+  else if String.suffix arg ~suf:".a" then
-  else if String.is_suffix arg ~suffix:".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 "!<thin>" 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")
+      List.exists (Config.find_list "buck-target-patterns") ~f:(fun sub ->
-        ~f:(fun substring -> String.is_substring target ~substring)
+          String.mem target ~sub )
     then target ^ "_sledge"
     else target
   in

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
+        In_channel.with_file ~f:In_channel.input_lines (String.drop 1 input)
-          (String.subo ~pos:1 input)
       else [input]
     in
     let open Command.Param in

sledge/nonstdlib/string.ml

@@ -6,7 +6,34 @@
  *)
 
 open! NS0
-include Base.String
+module String = ContainersLabels.String
-module Set = Set.Make (Base.String)
+
-module Map = Map.Make (Base.String)
+let rtake n s =
-module Tbl = HashTable.Make (Base.String)
+  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)

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

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)
+          let len = max_name_length / 2 in
-          ^ "…"
+          String.take len name ^ "…" ^ String.rtake len name
-          ^ String.suffix name (max_name_length / 2)
       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
         | [] ->

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