Skip to content

Commit 725982a

Browse files
ncavencave
committed
Restructured the adapters
1 parent 806b2b5 commit 725982a

File tree

9 files changed

+218
-168
lines changed

9 files changed

+218
-168
lines changed

‎fcs/fcs-fable/SR.fs‎

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,28 @@
1+
//------------------------------------------------------------------------
2+
// From SR.fs
3+
//------------------------------------------------------------------------
4+
5+
namespace Microsoft.FSharp.Compiler
6+
7+
module SR =
8+
let GetString(name: string) =
9+
match SR.Resources.resources.TryGetValue(name) with
10+
| true, value -> value
11+
| _ -> "Missing FSStrings error message for: " + name
12+
13+
module DiagnosticMessage =
14+
type ResourceString<'T>(sfmt: string, fmt: string) =
15+
member x.Format =
16+
let a = fmt.Split('%')
17+
|> Array.filter (fun s -> String.length s > 0)
18+
|> Array.map (fun s -> box("%" + s))
19+
let tmp = System.String.Format(sfmt, a)
20+
let fmt = Printf.StringFormat<'T>(tmp)
21+
sprintf fmt
22+
23+
let postProcessString (s: string) =
24+
s.Replace("\\n","\n").Replace("\\t","\t")
25+
26+
let DeclareResourceString (messageID: string, fmt: string) =
27+
let messageString = SR.GetString(messageID) |> postProcessString
28+
ResourceString<'T>(messageString, fmt)

‎fcs/fcs-fable/System.Collections.Concurrent.fs‎

Lines changed: 70 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,70 @@
1+
//------------------------------------------------------------------------
2+
// shims for things not yet implemented in Fable
3+
//------------------------------------------------------------------------
4+
5+
namespace System.Collections.Concurrent
6+
7+
open System.Collections.Generic
8+
9+
/// not actually thread safe, just an extension of Dictionary
10+
type ConcurrentDictionary<'Key, 'Value when 'Key: equality>(comparer: IEqualityComparer<'Key>) =
11+
inherit Dictionary<'Key, 'Value>(comparer)
12+
13+
new () =
14+
let comparer = {
15+
new IEqualityComparer<'Key> with
16+
member __.GetHashCode(x) = x.GetHashCode()
17+
member __.Equals(x, y) = x.Equals(y) }
18+
ConcurrentDictionary(comparer)
19+
20+
new (_concurrencyLevel: int, _capacity: int) =
21+
ConcurrentDictionary()
22+
new (_concurrencyLevel: int, comparer: IEqualityComparer<'Key>) =
23+
ConcurrentDictionary(comparer)
24+
new (_concurrencyLevel: int, _capacity: int, comparer: IEqualityComparer<'Key>) =
25+
ConcurrentDictionary(comparer)
26+
27+
member x.TryAdd (key: 'Key, value: 'Value): bool =
28+
if x.ContainsKey(key)
29+
then false
30+
else x.Add(key, value); true
31+
32+
member x.TryRemove (key: 'Key): bool * 'Value =
33+
match x.TryGetValue(key) with
34+
| true, v -> (x.Remove(key), v)
35+
| _ as res -> res
36+
37+
member x.GetOrAdd (key: 'Key, valueFactory: 'Key -> 'Value): 'Value =
38+
match x.TryGetValue(key) with
39+
| true, v -> v
40+
| _ -> let v = valueFactory(key) in x.Add(key, v); v
41+
42+
// member x.GetOrAdd (key: 'Key, value: 'Value): 'Value =
43+
// match x.TryGetValue(key) with
44+
// | true, v -> v
45+
// | _ -> let v = value in x.Add(key, v); v
46+
47+
// member x.GetOrAdd<'Arg> (key: 'Key, valueFactory: 'Key * 'Arg -> 'Value, arg: 'Arg): 'Value =
48+
// match x.TryGetValue(key) with
49+
// | true, v -> v
50+
// | _ -> let v = valueFactory(key, arg) in x.Add(key, v); v
51+
52+
// member x.TryUpdate (key: 'Key, value: 'Value, comparisonValue: 'Value): bool =
53+
// match x.TryGetValue(key) with
54+
// | true, v when v = comparisonValue -> x.[key] <- value; true
55+
// | _ -> false
56+
57+
// member x.AddOrUpdate (key: 'Key, value: 'Value, updateFactory: 'Key * 'Value -> 'Value): 'Value =
58+
// match x.TryGetValue(key) with
59+
// | true, v -> let v = updateFactory(key, v) in x.[key] <- v; v
60+
// | _ -> let v = value in x.Add(key, v); v
61+
62+
// member x.AddOrUpdate (key: 'Key, valueFactory: 'Key -> 'Value, updateFactory: 'Key * 'Value -> 'Value): 'Value =
63+
// match x.TryGetValue(key) with
64+
// | true, v -> let v = updateFactory(key, v) in x.[key] <- v; v
65+
// | _ -> let v = valueFactory(key) in x.Add(key, v); v
66+
67+
// member x.AddOrUpdate (key: 'Key, valueFactory: 'Key * 'Arg -> 'Value, updateFactory: 'Key * 'Arg * 'Value -> 'Value, arg: 'Arg): 'Value =
68+
// match x.TryGetValue(key) with
69+
// | true, v -> let v = updateFactory(key, arg, v) in x.[key] <- v; v
70+
// | _ -> let v = valueFactory(key, arg) in x.Add(key, v); v

‎fcs/fcs-fable/System.IO.fs‎

Lines changed: 59 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,59 @@
1+
//------------------------------------------------------------------------
2+
// shims for things not yet implemented in Fable
3+
//------------------------------------------------------------------------
4+
5+
namespace System.IO
6+
7+
module Directory =
8+
let GetCurrentDirectory () = "." //TODO: proper xplat implementation
9+
10+
module Path =
11+
let Combine (path1: string, path2: string) = //TODO: proper xplat implementation
12+
let path1 =
13+
if (String.length path1) = 0 then path1
14+
else (path1.TrimEnd [|'\\';'/'|]) + "/"
15+
path1 + (path2.TrimStart [|'\\';'/'|])
16+
17+
let ChangeExtension (path: string, ext: string) =
18+
let i = path.LastIndexOf(".")
19+
if i < 0 then path
20+
else path.Substring(0, i) + ext
21+
22+
let HasExtension (path: string) =
23+
let i = path.LastIndexOf(".")
24+
i >= 0
25+
26+
let GetExtension (path: string) =
27+
let i = path.LastIndexOf(".")
28+
if i < 0 then ""
29+
else path.Substring(i)
30+
31+
let GetInvalidPathChars () = //TODO: proper xplat implementation
32+
Seq.toArray "<>:\"|?*\b\t"
33+
34+
let GetInvalidFileNameChars () = //TODO: proper xplat implementation
35+
Seq.toArray "<>:\"|\\/?*\b\t"
36+
37+
let GetFullPath (path: string) = //TODO: proper xplat implementation
38+
path
39+
40+
let GetFileName (path: string) =
41+
let normPath = path.Replace("\\", "/").TrimEnd('/')
42+
let i = normPath.LastIndexOf("/")
43+
normPath.Substring(i + 1)
44+
45+
let GetFileNameWithoutExtension (path: string) =
46+
let filename = GetFileName path
47+
let i = filename.LastIndexOf(".")
48+
if i < 0 then filename
49+
else filename.Substring(0, i)
50+
51+
let GetDirectoryName (path: string) = //TODO: proper xplat implementation
52+
let normPath = path.Replace("\\", "/")
53+
let i = normPath.LastIndexOf("/")
54+
if i <= 0 then ""
55+
else normPath.Substring(0, i)
56+
57+
let IsPathRooted (path: string) = //TODO: proper xplat implementation
58+
let normPath = path.Replace("\\", "/").TrimEnd('/')
59+
normPath.StartsWith("/")

‎fcs/fcs-fable/System.fs‎

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
//------------------------------------------------------------------------
2+
// shims for things not yet implemented in Fable
3+
//------------------------------------------------------------------------
4+
5+
namespace System
6+
7+
module Diagnostics =
8+
type Trace() =
9+
static member TraceInformation(_s) = () //TODO: proper implementation
10+
11+
module Reflection =
12+
type AssemblyName(assemblyName: string) =
13+
member x.Name = assemblyName //TODO: proper implementation
14+
15+
type WeakReference<'T>(v: 'T) =
16+
member x.TryGetTarget () = (true, v)
17+
18+
type StringComparer(comp: System.StringComparison) =
19+
static member Ordinal = StringComparer(System.StringComparison.Ordinal)
20+
static member OrdinalIgnoreCase = StringComparer(System.StringComparison.OrdinalIgnoreCase)
21+
interface System.Collections.Generic.IEqualityComparer<string> with
22+
member x.Equals(a,b) = System.String.Compare(a, b, comp) = 0
23+
member x.GetHashCode(a) =
24+
match comp with
25+
| System.StringComparison.Ordinal -> hash a
26+
| System.StringComparison.OrdinalIgnoreCase -> hash (a.ToLowerInvariant())
27+
| _ -> failwithf "Unsupported StringComparison: %A" comp
28+
interface System.Collections.Generic.IComparer<string> with
29+
member x.Compare(a,b) = System.String.Compare(a, b, comp)

‎fcs/fcs-fable/XmlAdapters.fs‎

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
//------------------------------------------------------------------------
2+
// From reshapedreflection.fs
3+
//------------------------------------------------------------------------
4+
5+
namespace Microsoft.FSharp.Core
6+
7+
module XmlAdapters =
8+
let s_escapeChars = [| '<'; '>'; '\"'; '\''; '&' |]
9+
let getEscapeSequence c =
10+
match c with
11+
| '<' -> "&lt;"
12+
| '>' -> "&gt;"
13+
| '\"' -> "&quot;"
14+
| '\'' -> "&apos;"
15+
| '&' -> "&amp;"
16+
| _ as ch -> ch.ToString()
17+
let escape str = String.collect getEscapeSequence str

‎fcs/fcs-fable/adapters.fs‎

Lines changed: 0 additions & 161 deletions
This file was deleted.

‎fcs/fcs-fable/fcs-fable.fsproj‎

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,8 +19,14 @@
1919
</PropertyGroup>
2020

2121
<ItemGroup>
22-
<Compile Include="fsstrings.fs"/>
23-
<Compile Include="adapters.fs"/>
22+
<!-- shims -->
23+
<Compile Include="System.fs"/>
24+
<Compile Include="System.Collections.Concurrent.fs"/>
25+
<Compile Include="System.IO.fs"/>
26+
<!-- string resources -->
27+
<Compile Include="FSStrings.fs"/>
28+
<Compile Include="XmlAdapters.fs"/>
29+
<Compile Include="SR.fs"/>
2430
<Compile Include="codegen/FSComp.fs"/>
2531
<Compile Include="codegen/FSIstrings.fs"/>
2632
<!-- <Compile Include="../FSharp.Compiler.Service/AssemblyInfo.fs"/> -->

‎fcs/fcs-fable/service_slim.fs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -55,10 +55,10 @@ open Microsoft.FSharp.Compiler.TypeChecker
5555
type internal TcResult = TcEnv * TopAttribs * TypedImplFile option * ModuleOrNamespaceType
5656
type internal TcErrors = FSharpErrorInfo[]
5757

58-
type InteractiveChecker private (tcConfig, tcGlobals, tcImports, tcInitialState, ctok, reactorOps, parseCache, checkCache) =
58+
type InteractiveChecker internal (tcConfig, tcGlobals, tcImports, tcInitialState, ctok, reactorOps, parseCache, checkCache) =
5959
let userOpName = "Unknown"
6060

61-
static member private BuildTcImports (tcConfig: TcConfig, references: string[], readAllBytes: string -> byte[]) =
61+
static member internal BuildTcImports (tcConfig: TcConfig, references: string[], readAllBytes: string -> byte[]) =
6262
let tcImports = TcImports ()
6363
let ilGlobals = IL.EcmaMscorlibILGlobals
6464

0 commit comments

Comments
 (0)