Skip to content
Browse files

Fix parsing of HR and allow calling FSharp.Compiler from other F# bui…

…lds.
  • Loading branch information...
1 parent e1be1f2 commit 63f0cfc9f14b2c7b4007a583b2ac498c2616dcb6 @tpetricek committed Feb 13, 2012
View
4 .gitignore
@@ -1,5 +1,9 @@
src/FSharp.CodeFormat/bin
src/FSharp.CodeFormat/obj
+src/FSharp.CodeFormat.Tests/bin
+src/FSharp.CodeFormat.Tests/obj
src/FSharp.Markdown/bin
src/FSharp.Markdown/obj
+src/FSharp.Markdown.Tests/bin
+src/FSharp.Markdown.Tests/obj
*.suo
View
6 src/FSharp.CodeFormat.Tests/App.config
@@ -0,0 +1,6 @@
+<?xml version="1.0" encoding="utf-8"?>
+<configuration>
+ <startup>
+ <supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.0" />
+ </startup>
+</configuration>
View
65 src/FSharp.CodeFormat.Tests/FSharp.CodeFormat.Tests.fsproj
@@ -0,0 +1,65 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <PropertyGroup>
+ <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
+ <Platform Condition=" '$(Platform)' == '' ">x86</Platform>
+ <ProductVersion>8.0.30703</ProductVersion>
+ <SchemaVersion>2.0</SchemaVersion>
+ <ProjectGuid>{5debd769-d86e-4e14-abf1-373ca91bfaa2}</ProjectGuid>
+ <OutputType>Exe</OutputType>
+ <RootNamespace>FSharp.CodeFormat.Tests</RootNamespace>
+ <AssemblyName>FSharp.CodeFormat.Tests</AssemblyName>
+ <TargetFrameworkVersion>v4.0</TargetFrameworkVersion>
+ <TargetFrameworkProfile>
+ </TargetFrameworkProfile>
+ <Name>FSharp.CodeFormat.Tests</Name>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|x86' ">
+ <DebugSymbols>true</DebugSymbols>
+ <DebugType>full</DebugType>
+ <Optimize>false</Optimize>
+ <Tailcalls>false</Tailcalls>
+ <OutputPath>bin\Debug\</OutputPath>
+ <DefineConstants>DEBUG;TRACE</DefineConstants>
+ <WarningLevel>3</WarningLevel>
+ <PlatformTarget>x86</PlatformTarget>
+ <DocumentationFile>bin\Debug\FSharp.CodeFormat.Tests.XML</DocumentationFile>
+ </PropertyGroup>
+ <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|x86' ">
+ <DebugType>pdbonly</DebugType>
+ <Optimize>true</Optimize>
+ <Tailcalls>true</Tailcalls>
+ <OutputPath>bin\Release\</OutputPath>
+ <DefineConstants>TRACE</DefineConstants>
+ <WarningLevel>3</WarningLevel>
+ <PlatformTarget>x86</PlatformTarget>
+ <DocumentationFile>bin\Release\FSharp.CodeFormat.Tests.XML</DocumentationFile>
+ </PropertyGroup>
+ <Import Project="$(MSBuildExtensionsPath32)\FSharp\1.0\Microsoft.FSharp.Targets" Condition="!Exists('$(MSBuildBinPath)\Microsoft.Build.Tasks.v4.0.dll')" />
+ <Import Project="$(MSBuildExtensionsPath32)\..\Microsoft F#\v4.0\Microsoft.FSharp.Targets" Condition=" Exists('$(MSBuildBinPath)\Microsoft.Build.Tasks.v4.0.dll')" />
+ <ItemGroup>
+ <Compile Include="Program.fs" />
+ <None Include="App.config">
+ <CopyToOutputDirectory>Always</CopyToOutputDirectory>
+ </None>
+ </ItemGroup>
+ <ItemGroup>
+ <Reference Include="FSharp.CodeFormat">
+ <HintPath>..\FSharp.CodeFormat\bin\Debug\FSharp.CodeFormat.dll</HintPath>
+ </Reference>
+ <Reference Include="FSharp.Core">
+ <HintPath>..\..\..\..\..\Program Files (x86)\Reference Assemblies\Microsoft\FSharp\2.0\Runtime\v4.0\FSharp.Core.dll</HintPath>
+ </Reference>
+ <Reference Include="mscorlib" />
+ <Reference Include="System" />
+ <Reference Include="System.Core" />
+ <Reference Include="System.Numerics" />
+ </ItemGroup>
+ <!-- To modify your build process, add your task inside one of the targets below and uncomment it.
+ Other similar extension points exist, see Microsoft.Common.targets.
+ <Target Name="BeforeBuild">
+ </Target>
+ <Target Name="AfterBuild">
+ </Target>
+ -->
+</Project>
View
38 src/FSharp.CodeFormat.Tests/Program.fs
@@ -0,0 +1,38 @@
+// --------------------------------------------------------------------------------------
+// TODO: Some actual unit tests would be nice
+// --------------------------------------------------------------------------------------
+
+open System.IO
+open System.Diagnostics
+open System.Reflection
+open FSharp.CodeFormat
+
+// Load custom-built F# compiler with joinads
+let asmCompiler = Assembly.LoadFile(@"C:\Program Files (x86)\Microsoft F#\v4.0\FSharp.Compiler.dll")
+//let asmCompiler = Assembly.LoadFile(__SOURCE_DIRECTORY__ + @"\\bin\\Debug\\FSharp.Compiler.dll")
+
+let agent = CodeFormat.CreateAgent(asmCompiler)
+
+let tests = Path.Combine(__SOURCE_DIRECTORY__, "tests")
+let doWork () =
+ for file in Directory.GetFiles(tests, "a.fs") do
+ printfn " - processing %s" file
+ let source = File.ReadAllText(file)
+ let snips, errors = agent.ParseSource(file, source.Trim())
+
+ let res = CodeFormat.FormatHtml(snips, "fstips")
+ use wr = new StreamWriter(System.Console.OpenStandardOutput()) // file + ".output")
+ for snip in res.SnippetsHtml do
+ wr.WriteLine(snip.Title)
+ wr.WriteLine(snip.Html + "\n")
+ wr.WriteLine("\n\n<!-- GENERATED TOOL TIPS -->")
+ wr.Write(res.ToolTipHtml)
+
+doWork ()
+let sw = Stopwatch()
+sw.Start()
+doWork ()
+sw.Stop()
+printfn "Processing took: %dms" sw.ElapsedMilliseconds
+// Assembly.Load("FSharp.Compiler, Version=2.0.0.0, Culture=neutral, PublicKeyToken=a19089b1c74d0809")
+// Assembly.LoadFile(@"C:\Program Files (x86)\Microsoft SDKs\F#\3.0\Framework\v4.0\FSharp.Compiler.dll")
View
27 src/FSharp.CodeFormat.Tests/Script.fsx
@@ -1,27 +0,0 @@
-// --------------------------------------------------------------------------------------
-// TODO: Some actual unit tests would be nice
-// --------------------------------------------------------------------------------------
-
-#r @"..\FSharp.CodeFormat\bin\Debug\FSharp.CodeFormat.dll"
-open FSharp.CodeFormat
-open System.Reflection
-
-// Load custom-built F# compiler with joinads
-let asm = Assembly.LoadFile(@"C:\tomas\Binary\FSharp.Extensions\Debug\cli\4.0\bin\FSharp.Compiler.dll")
-
-let agent = CodeFormat.CreateAgent(asm)
-
-let source = @"
- let foo = 10
- foo
-"
-
-let snips =
- agent.AsyncParseSource("C:\\test.fsx", source.Trim())
- |> Async.RunSynchronously
-
-let res = CodeFormat.FormatHtml(snips, "fstips")
-res.SnippetsHtml.[0].Html
-
-// Assembly.Load("FSharp.Compiler, Version=2.0.0.0, Culture=neutral, PublicKeyToken=a19089b1c74d0809")
-// Assembly.LoadFile(@"C:\Program Files (x86)\Microsoft SDKs\F#\3.0\Framework\v4.0\FSharp.Compiler.dll")
View
1 src/FSharp.CodeFormat.Tests/tests/a.fs
@@ -0,0 +1 @@
+let str = "hello"
View
121 src/FSharp.CodeFormat.Tests/tests/async.fs
@@ -0,0 +1,121 @@
+// [snippet:0]
+open System
+open System.Net
+open System.Text.RegularExpressions
+
+/// Extracts the content of the <title> element
+let extractTitle html =
+ let regTitle = new Regex(@"\<title\>([^\<]+)\</title\>")
+ regTitle.Match(html).Groups.[1].Value
+
+/// Asynchronously downloads a page and extracts the title
+/// (uses a proxy to enable cross-domain downloads)
+let downloadTitle url = async {
+ let wc = new WebClient()
+ let proxy = "http://tomasp.net/tryjoinads/proxy.aspx?url=" + url
+ let! html = wc.AsyncDownloadString(Uri(proxy))
+ return extractTitle html }
+// [/snippet]
+
+// [snippet:1]
+open FSharp.Extensions.Joinads
+
+let fsharp = "http://www.fsharp.net"
+let csharp = "http://www.csharp.net"
+
+/// Download titles of two pages in parallel
+let titles = async {
+ match! downloadTitle fsharp, downloadTitle csharp with
+ | title1, title2 ->
+ printfn "Downloaded:\n - %s\n - %s" title1 title2 }
+
+titles |> Async.Start
+// [/snippet]
+
+// [snippet:2]
+let main = "http://msdn.microsoft.com/en-us/vstudio/hh388569.aspx"
+let backup = "http://www.fsharp.net"
+
+/// Start two downloads and return the first available result
+let getFirst = async {
+ match! downloadTitle main, downloadTitle backup with
+ | res, ? -> printfn "Main: %s" res
+ | ?, res -> printfn "Backup: %s" res }
+
+getFirst |> Async.Start
+// [/snippet]
+
+// [snippet:3]
+let good = "http://www.fsharp.net"
+let bad = "http://www.f#.net"
+
+/// Wraps 'downloadTitle' with an exception handler and returns
+/// None if an exception occurs (or Some when download succeeds)
+let tryDownloadTitle url = (*[omit(...)]*)async {
+ try
+ let! res = downloadTitle url
+ return Some res
+ with e -> return None }(*[/omit]*)
+
+/// Try to download first available title. If both downloads
+/// fail, then the value 'None' is returned.
+let tryGetFirst = async {
+ match! tryDownloadTitle good, tryDownloadTitle bad with
+ | Some res, ? -> return Some ("First: " + res)
+ | ?, Some res -> return Some ("Second: " + res)
+ | None, None -> return None }
+
+// Run the download synchronously and wait for the result
+let res = tryGetFirst |> Async.RunSynchronously
+printfn "Result: %A" res
+// [/snippet]
+
+// [snippet:4]
+(*[omit:Import necessary namespaces]*)
+open System.Windows
+open System.Windows.Controls
+open FSharp.Console
+open FSharp.Extensions.Joinads(*[/omit]*)
+
+/// Creates a label that shows the current count and
+/// buttons that increment and decrement the number
+let createUserInterface() = (*[omit:(...)]*)
+ let addControl (left, top) (ctrl:#UIElement) =
+ App.Console.Canvas.Children.Add(ctrl)
+ Canvas.SetTop(ctrl, top)
+ Canvas.SetLeft(ctrl, left)
+ ctrl
+
+ let label = addControl (20.0, 20.0) (TextBlock(FontSize = 20.0))
+ let incBtn = addControl (20.0, 60.0) (Button(Content="Increment", Width = 80.0))
+ let decBtn = addControl (110.0, 60.0) (Button(Content="Decrement", Width = 80.0))
+ label, incBtn, decBtn(*[/omit]*)
+
+/// Runs the specified workflow on the main
+/// user-interface thread of the F# console
+let runUserInterface work = (*[omit:(...)]*)
+ App.Dispatch (fun() ->
+ App.Console.ClearCanvas()
+ Async.StartImmediate work
+ App.Console.CanvasPosition <- CanvasPosition.Right )(*[/omit]*)
+
+/// Main workflow of the widget - creates the user interface and then
+/// starts a recursive async function that implements user interaction.
+let main = async {
+ let label, inc, dec = createUserInterface()
+
+ /// Recursive workflow that keeps the current count as an argument
+ let rec counter n : Async<unit> = async {
+ // Update the text on the label
+ label.Text <- sprintf "Count: %d" n
+ // Wait for click on one of the two buttons
+ match! Async.AwaitEvent inc.Click, Async.AwaitEvent dec.Click with
+ | _, ? -> return! counter (n + 1)
+ | ?, _ -> return! counter (n - 1) }
+
+ // Start the counter user interaction
+ return! counter 0 }
+
+// Start the main computation on GUI thread
+runUserInterface main
+// [/snippet]
View
21 src/FSharp.CodeFormat/CodeFormatAgent.fs
@@ -97,9 +97,9 @@ module private Helpers =
// --------------------------------------------------------------------------------------
/// Uses agent to handle formatting requests
-type CodeFormatAgent(assembly) =
+type CodeFormatAgent(fsharpCompiler) =
- do FSharpCompiler.BindToAssembly(assembly)
+ do FSharpCompiler.BindToAssembly(fsharpCompiler)
// Get the number of "IDENT" token in the F# compiler
// (This is needed when calling compiler, and it varies depending
@@ -242,8 +242,14 @@ type CodeFormatAgent(assembly) =
// Return parsed snippet as 'Snippet' value
Snippet(title, parsed))
-
- return parsedSnippets }
+
+ let sourceErrors =
+ [| for errInfo in errors ->
+ SourceError
+ ( (errInfo.StartLine, errInfo.StartColumn), (errInfo.EndLine, errInfo.EndColumn),
+ (if errInfo.Severity = Severity.Error then ErrorKind.Error else ErrorKind.Warning),
+ errInfo.Message ) |]
+ return parsedSnippets, sourceErrors }
// ------------------------------------------------------------------------------------
// Agent that implements the parsing & formatting
@@ -252,8 +258,11 @@ type CodeFormatAgent(assembly) =
while true do
// Receive parameters for the next parsing request
let! request, (chnl:AsyncReplyChannel<_>) = agent.Receive()
- let! res = processSourceCode request
- chnl.Reply(res |> Array.ofList)
+ try
+ let! res, errs = processSourceCode request
+ chnl.Reply(res |> Array.ofList, errs)
+ with e ->
+ printfn "Failed %A" e
})
/// Parse the source code specified by 'source', assuming that it
View
10 src/FSharp.CodeFormat/FSharp.CodeFormat.fsproj
@@ -20,7 +20,7 @@
<Optimize>false</Optimize>
<Tailcalls>false</Tailcalls>
<OutputPath>bin\Debug\</OutputPath>
- <DefineConstants>DEBUG;TRACE</DefineConstants>
+ <DefineConstants>TRACE;DEBUG</DefineConstants>
<WarningLevel>3</WarningLevel>
<PlatformTarget>x86</PlatformTarget>
<DocumentationFile>
@@ -36,9 +36,13 @@
<PlatformTarget>x86</PlatformTarget>
<DocumentationFile>bin\Release\FSharp.CodeFormat.XML</DocumentationFile>
</PropertyGroup>
+ <Import Project="$(MSBuildExtensionsPath32)\FSharp\1.0\Microsoft.FSharp.Targets" Condition="!Exists('$(MSBuildBinPath)\Microsoft.Build.Tasks.v4.0.dll')" />
+ <Import Project="$(MSBuildExtensionsPath32)\..\Microsoft F#\v4.0\Microsoft.FSharp.Targets" Condition=" Exists('$(MSBuildBinPath)\Microsoft.Build.Tasks.v4.0.dll')" />
<ItemGroup>
+ <Reference Include="FSharp.Core">
+ <HintPath>..\..\..\..\..\Program Files (x86)\Reference Assemblies\Microsoft\FSharp\2.0\Runtime\v4.0\FSharp.Core.dll</HintPath>
+ </Reference>
<Reference Include="mscorlib" />
- <Reference Include="FSharp.Core" />
<Reference Include="System" />
<Reference Include="System.Core" />
<Reference Include="System.Numerics" />
@@ -59,8 +63,6 @@
<Compile Include="HtmlFormatting.fs" />
<Compile Include="Main.fs" />
</ItemGroup>
- <Import Project="$(MSBuildExtensionsPath32)\FSharp\1.0\Microsoft.FSharp.Targets" Condition="!Exists('$(MSBuildBinPath)\Microsoft.Build.Tasks.v4.0.dll')" />
- <Import Project="$(MSBuildExtensionsPath32)\..\Microsoft F#\v4.0\Microsoft.FSharp.Targets" Condition=" Exists('$(MSBuildBinPath)\Microsoft.Build.Tasks.v4.0.dll')" />
<!-- To modify your build process, add your task inside one of the targets below and uncomment it.
Other similar extension points exist, see Microsoft.Common.targets.
<Target Name="BeforeBuild">
View
135 src/FSharp.CodeFormat/FSharpCompiler.fs
@@ -27,16 +27,32 @@ module Reflection =
let ctorFlags = instanceFlags
let inline asMethodBase(a:#MethodBase) = a :> MethodBase
+
+ // Caching to make the initial lookup a bit faster
+ let typeInfoLookup = new System.Collections.Generic.Dictionary<_, option<Type * Type>>()
+ let lookupTypeInfo typ f =
+ match typeInfoLookup.TryGetValue(typ) with
+ | true, res -> res
+ | false, _ ->
+ let res = f()
+ typeInfoLookup.Add(typ, res)
+ res
+
let (?) (o:obj) name : 'R =
+ let extractTypeInfo () =
+ if FSharpType.IsFunction(typeof<'R>) then
+ Some(FSharpType.GetFunctionElements(typeof<'R>))
+ else None
+
+ match lookupTypeInfo (typeof<'R>) extractTypeInfo with
// The return type is a function, which means that we want to invoke a method
- if FSharpType.IsFunction(typeof<'R>) then
- let argType, resType = FSharpType.GetFunctionElements(typeof<'R>)
+ | Some(argType, resType) ->
FSharpValue.MakeFunction(typeof<'R>, fun args ->
// We treat elements of a tuple passed as argument as a list of arguments
// When the 'o' object is 'System.Type', we call static methods
let methods, instance, args =
let args =
- if argType = typeof<unit> then [| |]
+ if Object.Equals(argType, typeof<unit>) then [| |]
elif not(FSharpType.IsTuple(argType)) then [| args |]
else FSharpValue.GetTupleFields(args)
if (typeof<System.Type>).IsAssignableFrom(o.GetType()) then
@@ -49,50 +65,123 @@ module Reflection =
// A simple overload resolution based on the name and number of parameters only
let methods =
[ for m in methods do
- if m.Name = name && m.GetParameters().Length = args.Length then yield m ]
+ if m.Name = name && m.GetParameters().Length = args.Length then yield m
+ if m.Name = name && m.IsGenericMethod &&
+ m.GetGenericArguments().Length + m.GetParameters().Length = args.Length then yield m ]
match methods with
| [] -> failwithf "No method '%s' with %d arguments found" name args.Length
| _::_::_ -> failwithf "Multiple methods '%s' with %d arguments found" name args.Length
| [:? ConstructorInfo as c] -> c.Invoke(args)
+ | [ m ] when m.IsGenericMethod ->
+ let tyCount = m.GetGenericArguments().Length
+ let tyArgs = args |> Seq.take tyCount
+ let actualArgs = args |> Seq.skip tyCount
+ let gm = (m :?> MethodInfo).MakeGenericMethod [| for a in tyArgs -> unbox a |]
+ gm.Invoke(instance, Array.ofSeq actualArgs)
| [ m ] -> m.Invoke(instance, args) ) |> unbox<'R>
- else
+ | _ ->
// When the 'o' object is 'System.Type', we access static properties
let typ, flags, instance =
if (typeof<System.Type>).IsAssignableFrom(o.GetType()) then unbox o, staticFlags, null
else o.GetType(), instanceFlags, o
// Find a property that we can call and get the value
let prop = typ.GetProperty(name, flags)
- if prop = null then
+ if Object.Equals(prop, null) then
let fld = typ.GetField(name, flags)
- if fld = null then
+ if Object.Equals(fld, null) then
failwithf "Field or property '%s' not found in '%s' using flags '%A'." name typ.Name flags
else
fld.GetValue(instance) |> unbox<'R>
else
let meth = prop.GetGetMethod(true)
- if prop = null then failwithf "Property '%s' found, but doesn't have 'get' method." name
+ if Object.Equals(prop, null) then failwithf "Property '%s' found, but doesn't have 'get' method." name
meth.Invoke(instance, [| |]) |> unbox<'R>
+
+
+
+ /// Convert list of type FSharpList to a list in the specified FSharp.Core assembly
+ let convertList (list:obj) (fsharpCore:Assembly) : obj =
+ // Find the generic arguments of the source
+ let bases = list.GetType() |> Seq.unfold (fun ty ->
+ if ty.FullName = "System.Object" then None else Some(ty, ty.BaseType) )
+ let sourceListTyp = bases |> Seq.find (fun ty -> ty.Name = "FSharpList`1")
+ let tyArg = sourceListTyp.GetGenericArguments().[0]
+
+ let listMod = fsharpCore.GetType("Microsoft.FSharp.Collections.ListModule")
+ listMod?OfSeq(tyArg, list)
+
+
+ /// Really simple closure type for creating delegates
+ type Closure<'T, 'R>(f) =
+ member x.Invoke(a : 'T) : 'R = unbox (f (box a))
+
+ /// Convert function of type FSharpFunc to a function in the specified FSharp.Core assembly
+ let convertFunction (func:obj) (fsharpCore:Assembly) : obj =
+ // Find the generic arguments of the source
+ let bases = func.GetType() |> Seq.unfold (fun ty ->
+ if ty.FullName = "System.Object" then None else Some(ty, ty.BaseType) )
+ let sourceFuncTyp = bases |> Seq.find (fun ty -> ty.Name = "FSharpFunc`2")
+ if not (sourceFuncTyp.IsGenericType) then failwith "FSharpFunc should be generic!"
+
+ let args = sourceFuncTyp.GetGenericArguments()
+ if args.Length <> 2 then failwith "FSharpFunc has wrong number of generic args!"
+ if args.[1].Name = "FSharpFunc`2" then failwith "Curried functions not supported yet!"
+
+ // Make target function type
+ let targetArgs = args |> Array.map (fun arg ->
+ // Does not work for generic types, but does the trick for unit
+ if arg.FullName.StartsWith("Microsoft.FSharp.Core") then
+ fsharpCore.GetType(arg.FullName)
+ else arg)
+
+ // Create closure that invokes the source function using reflection
+ let invoke = func.GetType().GetMethod("Invoke")
+ let invokeFunc (arg:obj) = invoke.Invoke(func, [| arg |])
+ let clo = typedefof<Closure<_, _>>.MakeGenericType(targetArgs)?``.ctor``(invokeFunc)
+
+ // Create converter delegate from the closure and turn it to F# function
+ // Assumes current runtime and the taget's runtime are the same...
+ let funcTyp = fsharpCore.GetType("Microsoft.FSharp.Core.FSharpFunc`2")
+ let boundFuncTyp = funcTyp.MakeGenericType(targetArgs)
+ let boundConverter = typedefof<System.Converter<_, _>>.MakeGenericType(targetArgs)
+ let converter = Delegate.CreateDelegate(boundConverter, clo, clo.GetType().GetMethod("Invoke"))
+ boundFuncTyp?FromConverter(converter)
+
/// Wrapper type for the 'FSharp.Compiler.dll' assembly - expose types we use
type FSharpCompilerWrapper() =
- let mutable assembly = None
+ let mutable fsharpCompiler = None
+ let mutable fsharpCore = None
+
/// Exposes the currently loaded FSharp.Compiler.dll
- member x.CurrentAssembly : Assembly =
- match assembly with
+ member x.FSharpCompiler : Assembly =
+ match fsharpCompiler with
| None -> failwith "Assembly FSharp.Compiler is not configured!"
| Some asm -> asm
- /// Configure the wrapper to use the specified FSharp.Compiler.dll
- member x.BindToAssembly(asm) = assembly <- Some asm
+ /// Returns the referenced 'FSharp.Core.dll' assembly
+ member x.ReferencedFSharpCore =
+ match fsharpCore with
+ | None -> failwith "Assembly FSharp.Core is not configured!"
+ | Some asm -> asm
- member x.InteractiveChecker = x.CurrentAssembly.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.InteractiveChecker")
- member x.IsResultObsolete = x.CurrentAssembly.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.IsResultObsolete")
- member x.CheckOptions = x.CurrentAssembly.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.CheckOptions")
- member x.SourceTokenizer = x.CurrentAssembly.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.SourceTokenizer")
- member x.TokenInformation = x.CurrentAssembly.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.TokenInformation")
- member x.``Parser.token.Tags`` = x.CurrentAssembly.GetType("Microsoft.FSharp.Compiler.Parser+token+Tags")
+ /// Configure the wrapper to use the specified FSharp.Compiler.dll
+ member x.BindToAssembly(compiler) =
+ fsharpCompiler <- Some compiler
+ // Determine FSharp.Core assmembly from the FSharpFunc`1 type given as
+ // the argument to InteractiveChecker.Create (kind of hack..)
+ let flags = BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic
+ let createMi = (x.InteractiveChecker : System.Type).GetMethod("Create", flags)
+ fsharpCore <- Some (createMi.GetParameters().[0].ParameterType.Assembly)
+
+ member x.InteractiveChecker = x.FSharpCompiler.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.InteractiveChecker")
+ member x.IsResultObsolete = x.FSharpCompiler.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.IsResultObsolete")
+ member x.CheckOptions = x.FSharpCompiler.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.CheckOptions")
+ member x.SourceTokenizer = x.FSharpCompiler.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.SourceTokenizer")
+ member x.TokenInformation = x.FSharpCompiler.GetType("Microsoft.FSharp.Compiler.SourceCodeServices.TokenInformation")
+ member x.``Parser.token.Tags`` = x.FSharpCompiler.GetType("Microsoft.FSharp.Compiler.Parser+token+Tags")
let FSharpCompiler = new FSharpCompilerWrapper()
@@ -188,7 +277,7 @@ module SourceCodeServices =
optInfo, newstate
type SourceTokenizer(defines:string list, source:string) =
- let wrapped = FSharpCompiler.SourceTokenizer?``.ctor``(defines, source)
+ let wrapped = FSharpCompiler.SourceTokenizer?``.ctor``(convertList defines FSharpCompiler.ReferencedFSharpCore, source)
member x.CreateLineTokenizer(line:string) =
LineTokenizer(wrapped?CreateLineTokenizer(line))
@@ -318,7 +407,7 @@ module SourceCodeServices =
/// Resolve the names at the given location to give a data tip
member x.GetDataTipText(pos:Position, line:string, names:Names, tokentag:int) : DataTipText =
- DataTipText(wrapped?GetDataTipText(pos, line, names, tokentag))
+ DataTipText(wrapped?GetDataTipText(pos, line, convertList names FSharpCompiler.ReferencedFSharpCore, tokentag))
/// Resolve the names at the given location to give F1 keyword
// member GetF1Keyword : Position * string * Names -> string option
@@ -373,7 +462,7 @@ module SourceCodeServices =
type InteractiveChecker(wrapped:obj) =
/// Crate an instance of the wrapper
static member Create (dirty:FileTypeCheckStateIsDirty) =
- InteractiveChecker(FSharpCompiler.InteractiveChecker?Create(dirty))
+ InteractiveChecker(FSharpCompiler.InteractiveChecker?Create(convertFunction dirty FSharpCompiler.ReferencedFSharpCore))
/// Parse a source code file, returning a handle that can be used for obtaining navigation bar information
/// To get the full information, call 'TypeCheckSource' method on the result
@@ -391,7 +480,7 @@ module SourceCodeServices =
TypeCheckAnswer
( wrapped?TypeCheckSource
( parsed.Wrapped, filename, fileversion, source, options.Wrapped,
- FSharpCompiler.IsResultObsolete?NewIsResultObsolete(f) ) : obj)
+ FSharpCompiler.IsResultObsolete?NewIsResultObsolete(convertFunction f FSharpCompiler.ReferencedFSharpCore) ) : obj)
/// For a given script file, get the CheckOptions implied by the #load closure
member x.GetCheckOptionsFromScriptRoot(filename:string, source:string) : CheckOptions =
View
8 src/FSharp.CodeFormat/HtmlFormatting.fs
@@ -50,7 +50,7 @@ type ToolTipFormatter(prefix) =
/// Returns all generated tool tip elements
member x.WriteTipElements (writer:TextWriter) =
for (KeyValue(_, (index, html))) in tips do
- writer.Write(sprintf "<div class=\"tip\" id=\"%s%d\">%s</div>" prefix index html)
+ writer.WriteLine(sprintf "<div class=\"tip\" id=\"%s%d\">%s</div>" prefix index html)
/// Represents context used by the formatter
type FormattingContext =
@@ -85,7 +85,8 @@ let formatToolTipSpans spans =
/// Format token spans such as tokens, omitted code etc.
let rec formatTokenSpans (ctx:FormattingContext) = List.iter (function
| Error(kind, message, body) when ctx.GenerateErrors ->
- let tipAttributes = ctx.FormatTip [Literal message] true formatToolTipSpans
+ let tip = ToolTipReader.formatMultilineString (message.Trim())
+ let tipAttributes = ctx.FormatTip tip true formatToolTipSpans
ctx.Writer.Write("<span ")
ctx.Writer.Write(tipAttributes)
ctx.Writer.Write("class=\"cerr\">")
@@ -101,7 +102,8 @@ let rec formatTokenSpans (ctx:FormattingContext) = List.iter (function
ctx.Writer.Write("</span>")
| Omitted(body, hidden) ->
- let tipAttributes = ctx.FormatTip [Literal body] false formatToolTipSpans
+ let tip = ToolTipReader.formatMultilineString (hidden.Trim())
+ let tipAttributes = ctx.FormatTip tip true formatToolTipSpans
ctx.Writer.Write("<span ")
ctx.Writer.Write(tipAttributes)
ctx.Writer.Write("class=\"omitted\">")
View
4 src/FSharp.CodeFormat/Main.fs
@@ -27,8 +27,8 @@ type CodeFormat =
/// using the F# compiler service. The agent requires a reference to
/// the 'FSharp.Compiler.dll' assembly. At the moment, the assembly
/// is shared by all the instances of formatting agent!
- static member CreateAgent(assembly) =
- CodeFormatAgent(assembly)
+ static member CreateAgent(fsharpCompiler) =
+ CodeFormatAgent(fsharpCompiler)
/// Formats the snippets parsed using the CodeFormatAgent as HTML
/// The parameters specify prefix for HTML tags, whether lines should
View
4 src/FSharp.CodeFormat/SourceCode.fs
@@ -42,4 +42,6 @@ and TokenSpans = TokenSpan list
type Line = Line of TokenSpans
-type Snippet = Snippet of string * Line list
+type Snippet = Snippet of string * Line list
+
+type SourceError = SourceError of (int * int) * (int * int) * ErrorKind * string
View
9 src/FSharp.Formatting.sln
@@ -7,10 +7,7 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.Markdown.Tests", "FS
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.CodeFormat", "FSharp.CodeFormat\FSharp.CodeFormat.fsproj", "{341EBF32-D470-4C55-99E9-55F14F7FFBB1}"
EndProject
-Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "FSharp.CodeFormat.Tests", "FSharp.CodeFormat.Tests", "{D8986C46-42E0-4087-9A07-131163119BC6}"
- ProjectSection(SolutionItems) = preProject
- FSharp.CodeFormat.Tests\Script.fsx = FSharp.CodeFormat.Tests\Script.fsx
- EndProjectSection
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.CodeFormat.Tests", "FSharp.CodeFormat.Tests\FSharp.CodeFormat.Tests.fsproj", "{5DEBD769-D86E-4E14-ABF1-373CA91BFAA2}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
@@ -30,6 +27,10 @@ Global
{341EBF32-D470-4C55-99E9-55F14F7FFBB1}.Debug|x86.Build.0 = Debug|x86
{341EBF32-D470-4C55-99E9-55F14F7FFBB1}.Release|x86.ActiveCfg = Release|x86
{341EBF32-D470-4C55-99E9-55F14F7FFBB1}.Release|x86.Build.0 = Release|x86
+ {5DEBD769-D86E-4E14-ABF1-373CA91BFAA2}.Debug|x86.ActiveCfg = Debug|x86
+ {5DEBD769-D86E-4E14-ABF1-373CA91BFAA2}.Debug|x86.Build.0 = Debug|x86
+ {5DEBD769-D86E-4E14-ABF1-373CA91BFAA2}.Release|x86.ActiveCfg = Release|x86
+ {5DEBD769-D86E-4E14-ABF1-373CA91BFAA2}.Release|x86.Build.0 = Release|x86
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
View
2 src/FSharp.Markdown/MarkdownParser.fs
@@ -163,7 +163,7 @@ let (|Heading|_|) = function
/// Recognizes a horizontal rule written using *, _ or -
let (|HorizontalRule|_|) (line:string) =
let rec loop ((h, a, u) as arg) i =
- if h >= 3 || a >= 3 || u >= 3 then Some()
+ if (h >= 3 || a >= 3 || u >= 3) && i = line.Length then Some()
elif i = line.Length then None
elif Char.IsWhiteSpace line.[i] then loop arg (i + 1)
elif line.[i] = '-' && a = 0 && u = 0 then loop (h + 1, a, u) (i + 1)

0 comments on commit 63f0cfc

Please sign in to comment.
Something went wrong with that request. Please try again.