hphp/hack/src/hhbc/hhbc_string_utils.ml

   1 (**
   2  * Copyright (c) 2017, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8 *)
   9 open Core_kernel
  10
  11 module SN = Naming_special_names
  12
  13 let quote_string s = "\"" ^ Php_escaping.escape s ^ "\""
  14 let quote_string_with_escape ?(f = Php_escaping.escape_char) s =
  15   "\\\"" ^ Php_escaping.escape ~f s ^ "\\\""
  16 let single_quote_string_with_escape ?(f = Php_escaping.escape_char) s =
  17   "'" ^ Php_escaping.escape ~f s ^ "'"
  18 let triple_quote_string s = "\"\"\"" ^ Php_escaping.escape s ^ "\"\"\""
  19
  20 let prefix_namespace n s = n ^ "\\" ^ s
  21 let strip_global_ns s =
  22   if String.length s > 0 || s.[0] = '\\'
  23   then String_utils.lstrip s "\\"
  24   else s
  25 let strip_ns =
  26   let rx = Str.regexp {|.*\\|} in
  27   (* strip zero or more chars followed by a backslash *)
  28   fun s -> Str.replace_first rx "" s
  29 let has_ns =
  30   let rx = Str.regexp {|.+\\.+|} in
  31   fun s -> Str.string_match rx s 0
  32 let strip_type_list =
  33   let rx = Str.regexp {|<.*>|} in
  34   fun s -> Str.global_replace rx "" s
  35
  36 let cmp ?(case_sensitive=true) ?(ignore_ns=false) s1 s2 =
  37   let s1, s2 =
  38     if case_sensitive then s1, s2 else
  39     String.lowercase s1, String.lowercase s2
  40   in
  41   let s1, s2 =
  42     if not ignore_ns then s1, s2 else
  43     strip_ns s1, strip_ns s2
  44   in
  45   s1 = s2
  46
  47 let is_self s =
  48   String.lowercase s = SN.Classes.cSelf
  49
  50 let is_parent s =
  51   String.lowercase s = SN.Classes.cParent
  52
  53 let is_static s =
  54   String.lowercase s = SN.Classes.cStatic
  55
  56 let is_class s =
  57   String.lowercase s = SN.Members.mClass
  58
  59 let mangle_meth_caller mangled_cls_name f_name =
  60   "\\MethCaller$" ^ mangled_cls_name ^ "::" ^ f_name
  61
  62 module Types = struct
  63   let fix_casing s = match String.lowercase s with
  64     | "vector" -> "Vector"
  65     | "immvector" -> "ImmVector"
  66     | "set" -> "Set"
  67     | "immset" -> "ImmSet"
  68     | "map" -> "Map"
  69     | "immmap" -> "ImmMap"
  70     | "pair" -> "Pair"
  71     | _ -> s
  72 end
  73
  74 (* Integers are represented as strings *)
  75 module Integer = struct
  76   (* Dont accidentally convert 0 to 0o *)
  77   let to_decimal s = Int64.to_string @@ Int64.of_string @@
  78     if String.length s > 1 && s.[0] = '0' then
  79     match s.[1] with
  80     (* Binary *)
  81     | 'b' | 'B'
  82     (* Hex *)
  83     | 'x' | 'X' -> s
  84     (* Octal *)
  85     | _ -> "0o" ^ String_utils.lstrip s "0"
  86     else s
  87
  88   (* In order for this to be true, every char has to be a number as well as
  89    * if the first digit is a zero, then there cannot be more digits
  90    * negative zero is dealt specially as it is not casted to zero
  91    *
  92    * E.g.:
  93    * -1 -> true
  94    * -0 -> false (special case)
  95    * 08 -> false (octal)
  96    * 0b1 -> false (binary)
  97    *
  98    **)
  99   let is_decimal_int s = if s = "-0" then false else
 100     let s = String_utils.lstrip s "-" in
 101     String_utils.fold_left s
 102       ~acc:true
 103       ~f:(fun acc i -> String_utils.is_decimal_digit i && acc)
 104     && (String.length s = 1 || (s.[0] <> '0'))
 105 end
 106
 107 module Float = struct
 108   let to_string f =
 109     match Printf.sprintf "%0.17g" f with
 110     | "nan" -> "NAN"
 111     | "inf" -> "INF"
 112     | "-inf" -> "-INF"
 113     | s -> s
 114
 115   (* Unfortunately the g flag does not provide enough of a match with hhvm,
 116    * hence we go for manual manipulation *)
 117   let with_scientific_notation f =
 118     if String.contains f 'E' || String.contains f 'e'
 119     then Printf.sprintf "%0.1E" (float_of_string f)
 120     else f
 121 end
 122
 123 module Locals = struct
 124
 125   let strip_dollar s = String_utils.lstrip s "$"
 126
 127 end
 128
 129 module Classes = struct
 130
 131   let mangle_class prefix scope ix =
 132     prefix ^ "$"
 133     ^ scope
 134     ^ (if ix = 1 then "" else "#" ^ string_of_int ix)
 135
 136   (* Anonymous classes have names of the form
 137    *   class@anonymous$ scope ix ; num
 138    * where
 139    *   scope  ::=
 140    *     <function-name>
 141    *   | <class-name> :: <method-name>
 142    *   |
 143    *   ix ::=
 144    *     # <digits>
 145    *)
 146   let mangle_anonymous_class scope ix =
 147     mangle_class "class@anonymous" scope ix
 148
 149   let is_anonymous_class_name n =
 150     String_utils.string_starts_with n "class@anonymous"
 151 end
 152
 153 module Closures = struct
 154
 155   let is_closure_name s =
 156     String_utils.string_starts_with s "Closure$"
 157   (* Closure classes have names of the form
 158    *   Closure prefix $ scope ix ; num
 159    * where
 160    *   prefix ::=
 161    *     $ <prefix-attribute>
 162    *   |
 163    *   scope  ::=
 164    *     <function-name>
 165    *   | <class-name> :: <method-name>
 166    *   |
 167    *   ix ::=
 168    *     # <digits>
 169    *)
 170   let unmangle_closure =
 171     let strip_index s =
 172       match String.lsplit2 s ~on:'#' with
 173       | Some (prefix, _) -> prefix
 174       | None -> s in
 175     fun s ->
 176       match String.split s ~on:'$' with
 177       | ["Closure"; _prefix; scope] -> Some (strip_index scope)
 178       | ["Closure"; scope] -> Some (strip_index scope)
 179       | _ -> None
 180
 181   let mangle_closure scope ix name =
 182     match name with
 183     | Some s -> Classes.mangle_class ("Closure$" ^ s)  scope ix
 184     | None -> Classes.mangle_class "Closure" scope ix
 185 end
 186
 187 (* XHP name mangling *)
 188 module Xhp = struct
 189   let is_xhp s = String.length s <> 0 && s.[0] = ':'
 190
 191   let strip_colon s = String_utils.lstrip s ":"
 192
 193   let clean s = if not (is_xhp s) then s else strip_colon s
 194
 195   let ignore_id s =
 196     Classes.is_anonymous_class_name s || Closures.is_closure_name s
 197
 198   (* Mangle an unqualified ID *)
 199   let mangle_id_worker =
 200     let rx_colon = Str.regexp ":" in
 201     let rx_dash = Str.regexp "-" in
 202     fun s ->
 203       if ignore_id s then s
 204       else
 205       let need_prefix = is_xhp s in
 206       let s = if need_prefix then (strip_colon s) else s in
 207       let s =
 208         s
 209         |> Str.global_replace rx_colon "__"
 210         |> Str.global_replace rx_dash "_" in
 211       if need_prefix then "xhp_" ^ s else s
 212
 213   let mangle_id s =
 214     if ignore_id s then s else mangle_id_worker s
 215
 216   (* Mangle a possibly-qualified ID *)
 217   let mangle =
 218     let rx = Str.regexp "\\" in
 219     fun s ->
 220       if ignore_id s then s
 221       else
 222       match List.rev (Str.split_delim rx s) with
 223       | [] -> ""
 224       | id::rest ->
 225         String.concat ~sep:"\\" (List.rev (mangle_id_worker id :: rest))
 226
 227   let unmangle_id_worker =
 228     let rx_dunder = Str.regexp "__" in
 229     let rx_under = Str.regexp "_" in
 230     fun s ->
 231       let has_prefix = String_utils.string_starts_with s "xhp_" in
 232       let s = if has_prefix then String_utils.lstrip s "xhp_" else s in
 233       let s =
 234         s
 235         |> Str.global_replace rx_dunder ":"
 236         |>Str.global_replace rx_under "-" in
 237       if has_prefix then ":" ^ s else s
 238
 239   let unmangle =
 240     let rx = Str.regexp "\\" in
 241     fun s ->
 242       if ignore_id s then s
 243       else
 244       match List.rev (Str.split_delim rx s) with
 245       | [] -> ""
 246       | id::rest ->
 247         String.concat ~sep:"\\" (List.rev (unmangle_id_worker id :: rest))
 248
 249 end
 250
 251 (* Reified param mangling *)
 252 module Reified = struct
 253   let mangle_reified_param ?(nodollar = false) s =
 254     (if nodollar then "" else "$") ^ "__reified$" ^ s
 255
 256   let reified_prop_name = "86reified_prop"
 257
 258   let reified_init_method_name = "86reifiedinit"
 259
 260   let reified_init_method_param_name = "$__typestructures"
 261
 262   let reified_generics_local_name = "$0ReifiedGenerics"
 263
 264   let reified_generic_captured_name is_fun i =
 265     let type_ = if is_fun then "function" else "class" in
 266     Printf.sprintf "$__captured$reifiedgeneric$%s$%d" type_ i
 267
 268   let is_captured_generic id =
 269     let prefix = "$__captured$reifiedgeneric$" in
 270     let (>>=) = Option.(>>=) in
 271     String.chop_prefix ~prefix id
 272     >>= String.lsplit2 ~on:'$'
 273     >>= (fun v -> try match v with
 274           | ("function", i) -> Some (true, int_of_string i)
 275           | ("class", i) -> Some (false, int_of_string i)
 276           | _ -> None
 277           with _ -> None
 278         )
 279 end