Skip to content

Commit

Permalink
Lookup aspect target (WIP)
Browse files Browse the repository at this point in the history
  • Loading branch information
@kekyo
kekyo committed Dec 22, 2016
1 parent f3de3c8 commit ec1249a
Show file tree
Hide file tree
Showing 4 changed files with 139 additions and 48 deletions.
2 changes: 0 additions & 2 deletions fscx.sln
View file
Original file line number Diff line number Diff line change
Expand Up @@ -115,9 +115,7 @@ Global
{003F2DE0-89F5-4202-99CB-41A4C3CE39D7}.Release|Any CPU.ActiveCfg = Release|Any CPU
{003F2DE0-89F5-4202-99CB-41A4C3CE39D7}.Release|Any CPU.Build.0 = Release|Any CPU
{29331FED-1279-4F4A-B7F4-1EABC3D794D0}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{29331FED-1279-4F4A-B7F4-1EABC3D794D0}.Debug|Any CPU.Build.0 = Debug|Any CPU
{29331FED-1279-4F4A-B7F4-1EABC3D794D0}.Release|Any CPU.ActiveCfg = Release|Any CPU
{29331FED-1279-4F4A-B7F4-1EABC3D794D0}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
Expand Down
165 changes: 124 additions & 41 deletions src/FSharp.Expandable.Compiler.Aspect/FscxInjectAspectVisitor.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@ namespace FSharp.Expandable

open System
open System.IO
open System.Linq
open System.Reflection
open System.Text.RegularExpressions
open FSharp.Expandable
Expand All @@ -33,7 +34,7 @@ open Microsoft.FSharp.Compiler.SourceCodeServices
////////////////////////////////////////////////////////////////

[<Sealed; AbstractClass; NoEquality; NoComparison; AutoSerializable(false)>]
type internal FscxInjectAspectVisitorImpl<'TAspect> private () =
type private FscxInjectAspectVisitorImpl<'TAspect> private () =

static let typeName = typeof<'TAspect>.FullName

Expand Down Expand Up @@ -82,7 +83,8 @@ type internal FscxInjectAspectVisitorImpl<'TAspect> private () =
type FscxInjectAspectVisitorContext<'TContext> = {
SymbolInformation: FSharpCheckFileResults
FilterArguments: Map<string, string[]>
CachedTargets: (Regex * Regex)[]
TargetAssemblies: Regex[]
AspectTargetCount: int
Context: 'TContext
}

Expand Down Expand Up @@ -185,11 +187,11 @@ type FscxInjectAspectVisitor<'TContext when 'TContext: (new: unit -> 'TContext)>
identForSymbol funcExpr
// Single symbol
| SynExpr.Ident ident ->
Some (expr, ident.idText)
Some (expr, [ ident ], ident.idText)
// Multiple structuring symbols
| SynExpr.LongIdent (_, longIdent, _, _) ->
let elements = longIdent.Lid |> List.map (fun i -> i.idText)
Some (expr, String.Join(".", elements))
Some (expr, longIdent.Lid, String.Join(".", elements))
// Other, do not apply custom visitor.
| _ ->
None
Expand Down Expand Up @@ -252,6 +254,19 @@ type FscxInjectAspectVisitor<'TContext when 'TContext: (new: unit -> 'TContext)>

//////////////////////

static let getSymbolUseAtIdent (symbolInformation: FSharpCheckFileResults) (ids: Ident list) =
let head = ids |> Seq.map (fun id -> id.idRange) |> Seq.head
let last = ids |> Seq.map (fun id -> id.idRange) |> Enumerable.Last
let names = ids |> Seq.map (fun id -> id.idText) |> Seq.toList
let text = String.Join(".", names)
symbolInformation.GetSymbolUseAtLocation
(head.StartLine,
last.EndColumn,
text,
names)

//////////////////////

// Public constructor
new (aspectTypeName: string) =
FscxInjectAspectVisitor([ yield! aspectTypeName.Split('.'); yield "Enter"])
Expand Down Expand Up @@ -402,23 +417,79 @@ type FscxInjectAspectVisitor<'TContext when 'TContext: (new: unit -> 'TContext)>
override __.CreateContext(filterArguments, symbolInformation) =
let targets =
match filterArguments.TryFind "FSharp.Expandable.Compiler.Aspect" with
| Some args ->
args
|> Seq.map (fun value ->
value.Split([|':'|], StringSplitOptions.RemoveEmptyEntries)
|> Array.map (fun arg -> arg.Trim()))
|> Seq.choose (fun args ->
match args with
| [|fileName; functionName|] -> Some (fileName, functionName)
| _ -> None)
| None ->
[ (".*", ".*") ] |> seq // Targetting for all source file and functions.
let cachedTargets =
| Some args -> args
| None -> [| ".*" |] // Targetting for all source file and functions.
let targetAssemblies =
targets
|> Seq.map (fun (fileName, functionName) -> new Regex(fileName, RegexOptions.Compiled), new Regex(functionName, RegexOptions.Compiled))
|> Seq.toArray
|> Array.map (fun matchExpr -> new Regex(matchExpr, RegexOptions.Compiled ||| RegexOptions.Singleline))

{ FilterArguments = filterArguments;
SymbolInformation = symbolInformation;
TargetAssemblies = targetAssemblies;
AspectTargetCount = 0;
Context = new 'TContext() }

/// <summary>
/// Hook "SynBinding.Binding" (Before visit)
/// </summary>
override __.BeforeVisitBinding_Binding
(context,
access,
bindingKind,
mustInline,
isMutable,
attributes,
xmlDoc,
item7,
headPat,
item9,
expr,
lhsRange,
spBind) =

let context =
// Check if applied attributes:
let found =
attributes.AsParallel().Any
(new Func<SynAttribute, bool>(fun attribute ->
// Binding expression has one or more attributes
let ids = attribute.TypeName.Lid
let result =
getSymbolUseAtIdent context.SymbolInformation ids
|> Async.RunSynchronously // Cannot async wait
match result with
| Some symbolUse ->
// Duck-typed naming "AspectTargetAttribute"
// (Not required decision for where is assembly)
let name = symbolUse.Symbol.FullName
if name = "FSharp.Expandable.Compiler.AspectTargetAttribute" then
true
else
false
| _ -> false))

// Found AspectTargetAttribute
if found then
// Enter aspect block:
{ context with AspectTargetCount = context.AspectTargetCount + 1 }
else
context

{ FilterArguments = filterArguments; SymbolInformation = symbolInformation; CachedTargets = cachedTargets; Context = new 'TContext() }
// Fallback default impls.
base.BeforeVisitBinding_Binding
(context,
access,
bindingKind,
mustInline,
isMutable,
attributes,
xmlDoc,
item7,
headPat,
item9,
expr,
lhsRange,
spBind)

/// <summary>
/// Hook "SynExpr.App" (Before visit)
Expand All @@ -431,31 +502,43 @@ type FscxInjectAspectVisitor<'TContext when 'TContext: (new: unit -> 'TContext)>
argExpr,
appRange) =

let inputFileName =
match base.Parents |> Seq.head with
| AstElement.Input(ParsedInput.ImplFile(ParsedImplFileInput(inputPath, _, _, _, _, _, _))) ->
Path.GetFileName inputPath
// This expr already applied "AspectTargetAttribute."
if context.AspectTargetCount >= 1 then
match funcExpr, (funcExpr, argExpr) with
| IdentForSymbol(identExpr, ids, symbolName), Arguments(deconstructedExprs, currying) ->
// Try lookup symbol to typed reference:
let result =
getSymbolUseAtIdent context.SymbolInformation ids
|> Async.RunSynchronously // Cannot async wait
match result with
// Found:
| Some symbolUse ->
// Typed assembly name:
let qualifiedName = symbolUse.Symbol.Assembly.QualifiedName
let simpleName = symbolUse.Symbol.Assembly.SimpleName
let foundForQualified =
context.TargetAssemblies
|> Seq.exists (fun regex -> regex.IsMatch qualifiedName)
let found =
foundForQualified ||
(context.TargetAssemblies |> Seq.exists (fun regex -> regex.IsMatch simpleName))
if found then
// Deconstructed exprs visit manually.
// (funcExpr not visit, because IdentForSymbol traversed on original AST structures and decomposed identity.)
let visitedDeconstractedExprs = deconstructedExprs |> List.map (this.VisitExpr context)
// Insert aspect
this.InsertAspectToAppExpr(identExpr, symbolName, argExpr, visitedDeconstractedExprs, currying, appRange)
else
// Continue visit
base.BeforeVisitExpr_App(context, exprAtomicFlag, isInfix, funcExpr, argExpr, appRange)
| _ ->
// Continue visit
base.BeforeVisitExpr_App(context, exprAtomicFlag, isInfix, funcExpr, argExpr, appRange)
| _ ->
failwith ""

let functionNameRegex =
context.CachedTargets
|> Seq.choose (fun (fileNameRegex, functionNameRegex) ->
if fileNameRegex.IsMatch(inputFileName) then Some functionNameRegex else None)
|> Seq.tryHead

match funcExpr, (funcExpr, argExpr), functionNameRegex with
| IdentForSymbol(identExpr, symbolName), Arguments(deconstructedExprs, currying), Some functionNameRegex ->
if functionNameRegex.IsMatch(symbolName) then
// Deconstructed exprs visit manually.
// (funcExpr not visit, because IdentForSymbol traversed on original AST structures and decomposed identity.)
let visitedDeconstractedExprs = deconstructedExprs |> List.map (this.VisitExpr context)
// Insert aspect
this.InsertAspectToAppExpr(identExpr, symbolName, argExpr, visitedDeconstractedExprs, currying, appRange)
else
// Continue visit
base.BeforeVisitExpr_App(context, exprAtomicFlag, isInfix, funcExpr, argExpr, appRange)
| _ ->

else
// Continue visit
base.BeforeVisitExpr_App(context, exprAtomicFlag, isInfix, funcExpr, argExpr, appRange)

Expand Down
2 changes: 1 addition & 1 deletion tests/test_bench/Program.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@ module Program =
let main argv =
let args = CompilerHelper.UnsafeGetPreDefinedDefaultArguments TargetRuntimes.Loaded [] (["SampleAspectLogger.fs"; "SampleCode.fs"] |> List.map Path.GetFullPath)
args.FilterArguments <-
[("FSharp.Expandable.Compiler.Aspect",[|"SampleCode.fs:SampleCode\.AspectTargets?\.f[0-9][0-9]"|])]
[("FSharp.Expandable.Compiler.Aspect",[|"SampleCode"|])] // Regex'd assembly name
|> Map.ofList
let declAspectVisitor = DeclareFscxInjectAspectVisitor("SampleAspectLogger.SampleAspect")
CompilerHelper.RawCompileWithArguments (new Action<_>(dump)) args ([declAspectVisitor] |> Seq.cast<_>)
18 changes: 14 additions & 4 deletions tests/test_bench/SampleCode.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,14 +21,14 @@

namespace FSharp.Expandable.Compiler

open System

[<AttributeUsage(AttributeTargets.Method)>]
[<System.AttributeUsage(System.AttributeTargets.Method)>]
type AspectTargetAttribute() =
inherit Attribute()
inherit System.Attribute()

namespace SampleCode

open FSharp.Expandable.Compiler

module TestFunctions =

// let test () =
Expand All @@ -50,40 +50,50 @@ module TestFunctions =

module AspectTargets1 =

[<AspectTarget>]
let f11 (a: int, b: string, c: int) =
TestFunctions.output1(a + c, b, 123.456)

[<AspectTarget>]
let f12 (a: int, b: string, c: int) =
TestFunctions.output2 (a + c) b 123.456

[<AspectTarget>]
let f13 (a: int, b: string, c: int) =
TestFunctions.output3 (a + c) b 123.456

[<AspectTarget>]
let f14 () =
TestFunctions.output4 ()

//////////////

module AspectTargets2 =

[<AspectTarget>]
let f21 (a: int) (b: string) (c: int) =
TestFunctions.output1(a + c, b, 123.456)

[<AspectTarget>]
let f22 (a: int) (b: string) (c: int) =
TestFunctions.output2 (a + c) b 123.456

[<AspectTarget>]
let f23 (a: int) (b: string) (c: int) =
TestFunctions.output3 (a + c) b 123.456

//////////////

module AspectTargets3 =

[<AspectTarget>]
let f31 a b c =
TestFunctions.output1(a + c, b, 123.456)

[<AspectTarget>]
let f32 a b c =
TestFunctions.output2 (a + c) b 123.456

[<AspectTarget>]
let f33 a b c =
TestFunctions.output3 (a + c) b 123.456

0 comments on commit ec1249a

Please sign in to comment.