|
| 1 | +namespace Internal.Utilities |
| 2 | + |
| 3 | +#nowarn "1182" |
| 4 | + |
| 5 | +//------------------------------------------------------------------------ |
| 6 | +// shims for things not yet implemented in Fable |
| 7 | +//------------------------------------------------------------------------ |
| 8 | + |
| 9 | +//TODO: implement proper Unicode char, decimal |
| 10 | + |
| 11 | +module System = |
| 12 | + |
| 13 | + module Decimal = |
| 14 | + let GetBits(d: decimal): int[] = [| 0; 0; 0; 0 |] //TODO: proper implementation |
| 15 | + |
| 16 | + module Diagnostics = |
| 17 | + type Trace() = |
| 18 | + static member TraceInformation(s) = () //TODO: proper implementation |
| 19 | + |
| 20 | + module Reflection = |
| 21 | + type AssemblyName(assemblyName: string) = |
| 22 | + member x.Name = assemblyName //TODO: proper implementation |
| 23 | + |
| 24 | + type WeakReference<'T>(v: 'T) = |
| 25 | + member x.TryGetTarget () = (true, v) |
| 26 | + |
| 27 | + type StringComparer(comp: System.StringComparison) = |
| 28 | + static member Ordinal = StringComparer(System.StringComparison.Ordinal) |
| 29 | + static member OrdinalIgnoreCase = StringComparer(System.StringComparison.OrdinalIgnoreCase) |
| 30 | + interface System.Collections.Generic.IEqualityComparer<string> with |
| 31 | + member x.Equals(a,b) = System.String.Compare(a, b, comp) = 0 |
| 32 | + member x.GetHashCode(a) = |
| 33 | + match comp with |
| 34 | + | System.StringComparison.Ordinal -> hash a |
| 35 | + | System.StringComparison.OrdinalIgnoreCase -> hash (a.ToLowerInvariant()) |
| 36 | + | _ -> failwithf "Unsupported StringComparison: %A" comp |
| 37 | + interface System.Collections.Generic.IComparer<string> with |
| 38 | + member x.Compare(a,b) = System.String.Compare(a, b, comp) |
| 39 | + |
| 40 | + module Collections = |
| 41 | + module Concurrent = |
| 42 | + open System.Collections.Generic |
| 43 | + |
| 44 | + type ConcurrentDictionary<'TKey, 'TValue when 'TKey: equality> = |
| 45 | + inherit Dictionary<'TKey, 'TValue> |
| 46 | + new () = { inherit Dictionary<'TKey, 'TValue>() } |
| 47 | + new (comparer: IEqualityComparer<'TKey>) = { inherit Dictionary<'TKey, 'TValue>(comparer) } |
| 48 | + member x.TryAdd (key:'TKey, value:'TValue) = x.[key] <- value; true |
| 49 | + member x.GetOrAdd (key, valueFactory) = |
| 50 | + match x.TryGetValue key with |
| 51 | + | true, v -> v |
| 52 | + | false, _ -> let v = valueFactory(key) in x.[key] <- v; v |
| 53 | + |
| 54 | + module IO = |
| 55 | + module Directory = |
| 56 | + let GetCurrentDirectory () = "." //TODO: proper xplat implementation |
| 57 | + |
| 58 | + module Path = |
| 59 | + |
| 60 | + let Combine (path1: string, path2: string) = //TODO: proper xplat implementation |
| 61 | + let path1 = |
| 62 | + if (String.length path1) = 0 then path1 |
| 63 | + else (path1.TrimEnd [|'\\';'/'|]) + "/" |
| 64 | + path1 + (path2.TrimStart [|'\\';'/'|]) |
| 65 | + |
| 66 | + let ChangeExtension (path: string, ext: string) = |
| 67 | + let i = path.LastIndexOf(".") |
| 68 | + if i < 0 then path |
| 69 | + else path.Substring(0, i) + ext |
| 70 | + |
| 71 | + let HasExtension (path: string) = |
| 72 | + let i = path.LastIndexOf(".") |
| 73 | + i >= 0 |
| 74 | + |
| 75 | + let GetExtension (path: string) = |
| 76 | + let i = path.LastIndexOf(".") |
| 77 | + if i < 0 then "" |
| 78 | + else path.Substring(i) |
| 79 | + |
| 80 | + let GetInvalidPathChars () = //TODO: proper xplat implementation |
| 81 | + Seq.toArray "<>:\"|\\/?*\b\t" |
| 82 | + |
| 83 | + let GetInvalidFileNameChars () = //TODO: proper xplat implementation |
| 84 | + Seq.toArray "<>:\"|\\/?*\b\t" |
| 85 | + |
| 86 | + let GetFullPath (path: string) = //TODO: proper xplat implementation |
| 87 | + path |
| 88 | + |
| 89 | + let GetFileName (path: string) = |
| 90 | + let normPath = path.Replace("\\", "/").TrimEnd('/') |
| 91 | + let i = normPath.LastIndexOf("/") |
| 92 | + path.Substring(i + 1) |
| 93 | + |
| 94 | + let GetFileNameWithoutExtension (path: string) = |
| 95 | + let filename = GetFileName path |
| 96 | + let i = filename.LastIndexOf(".") |
| 97 | + if i < 0 then filename |
| 98 | + else filename.Substring(0, i) |
| 99 | + |
| 100 | + let GetDirectoryName (path: string) = //TODO: proper xplat implementation |
| 101 | + let normPath = path.Replace("\\", "/") |
| 102 | + let i = normPath.LastIndexOf("/") |
| 103 | + if i <= 0 then "" |
| 104 | + else path.Substring(0, i) |
| 105 | + |
| 106 | + let IsPathRooted (path: string) = //TODO: proper xplat implementation |
| 107 | + let normPath = path.Replace("\\", "/").TrimEnd('/') |
| 108 | + path.StartsWith("/") |
| 109 | + |
| 110 | + module Char = |
| 111 | + open System.Globalization |
| 112 | + |
| 113 | + let GetUnicodeCategory (c: char): UnicodeCategory = //TODO: proper Unicode implementation |
| 114 | + LanguagePrimitives.EnumOfValue (int categoryForLatin1.[int c]) |
| 115 | + let IsControl (c: char) = |
| 116 | + GetUnicodeCategory(c) = UnicodeCategory.Control |
| 117 | + let IsDigit (c: char) = |
| 118 | + GetUnicodeCategory(c) = UnicodeCategory.DecimalDigitNumber |
| 119 | + let IsLetter (c: char) = |
| 120 | + match GetUnicodeCategory(c) with |
| 121 | + | UnicodeCategory.UppercaseLetter |
| 122 | + | UnicodeCategory.LowercaseLetter |
| 123 | + | UnicodeCategory.TitlecaseLetter |
| 124 | + | UnicodeCategory.ModifierLetter |
| 125 | + | UnicodeCategory.OtherLetter -> true |
| 126 | + | _ -> false |
| 127 | + let IsLetterOrDigit (c: char) = |
| 128 | + IsLetter(c) || IsDigit(c) |
| 129 | + let IsWhiteSpace (c: char) = |
| 130 | + // There are characters which belong to UnicodeCategory.Control but are considered as white spaces. |
| 131 | + c = ' ' || (c >= '\x09' && c <= '\x0d') || c = '\xa0' || c = '\x85' |
| 132 | + let IsUpper (c: char) = |
| 133 | + GetUnicodeCategory(c) = UnicodeCategory.UppercaseLetter |
| 134 | + let IsLower (c: char) = |
| 135 | + GetUnicodeCategory(c) = UnicodeCategory.LowercaseLetter |
| 136 | + let IsPunctuation (c: char) = |
| 137 | + match GetUnicodeCategory(c) with |
| 138 | + | UnicodeCategory.ConnectorPunctuation |
| 139 | + | UnicodeCategory.DashPunctuation |
| 140 | + | UnicodeCategory.OpenPunctuation |
| 141 | + | UnicodeCategory.ClosePunctuation |
| 142 | + | UnicodeCategory.InitialQuotePunctuation |
| 143 | + | UnicodeCategory.FinalQuotePunctuation |
| 144 | + | UnicodeCategory.OtherPunctuation -> true |
| 145 | + | _ -> false |
| 146 | + let IsSurrogatePair (s,i) = false //TODO: proper Unicode implementation |
| 147 | + let ToUpper (c: char) = if IsLower(c) then char(int('A') + (int(c) - int('a'))) else c |
| 148 | + let ToLower (c: char) = if IsUpper(c) then char(int('a') + (int(c) - int('A'))) else c |
| 149 | + let ToUpperInvariant (c: char) = ToUpper(c) |
| 150 | + let ToLowerInvariant (c: char) = ToLower(c) |
| 151 | + let ToString (c: char) = string c |
| 152 | + |
| 153 | + module Text = |
| 154 | + |
| 155 | + type StringBuilder(?s: string) = |
| 156 | + let buf = ResizeArray<string>() |
| 157 | + do if Option.isSome s then buf.Add(s.Value) |
| 158 | + new (capacity: int, ?maxCapacity: int) = StringBuilder() |
| 159 | + new (s: string, ?maxCapacity: int) = StringBuilder(s) |
| 160 | + member x.Append(s: string) = buf.Add(s); x |
| 161 | + member x.AppendFormat(fmt: string, o: obj) = buf.Add(System.String.Format(fmt, o)); x |
| 162 | + override x.ToString() = System.String.Concat(buf) |
| 163 | + |
| 164 | + module Encoding = |
| 165 | + |
| 166 | + module Unicode = // TODO: add surrogate pairs |
| 167 | + let GetBytes (s: string) = |
| 168 | + let addUnicodeChar (buf: ResizeArray<byte>) (c: char) = |
| 169 | + let i = int c |
| 170 | + buf.Add (byte (i % 256)) |
| 171 | + buf.Add (byte (i / 256)) |
| 172 | + let buf = ResizeArray<byte>() |
| 173 | + s.ToCharArray() |> Array.map (addUnicodeChar buf) |> ignore |
| 174 | + buf.ToArray() |
| 175 | + |
| 176 | + let GetString (bytes: byte[], index: int, count: int) = |
| 177 | + let sb = StringBuilder() |
| 178 | + for i in 0 .. 2 .. count-1 do |
| 179 | + let c = char ((int(bytes.[index+i+1]) <<< 8) ||| int(bytes.[index+i])) |
| 180 | + sb.Append(string c) |> ignore |
| 181 | + sb.ToString() |
| 182 | + |
| 183 | + module UTF8 = // TODO: add surrogate pairs |
| 184 | + let GetBytes (s: string) = |
| 185 | + let buf = ResizeArray<byte>() |
| 186 | + let encodeUtf8 (c: char) = |
| 187 | + let i = int c |
| 188 | + if i < 0x80 then |
| 189 | + buf.Add (byte(i)) |
| 190 | + else if i < 0x800 then |
| 191 | + buf.Add (byte(0xC0 ||| (i >>> 6 &&& 0x1F))) |
| 192 | + buf.Add (byte(0x80 ||| (i &&& 0x3F))) |
| 193 | + else if i < 0x10000 then |
| 194 | + buf.Add (byte(0xE0 ||| (i >>> 12 &&& 0xF))) |
| 195 | + buf.Add (byte(0x80 ||| (i >>> 6 &&& 0x3F))) |
| 196 | + buf.Add (byte(0x80 ||| (i &&& 0x3F))) |
| 197 | + s.ToCharArray() |> Array.map encodeUtf8 |> ignore |
| 198 | + buf.ToArray() |
| 199 | + |
| 200 | + let GetString (bytes: byte[], index: int, count: int) = |
| 201 | + let decodeUtf8 pos = |
| 202 | + let i1 = int(bytes.[pos]) |
| 203 | + if i1 &&& 0x80 = 0 then |
| 204 | + (i1 &&& 0x7F), 1 |
| 205 | + else if i1 &&& 0xE0 = 0xC0 then |
| 206 | + let i2 = int(bytes.[pos + 1]) in |
| 207 | + ((i1 &&& 0x1F) <<< 6) ||| (i2 &&& 0x3F), 2 |
| 208 | + else if i1 &&& 0xF0 = 0xE0 then |
| 209 | + let i2 = int(bytes.[pos + 1]) in |
| 210 | + let i3 = int(bytes.[pos + 2]) in |
| 211 | + ((i1 &&& 0x1F) <<< 12) ||| ((i2 &&& 0x3F) <<< 6) ||| (i3 &&& 0x3F), 3 |
| 212 | + else 0, 1 // invalid decoding |
| 213 | + let sb = StringBuilder() |
| 214 | + let mutable pos = index |
| 215 | + let last = index + count |
| 216 | + while pos < last do |
| 217 | + let d, inc = decodeUtf8 pos |
| 218 | + sb.Append(string (char d)) |> ignore |
| 219 | + pos <- pos + inc |
| 220 | + sb.ToString() |
| 221 | + |
| 222 | + |
| 223 | +module Microsoft = |
| 224 | + module FSharp = |
| 225 | + |
| 226 | + module Collections = |
| 227 | + open System.Collections.Generic |
| 228 | + |
| 229 | + module HashIdentity = |
| 230 | + let inline FromFunctions hash eq : IEqualityComparer<'T> = |
| 231 | + { new IEqualityComparer<'T> with |
| 232 | + member __.GetHashCode(x) = hash x |
| 233 | + member __.Equals(x,y) = eq x y } |
| 234 | + let inline Structural<'T when 'T : equality> : IEqualityComparer<'T> = |
| 235 | + FromFunctions LanguagePrimitives.GenericHash LanguagePrimitives.GenericEquality |
| 236 | + let Reference<'T when 'T : not struct > : IEqualityComparer<'T> = |
| 237 | + FromFunctions LanguagePrimitives.PhysicalHash LanguagePrimitives.PhysicalEquality |
| 238 | + |
| 239 | + module ComparisonIdentity = |
| 240 | + let inline FromFunction comparer = |
| 241 | + { new IComparer<'T> with |
| 242 | + member __.Compare(x,y) = comparer x y } |
| 243 | + let inline Structural<'T when 'T : comparison> : IComparer<'T> = |
| 244 | + FromFunction LanguagePrimitives.GenericComparison |
| 245 | + |
| 246 | + module List = |
| 247 | + let indexed source = List.mapi (fun i x -> i,x) source |
| 248 | + |
| 249 | + module Core = |
| 250 | + module LanguagePrimitives = |
| 251 | + let FastGenericComparer<'T when 'T : comparison> = |
| 252 | + Collections.ComparisonIdentity.Structural<'T> |
| 253 | + |
| 254 | + module Operators = |
| 255 | + let (|Failure|_|) (exn: exn) = Some exn.Message |
| 256 | + //if exn.GetType().FullName.EndsWith("Exception") then Some exn.Message else None |
| 257 | + let Failure message = new System.Exception(message) |
| 258 | + let nullArg x = raise(System.ArgumentNullException(x)) |
| 259 | + let lock _lockObj action = action() // no locking |
| 260 | + |
| 261 | + module Printf = |
| 262 | + let bprintf (sb: System.Text.StringBuilder) = |
| 263 | + let f (s:string) = sb.Append(s) |> ignore |
| 264 | + Printf.kprintf f |
| 265 | + let fprintf (os: System.IO.TextWriter) = |
| 266 | + let f (s:string) = System.Console.Write(s) //os.Write(s) |
| 267 | + Printf.kprintf f |
| 268 | + |
| 269 | + //------------------------------------------------------------------------ |
| 270 | + // From reshapedreflection.fs |
| 271 | + //------------------------------------------------------------------------ |
| 272 | + module XmlAdapters = |
| 273 | + let s_escapeChars = [| '<'; '>'; '\"'; '\''; '&' |] |
| 274 | + let getEscapeSequence c = |
| 275 | + match c with |
| 276 | + | '<' -> "<" |
| 277 | + | '>' -> ">" |
| 278 | + | '\"' -> """ |
| 279 | + | '\'' -> "'" |
| 280 | + | '&' -> "&" |
| 281 | + | _ as ch -> ch.ToString() |
| 282 | + let escape str = String.collect getEscapeSequence str |
| 283 | + |
| 284 | + //------------------------------------------------------------------------ |
| 285 | + // From sr.fs |
| 286 | + //------------------------------------------------------------------------ |
| 287 | + module Compiler = |
| 288 | + module SR = |
| 289 | + let GetString(name:string) = |
| 290 | + let ok, value = SR.Resources.resources.TryGetValue(name) |
| 291 | + if ok then value |
| 292 | + else "Missing FSStrings error message for: " + name |
| 293 | + |
| 294 | + module internal DiagnosticMessage = |
| 295 | + type ResourceString<'T>(sfmt: string, fmt: string) = |
| 296 | + member x.Format = |
| 297 | + let ar = fmt.Split('%') |
| 298 | + |> Array.filter (fun s -> String.length s > 0) |
| 299 | + |> Array.map (fun s -> box("%"+s)) |
| 300 | + let tmp = System.String.Format(sfmt, ar) |
| 301 | + let fmt = Printf.StringFormat<'T>(tmp) |
| 302 | + sprintf fmt |
| 303 | + |
| 304 | + let postProcessString (s : string) = |
| 305 | + s.Replace("\\n","\n").Replace("\\t","\t") |
| 306 | + let DeclareResourceString ((messageID: string),(fmt: string)) = |
| 307 | + let messageString = SR.GetString(messageID) |> postProcessString |
| 308 | + ResourceString<'T>(messageString, fmt) |
0 commit comments