Skip to content

Commit ddbeea5

Browse files
committed
Fable support
1 parent b284b63 commit ddbeea5

File tree

107 files changed

+7747
-3672
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

107 files changed

+7747
-3672
lines changed

.gitignore

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -191,7 +191,7 @@ artifacts/*.nupkg
191191
*.orig
192192
*.mdf
193193
*.ldf
194-
.paket/paket.exe
194+
fcs/.paket/paket.exe
195195
paket-files
196196
docsrc/tools/FSharp.Formatting.svclog
197197
src/fsharp/FSharp.Compiler.Service/pplex.fs
@@ -201,6 +201,7 @@ src/fsharp/FSharp.Compiler.Service/pppars.fsi
201201
*.cto
202202
*.vstman
203203
project.lock.json
204+
.vscode
204205

205206
src/fsharp/FSharp.Compiler.Service/FSComp.fs
206207
src/fsharp/FSharp.Compiler.Service/FSComp.resx

fcs/build.fsx

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -98,6 +98,25 @@ Target "NuGet" (fun _ ->
9898
runDotnet __SOURCE_DIRECTORY__ "pack FSharp.Compiler.Service.sln -v n -c release"
9999
)
100100

101+
Target "CodeGen.Fable" (fun _ ->
102+
let outDir = __SOURCE_DIRECTORY__ + "/fcs-fable/codegen/"
103+
104+
// run FCS codegen (except that fssrgen runs without .resx output to inline it)
105+
runDotnet outDir "run -- ../../../src/fsharp/FSComp.txt FSComp.fs"
106+
runDotnet outDir "run -- ../../../src/fsharp/fsi/FSIstrings.txt FSIstrings.fs"
107+
108+
// Fable-specific (comment the #line directive as it is not supported)
109+
["lex.fs"; "pplex.fs"; "illex.fs"; "ilpars.fs"; "pars.fs"; "pppars.fs"]
110+
|> Seq.map (fun fileName -> outDir + fileName)
111+
|> RegexReplaceInFilesWithEncoding @"(?<!/)# (?=\d)" "//# " Text.Encoding.UTF8
112+
113+
// prevent stack overflows on large files (make lexer rules inline)
114+
let pattern = @"(?<=and )(?!inline )([a-zA-Z]+ )+ *\(lexbuf "
115+
["lex.fs"; "pplex.fs"; "illex.fs"]
116+
|> Seq.map (fun fileName -> outDir + fileName)
117+
|> RegexReplaceInFilesWithEncoding pattern @"inline $0" Text.Encoding.UTF8
118+
)
119+
101120
Target "GenerateDocsEn" (fun _ ->
102121
executeFSIWithArgs "docsrc/tools" "generate.fsx" [] [] |> ignore
103122
)
@@ -125,6 +144,10 @@ Target "Release" DoNothing
125144
Target "GenerateDocs" DoNothing
126145
Target "TestAndNuGet" DoNothing
127146

147+
"Clean"
148+
==> "Restore"
149+
==> "CodeGen.Fable"
150+
128151
"Start"
129152
=?> ("BuildVersion", isAppVeyorBuild)
130153
==> "Restore"

fcs/fcs-fable/.gitignore

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
# Codegen
2+
codegen/*.fs
3+
codegen/*.fsi

fcs/fcs-fable/adapters.fs

Lines changed: 155 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,155 @@
1+
namespace Internal.Utilities
2+
3+
#nowarn "1182"
4+
5+
//------------------------------------------------------------------------
6+
// shims for things not yet implemented in Fable
7+
//------------------------------------------------------------------------
8+
9+
module System =
10+
11+
module Decimal =
12+
let GetBits(d: decimal): int[] = [| 0; 0; 0; 0 |] //TODO: proper implementation
13+
14+
module Diagnostics =
15+
type Trace() =
16+
static member TraceInformation(s) = () //TODO: proper implementation
17+
18+
module Reflection =
19+
type AssemblyName(assemblyName: string) =
20+
member x.Name = assemblyName //TODO: proper implementation
21+
22+
type WeakReference<'T>(v: 'T) =
23+
member x.TryGetTarget () = (true, v)
24+
25+
type StringComparer(comp: System.StringComparison) =
26+
static member Ordinal = StringComparer(System.StringComparison.Ordinal)
27+
static member OrdinalIgnoreCase = StringComparer(System.StringComparison.OrdinalIgnoreCase)
28+
interface System.Collections.Generic.IEqualityComparer<string> with
29+
member x.Equals(a,b) = System.String.Compare(a, b, comp) = 0
30+
member x.GetHashCode(a) =
31+
match comp with
32+
| System.StringComparison.Ordinal -> hash a
33+
| System.StringComparison.OrdinalIgnoreCase -> hash (a.ToLowerInvariant())
34+
| _ -> failwithf "Unsupported StringComparison: %A" comp
35+
interface System.Collections.Generic.IComparer<string> with
36+
member x.Compare(a,b) = System.String.Compare(a, b, comp)
37+
38+
module Collections =
39+
module Concurrent =
40+
open System.Collections.Generic
41+
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) }
48+
member x.TryAdd (key:'TKey, value:'TValue) = x.[key] <- value; true
49+
member x.GetOrAdd (key:'TKey, valueFactory: 'TKey -> 'TValue): 'TValue =
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+
normPath.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 normPath.Substring(0, i)
105+
106+
let IsPathRooted (path: string) = //TODO: proper xplat implementation
107+
let normPath = path.Replace("\\", "/").TrimEnd('/')
108+
normPath.StartsWith("/")
109+
110+
111+
module Microsoft =
112+
module FSharp =
113+
114+
//------------------------------------------------------------------------
115+
// From reshapedreflection.fs
116+
//------------------------------------------------------------------------
117+
module Core =
118+
module XmlAdapters =
119+
let s_escapeChars = [| '<'; '>'; '\"'; '\''; '&' |]
120+
let getEscapeSequence c =
121+
match c with
122+
| '<' -> "&lt;"
123+
| '>' -> "&gt;"
124+
| '\"' -> "&quot;"
125+
| '\'' -> "&apos;"
126+
| '&' -> "&amp;"
127+
| _ as ch -> ch.ToString()
128+
let escape str = String.collect getEscapeSequence str
129+
130+
//------------------------------------------------------------------------
131+
// From sr.fs
132+
//------------------------------------------------------------------------
133+
module Compiler =
134+
module SR =
135+
let GetString(name: string) =
136+
match SR.Resources.resources.TryGetValue(name) with
137+
| true, value -> value
138+
| _ -> "Missing FSStrings error message for: " + name
139+
140+
module DiagnosticMessage =
141+
type ResourceString<'T>(sfmt: string, fmt: string) =
142+
member x.Format =
143+
let a = fmt.Split('%')
144+
|> Array.filter (fun s -> String.length s > 0)
145+
|> Array.map (fun s -> box("%" + s))
146+
let tmp = System.String.Format(sfmt, a)
147+
let fmt = Printf.StringFormat<'T>(tmp)
148+
sprintf fmt
149+
150+
let postProcessString (s: string) =
151+
s.Replace("\\n","\n").Replace("\\t","\t")
152+
153+
let DeclareResourceString (messageID: string, fmt: string) =
154+
let messageString = SR.GetString(messageID) |> postProcessString
155+
ResourceString<'T>(messageString, fmt)

fcs/fcs-fable/ast_print.fs

Lines changed: 101 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,101 @@
1+
// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information.
2+
3+
namespace Microsoft.FSharp.Compiler.SourceCodeServices
4+
5+
//-------------------------------------------------------------------------
6+
// AstPrint
7+
//-------------------------------------------------------------------------
8+
9+
module AstPrint =
10+
11+
let attribsOfSymbol (s:FSharpSymbol) =
12+
[ match s with
13+
| :? FSharpField as v ->
14+
yield "field"
15+
if v.IsCompilerGenerated then yield "compgen"
16+
if v.IsDefaultValue then yield "default"
17+
if v.IsMutable then yield "mutable"
18+
if v.IsVolatile then yield "volatile"
19+
if v.IsStatic then yield "static"
20+
if v.IsLiteral then yield sprintf "%A" v.LiteralValue.Value
21+
22+
| :? FSharpEntity as v ->
23+
v.TryFullName |> ignore // check there is no failure here
24+
match v.BaseType with
25+
| Some t when t.HasTypeDefinition && t.TypeDefinition.TryFullName.IsSome ->
26+
yield sprintf "inherits %s" t.TypeDefinition.FullName
27+
| _ -> ()
28+
if v.IsNamespace then yield "namespace"
29+
if v.IsFSharpModule then yield "module"
30+
if v.IsByRef then yield "byref"
31+
if v.IsClass then yield "class"
32+
if v.IsDelegate then yield "delegate"
33+
if v.IsEnum then yield "enum"
34+
if v.IsFSharpAbbreviation then yield "abbrev"
35+
if v.IsFSharpExceptionDeclaration then yield "exception"
36+
if v.IsFSharpRecord then yield "record"
37+
if v.IsFSharpUnion then yield "union"
38+
if v.IsInterface then yield "interface"
39+
if v.IsMeasure then yield "measure"
40+
#if !NO_EXTENSIONTYPING
41+
if v.IsProvided then yield "provided"
42+
if v.IsStaticInstantiation then yield "static_inst"
43+
if v.IsProvidedAndErased then yield "erased"
44+
if v.IsProvidedAndGenerated then yield "generated"
45+
#endif
46+
if v.IsUnresolved then yield "unresolved"
47+
if v.IsValueType then yield "valuetype"
48+
49+
| :? FSharpMemberOrFunctionOrValue as v ->
50+
yield "owner: " + match v.DeclaringEntity with | Some e -> e.CompiledName | _ -> "<unknown>"
51+
if v.IsActivePattern then yield "active_pattern"
52+
if v.IsDispatchSlot then yield "dispatch_slot"
53+
if v.IsModuleValueOrMember && not v.IsMember then yield "val"
54+
if v.IsMember then yield "member"
55+
if v.IsProperty then yield "property"
56+
if v.IsExtensionMember then yield "extension_member"
57+
if v.IsPropertyGetterMethod then yield "property_getter"
58+
if v.IsPropertySetterMethod then yield "property_setter"
59+
if v.IsEvent then yield "event"
60+
if v.EventForFSharpProperty.IsSome then yield "property_event"
61+
if v.IsEventAddMethod then yield "event_add"
62+
if v.IsEventRemoveMethod then yield "event_remove"
63+
if v.IsTypeFunction then yield "type_func"
64+
if v.IsCompilerGenerated then yield "compiler_gen"
65+
if v.IsImplicitConstructor then yield "implicit_ctor"
66+
if v.IsMutable then yield "mutable"
67+
if v.IsOverrideOrExplicitInterfaceImplementation then yield "override_impl"
68+
if not v.IsInstanceMember then yield "static"
69+
if v.IsInstanceMember && not v.IsInstanceMemberInCompiledCode && not v.IsExtensionMember then yield "funky"
70+
if v.IsExplicitInterfaceImplementation then yield "interface_impl"
71+
yield sprintf "%A" v.InlineAnnotation
72+
// if v.IsConstructorThisValue then yield "ctorthis"
73+
// if v.IsMemberThisValue then yield "this"
74+
// if v.LiteralValue.IsSome then yield "literal"
75+
| _ -> () ]
76+
77+
let rec printFSharpDecls prefix decls = seq {
78+
let mutable i = 0
79+
for decl in decls do
80+
i <- i + 1
81+
match decl with
82+
| FSharpImplementationFileDeclaration.Entity (e, sub) ->
83+
yield sprintf "%s%i) ENTITY: %s %A" prefix i e.CompiledName (attribsOfSymbol e)
84+
if not (Seq.isEmpty e.Attributes) then
85+
yield sprintf "%sattributes: %A" prefix (Seq.toList e.Attributes)
86+
if not (Seq.isEmpty e.DeclaredInterfaces) then
87+
yield sprintf "%sinterfaces: %A" prefix (Seq.toList e.DeclaredInterfaces)
88+
yield ""
89+
yield! printFSharpDecls (prefix + "\t") sub
90+
| FSharpImplementationFileDeclaration.MemberOrFunctionOrValue (meth, args, body) ->
91+
yield sprintf "%s%i) METHOD: %s %A" prefix i meth.CompiledName (attribsOfSymbol meth)
92+
yield sprintf "%stype: %A" prefix meth.FullType
93+
yield sprintf "%sargs: %A" prefix args
94+
// if not meth.IsCompilerGenerated then
95+
yield sprintf "%sbody: %A" prefix body
96+
yield ""
97+
| FSharpImplementationFileDeclaration.InitAction (expr) ->
98+
yield sprintf "%s%i) ACTION" prefix i
99+
yield sprintf "%s%A" prefix expr
100+
yield ""
101+
}
Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
<Project Sdk="Microsoft.NET.Sdk">
2+
<PropertyGroup>
3+
<FSharpSourcesRoot>$(MSBuildProjectDirectory)\..\..\..\src</FSharpSourcesRoot>
4+
</PropertyGroup>
5+
<!-- <Import Project="..\..\fcs.props" /> -->
6+
<Import Project="..\..\..\src\buildtools\buildtools.targets" />
7+
<!-- <Import Project="fssrgen.targets" /> -->
8+
<PropertyGroup>
9+
<OutputType>Exe</OutputType>
10+
<TargetFramework>netcoreapp2.1</TargetFramework>
11+
</PropertyGroup>
12+
<ItemGroup>
13+
<!-- <FsSrGen Include="$(FSharpSourcesRoot)\fsharp\FSComp.txt">
14+
<Link>FSComp.txt</Link>
15+
</FsSrGen>
16+
<FsSrGen Include="$(FSharpSourcesRoot)\fsharp\fsi\FSIstrings.txt">
17+
<Link>FSIstrings.txt</Link>
18+
</FsSrGen> -->
19+
<FsYacc Include="$(FSharpSourcesRoot)\absil\ilpars.fsy">
20+
<OtherFlags>--module Microsoft.FSharp.Compiler.AbstractIL.Internal.AsciiParser --open Microsoft.FSharp.Compiler.AbstractIL --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing</OtherFlags>
21+
<Link>ilpars.fsy</Link>
22+
</FsYacc>
23+
<FsYacc Include="$(FSharpSourcesRoot)\fsharp\pars.fsy">
24+
<OtherFlags>--module Microsoft.FSharp.Compiler.Parser --open Microsoft.FSharp.Compiler --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing</OtherFlags>
25+
<Link>pars.fsy</Link>
26+
</FsYacc>
27+
<FsLex Include="$(FSharpSourcesRoot)\absil\illex.fsl">
28+
<OtherFlags>--unicode --lexlib Internal.Utilities.Text.Lexing</OtherFlags>
29+
<Link>AbsIL/illex.fsl</Link>
30+
</FsLex>
31+
<FsLex Include="$(FSharpSourcesRoot)\fsharp\lex.fsl">
32+
<OtherFlags>--unicode --lexlib Internal.Utilities.Text.Lexing</OtherFlags>
33+
<Link>ParserAndUntypedAST/lex.fsl</Link>
34+
</FsLex>
35+
<FsLex Include="$(FSharpSourcesRoot)\fsharp\pplex.fsl">
36+
<OtherFlags>--unicode --lexlib Internal.Utilities.Text.Lexing</OtherFlags>
37+
<Link>ParserAndUntypedAST/pplex.fsl</Link>
38+
</FsLex>
39+
<FsYacc Include="$(FSharpSourcesRoot)\fsharp\pppars.fsy">
40+
<OtherFlags>--module Microsoft.FSharp.Compiler.PPParser --open Microsoft.FSharp.Compiler --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing</OtherFlags>
41+
<Link>ParserAndUntypedAST/pppars.fsy</Link>
42+
</FsYacc>
43+
<Compile Include="fssrgen.fsx" />
44+
</ItemGroup>
45+
<Target Name="GenerateCode" AfterTargets="Restore" BeforeTargets="BeforeBuild" DependsOnTargets="CallFsLex;CallFsYacc"></Target>
46+
<!-- <Target Name="GenerateCode" AfterTargets="Restore" BeforeTargets="BeforeBuild" DependsOnTargets="CallFsLex;CallFsYacc;CallFsSrGen"></Target> -->
47+
</Project>

0 commit comments

Comments
 (0)