Skip to content

Commit 90415c1

Browse files
ncavencave
committed
Fable2 support
1 parent bf7ee70 commit 90415c1

21 files changed

+125
-354
lines changed

‎fcs/fcs-fable/adapters.fs‎

Lines changed: 21 additions & 174 deletions
Original file line numberDiff line numberDiff line change
@@ -6,8 +6,6 @@ namespace Internal.Utilities
66
// shims for things not yet implemented in Fable
77
//------------------------------------------------------------------------
88

9-
//TODO: implement proper Unicode char, decimal
10-
119
module System =
1210

1311
module Decimal =
@@ -41,12 +39,14 @@ module System =
4139
module Concurrent =
4240
open System.Collections.Generic
4341

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) }
42+
type ConcurrentDictionary<'TKey, 'TValue when 'TKey: equality>(comparer: IEqualityComparer<'TKey>) =
43+
inherit Dictionary<'TKey, 'TValue>(comparer)
44+
new () = ConcurrentDictionary {
45+
new IEqualityComparer<'TKey> with
46+
member __.GetHashCode(x) = x.GetHashCode()
47+
member __.Equals(x, y) = x.Equals(y) }
4848
member x.TryAdd (key:'TKey, value:'TValue) = x.[key] <- value; true
49-
member x.GetOrAdd (key, valueFactory) =
49+
member x.GetOrAdd (key:'TKey, valueFactory: 'TKey -> 'TValue): 'TValue =
5050
match x.TryGetValue key with
5151
| true, v -> v
5252
| false, _ -> let v = valueFactory(key) in x.[key] <- v; v
@@ -107,168 +107,14 @@ module System =
107107
let normPath = path.Replace("\\", "/").TrimEnd('/')
108108
path.StartsWith("/")
109109

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-
222110

223111
module Microsoft =
224112
module FSharp =
225113

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-
114+
//------------------------------------------------------------------------
115+
// From reshapedreflection.fs
116+
//------------------------------------------------------------------------
249117
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-
//------------------------------------------------------------------------
272118
module XmlAdapters =
273119
let s_escapeChars = [| '<'; '>'; '\"'; '\''; '&' |]
274120
let getEscapeSequence c =
@@ -286,23 +132,24 @@ module Microsoft =
286132
//------------------------------------------------------------------------
287133
module Compiler =
288134
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
135+
let GetString(name: string) =
136+
match SR.Resources.resources.TryGetValue(name) with
137+
| true, value -> value
138+
| _ -> "Missing FSStrings error message for: " + name
293139

294-
module internal DiagnosticMessage =
140+
module DiagnosticMessage =
295141
type ResourceString<'T>(sfmt: string, fmt: string) =
296142
member x.Format =
297-
let ar = fmt.Split('%')
143+
let a = fmt.Split('%')
298144
|> Array.filter (fun s -> String.length s > 0)
299-
|> Array.map (fun s -> box("%"+s))
300-
let tmp = System.String.Format(sfmt, ar)
145+
|> Array.map (fun s -> box("%" + s))
146+
let tmp = System.String.Format(sfmt, a)
301147
let fmt = Printf.StringFormat<'T>(tmp)
302148
sprintf fmt
303149

304-
let postProcessString (s : string) =
150+
let postProcessString (s: string) =
305151
s.Replace("\\n","\n").Replace("\\t","\t")
306-
let DeclareResourceString ((messageID: string),(fmt: string)) =
152+
153+
let DeclareResourceString (messageID: string, fmt: string) =
307154
let messageString = SR.GetString(messageID) |> postProcessString
308155
ResourceString<'T>(messageString, fmt)

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

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,6 @@
2020

2121
<ItemGroup>
2222
<Compile Include="fsstrings.fs"/>
23-
<Compile Include="unicode.fs"/>
2423
<Compile Include="adapters.fs"/>
2524
<Compile Include="codegen/FSComp.fs"/>
2625
<Compile Include="codegen/FSIstrings.fs"/>

‎fcs/fcs-fable/test/app.fs‎

Lines changed: 21 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -10,17 +10,22 @@ let metadataPath =
1010
else "/temp/repl/metadata2/" // dotnet core 2.0 binaries
1111

1212
#if !DOTNET_FILE_SYSTEM
13+
open Fable.Core
1314

14-
let readFileSync: System.Func<string, byte[]> = Fable.Core.JsInterop.import "readFileSync" "fs"
15-
let readTextSync: System.Func<string, string, string> = Fable.Core.JsInterop.import "readFileSync" "fs"
15+
let readFileSync: System.Func<string, byte[]> = JsInterop.import "readFileSync" "fs"
16+
let readTextSync: System.Func<string, string, string> = JsInterop.import "readFileSync" "fs"
17+
let writeTextSync: System.Action<string, string> = JsInterop.import "writeFileSync" "fs"
1618

1719
let readAllBytes = fun (fileName:string) -> readFileSync.Invoke (metadataPath + fileName)
1820
let readAllText = fun (filePath:string) -> readTextSync.Invoke (filePath, "utf8")
21+
let writeAllText (filePath:string) (text:string) = writeTextSync.Invoke (filePath, text)
1922

2023
#else // DOTNET_FILE_SYSTEM
24+
open System.IO
2125

22-
let readAllBytes = fun (fileName:string) -> System.IO.File.ReadAllBytes (metadataPath + fileName)
23-
let readAllText = fun (filePath:string) -> System.IO.File.ReadAllText (filePath, System.Text.Encoding.UTF8)
26+
let readAllBytes = fun (fileName:string) -> File.ReadAllBytes (metadataPath + fileName)
27+
let readAllText = fun (filePath:string) -> File.ReadAllText (filePath, System.Text.Encoding.UTF8)
28+
let writeAllText (filePath:string) (text:string) = File.WriteAllText (filePath, text)
2429

2530
#endif
2631

@@ -49,12 +54,20 @@ let main argv =
4954
//printfn "projectResults Contents: %A" projectResults.AssemblyContents
5055

5156
printfn "Typed AST (unoptimized):"
52-
projectResults.AssemblyContents.ImplementationFiles
53-
|> Seq.iter (fun file -> AstPrint.printFSharpDecls "" file.Declarations |> Seq.iter (printfn "%s"))
57+
let unoptimizedDecls =
58+
projectResults.AssemblyContents.ImplementationFiles
59+
|> Seq.collect (fun file -> AstPrint.printFSharpDecls "" file.Declarations)
60+
|> String.concat "\n"
61+
unoptimizedDecls |> printfn "%s"
62+
//writeAllText (fileName + ".unoptimized.ast.txt") unoptimizedDecls
5463

5564
printfn "Typed AST (optimized):"
56-
projectResults.GetOptimizedAssemblyContents().ImplementationFiles
57-
|> Seq.iter (fun file -> AstPrint.printFSharpDecls "" file.Declarations |> Seq.iter (printfn "%s"))
65+
let optimizedDecls =
66+
projectResults.GetOptimizedAssemblyContents().ImplementationFiles
67+
|> Seq.collect (fun file -> AstPrint.printFSharpDecls "" file.Declarations)
68+
|> String.concat "\n"
69+
optimizedDecls |> printfn "%s"
70+
//writeAllText (fileName + ".optimized.ast.txt") optimizedDecls
5871

5972
let inputLines = source.Split('\n')
6073

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -16,8 +16,8 @@
1616
</ItemGroup>
1717

1818
<ItemGroup>
19-
<PackageReference Include="Fable.Core" Version="1.3.7" />
20-
<DotNetCliToolReference Include="dotnet-fable" Version="1.3.7" />
19+
<PackageReference Include="Fable.Core" Version="2.0.0-*" />
20+
<DotNetCliToolReference Include="dotnet-fable" Version="2.0.0-*" />
2121
</ItemGroup>
2222

2323
</Project>

‎fcs/fcs-fable/test/package.json‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -9,14 +9,14 @@
99
"preinstall": "dotnet restore",
1010
"build": "dotnet fable npm-run splitter",
1111
"rollup": "rollup -c",
12-
"splitter": "node ./node_modules/fable-splitter/cli -c splitter.config.js",
12+
"splitter": "node ./node_modules/fable-splitter/dist/cli -c splitter.config.js",
1313
"start": "node out/app"
1414
},
1515
"devDependencies": {
1616
"babel-core": "^6.26.3",
1717
"babel-preset-env": "^1.7.0",
18-
"fable-splitter": "^0.1.21",
18+
"fable-splitter": "2.0.0-beta-002",
1919
"rollup": "^0.66.2",
20-
"rollup-plugin-fable": "^1.1.1"
20+
"rollup-plugin-fable": "2.0.0-beta-001"
2121
}
2222
}

0 commit comments

Comments
 (0)