diff --git a/src/absil/il.fs b/src/absil/il.fs index 088b89157f6..955d779c55d 100755 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -1,6 +1,6 @@ // 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. -module internal Microsoft.FSharp.Compiler.AbstractIL.IL +module (*internal*) Microsoft.FSharp.Compiler.AbstractIL.IL #nowarn "49" #nowarn "44" // This construct is deprecated. please use List.item diff --git a/src/absil/il.fsi b/src/absil/il.fsi index e66e1afade7..ba68fe138c7 100644 --- a/src/absil/il.fsi +++ b/src/absil/il.fsi @@ -2,7 +2,7 @@ /// The "unlinked" view of .NET metadata and code. Central to /// to Abstract IL library -module internal Microsoft.FSharp.Compiler.AbstractIL.IL +module (*internal*) Microsoft.FSharp.Compiler.AbstractIL.IL open Internal.Utilities open System.Collections.Generic @@ -378,7 +378,7 @@ and ILTypes = ILList [] -module ILList = +module internal ILList = val inline map : ('T -> 'U) -> ILList<'T> -> ILList<'U> val inline mapi : (int -> 'T -> 'U) -> ILList<'T> -> ILList<'U> val inline isEmpty : ILList<'T> -> bool diff --git a/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj b/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj index 53091187420..834eb8b7ffd 100644 --- a/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj +++ b/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj @@ -21,7 +21,11 @@ {a437a6ec-5323-47c2-8f86-e2cac54ff152} true 0x06800000 + $(OtherFlags) --targetprofile:netcore + + + $(FSharpSourcesRoot)\..\loc\lcl\{Lang}\$(AssemblyName).dll.lcl @@ -31,6 +35,9 @@ + + assemblyinfo.FSharp.Compiler.dll.fs + FSComp.txt @@ -40,10 +47,9 @@ Reflection\reshapedreflection.fs - - assemblyinfo.FSharp.Compiler.dll.fs + + Reflection\reshapedmsbuild.fs - ErrorText\sformat.fsi @@ -198,6 +204,9 @@ AbsIL/ilmorph.fs + + AbsIL\ilsign.fs + AbsIL/ilsupp.fsi @@ -491,6 +500,12 @@ Service/Symbols.fs + + Service/Exprs.fsi + + + Service/Exprs.fs + Service/ServiceLexing.fsi @@ -524,8 +539,14 @@ Service/service.fs + + InternalsVisibleTo.fs + - + + + + @@ -543,6 +564,8 @@ ..\..\..\packages\Microsoft.DiaSymReader\1.0.7\lib\portable-net45+win8\Microsoft.DiaSymReader.dll ..\..\..\packages\System.Reflection.Metadata.1.3.0-beta-23816\lib\portable-net45+win8\System.Reflection.Metadata.dll ..\..\..\packages\System.Collections.Immutable.1.2.0-rc3-23805\lib\portable-net45+win8+wp8+wpa81 + + {DED3BBD7-53F4-428A-8C9F-27968E768605} FSharp.Core diff --git a/src/fsharp/FSharp.LanguageService.Compiler/project.json b/src/fsharp/FSharp.LanguageService.Compiler/project.json new file mode 100644 index 00000000000..aad7ac0b38a --- /dev/null +++ b/src/fsharp/FSharp.LanguageService.Compiler/project.json @@ -0,0 +1,38 @@ +{ + "dependencies": { + "Microsoft.NETCore.Platforms": "1.0.1-rc2-23911", + "NETStandard.Library": "1.5.0-rc2-23911", + "System.Collections.Immutable":"1.2.0-rc2-23911", + "System.Diagnostics.Process": "4.1.0-rc2-23911", + "System.Diagnostics.TraceSource": "4.0.0-rc2-23911", + "System.Linq.Expressions": "4.0.11-rc2-23911", + "System.Linq.Queryable": "4.0.1-rc2-23911", + "System.Net.Requests": "4.0.11-rc2-23911", + "System.Reflection.Emit": "4.0.1-rc2-23911", + "System.Reflection.Emit.ILGeneration": "4.0.1-rc2-23911", + "System.Reflection.Metadata": "1.3.0-rc2-23911", + "System.Reflection.TypeExtensions": "4.1.0-rc2-23911", + "System.Runtime.InteropServices": "4.1.0-rc2-23911", + "System.Runtime.InteropServices.PInvoke": "4.0.0-rc2-23911", + "System.Runtime.Loader": "4.0.0-rc2-23911", + "System.Security.Cryptography.Algorithms": "4.1.0-rc2-23911", + "System.Security.Cryptography.Primitives": "4.0.0-rc2-23911", + "System.Threading.Tasks.Parallel": "4.0.1-rc2-23911", + "System.Threading.Thread": "4.0.0-rc2-23911", + "System.Threading.ThreadPool": "4.0.10-rc2-23911", + "Microsoft.DiaSymReader.PortablePdb": "1.0.0-rc-60301", + "Microsoft.DiaSymReader": "1.0.7", + }, + "runtimes": { + "win7-x86": { }, + "win7-x64": { }, + "osx.10.10-x64": { }, + "ubuntu.14.04-x64": { } + }, + "frameworks": { + "dnxcore50": { + "imports": "portable-net45+win8" + } + } +} + diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index 1599fd5eb6b..cc7c3c8501c 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -1,6 +1,6 @@ // 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. -module internal Microsoft.FSharp.Compiler.Ast +module (*internal*) Microsoft.FSharp.Compiler.Ast open System.Collections.Generic open Internal.Utilities diff --git a/src/fsharp/range.fs b/src/fsharp/range.fs index 019884754bf..7524cf746fb 100755 --- a/src/fsharp/range.fs +++ b/src/fsharp/range.fs @@ -1,7 +1,7 @@ // 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. /// Anything to do with special names of identifiers and other lexical rules -module internal Microsoft.FSharp.Compiler.Range +module (*internal*) Microsoft.FSharp.Compiler.Range open System.IO open System.Collections.Generic diff --git a/src/fsharp/range.fsi b/src/fsharp/range.fsi index 07e2abd4c29..4b0a34fdf88 100755 --- a/src/fsharp/range.fsi +++ b/src/fsharp/range.fsi @@ -1,6 +1,6 @@ // 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. -module internal Microsoft.FSharp.Compiler.Range +module (*internal*) Microsoft.FSharp.Compiler.Range open System.Text open System.Collections.Generic diff --git a/src/fsharp/vs/Exprs.fs b/src/fsharp/vs/Exprs.fs new file mode 100644 index 00000000000..2d64cf90d33 --- /dev/null +++ b/src/fsharp/vs/Exprs.fs @@ -0,0 +1,1009 @@ +// Copyright (c) Microsoft Corpration, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +namespace Microsoft.FSharp.Compiler.SourceCodeServices + +open Microsoft.FSharp.Compiler +open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library +open Microsoft.FSharp.Compiler.AbstractIL.IL +open Microsoft.FSharp.Compiler.Lib +open Microsoft.FSharp.Compiler.Infos +open Microsoft.FSharp.Compiler.Range +open Microsoft.FSharp.Compiler.Tast +open Microsoft.FSharp.Compiler.TcGlobals +open Microsoft.FSharp.Compiler.Tastops +open Microsoft.FSharp.Compiler.QuotationTranslator +open Microsoft.FSharp.Compiler.TypeRelations +open Internal.Utilities + + +[] +module ExprUtilsImpl = + + // ILCall nodes arise from calls to .NET methods, and provided calls to + // F# methods. This method attempts to take the information in a ILMethodRef + // and bind it to a symbol. This is not fool proof when the ILCall refers to + // an F# method, but is a good approximation. + let bindILMethodRefToSymbol (cenv:Impl.cenv) m (ilMethRef: ILMethodRef) = + let tcref = Import.ImportILTypeRef cenv.amap m ilMethRef.EnclosingTypeRef + let enclosingType = generalizedTyconRef tcref + // First try to resolve it to IL metadata + let try1 = + if tcref.IsILTycon then + try + let mdef = resolveILMethodRefWithRescope (rescopeILType (p13 tcref.ILTyconInfo)) tcref.ILTyconRawMetadata ilMethRef + let minfo = MethInfo.CreateILMeth(cenv.amap, m, enclosingType, mdef) + Some (FSharpMemberOrFunctionOrValue(cenv, minfo)) + with _ -> None + else None + + // Otherwise try to bind it to an F# symbol + match try1 with + | Some res -> res + | None -> + try + // Try to bind the call to an F# method call + let memberParentName = if tcref.IsModuleOrNamespace then None else Some tcref.LogicalName + // TODO: this logical name is not correct in the presence of CompiledName + let logicalName = ilMethRef.Name + let isMember = memberParentName.IsSome + if isMember then + let isCtor = (ilMethRef.Name = ".ctor") + let isStatic = isCtor || ilMethRef.CallingConv.IsStatic + let scoref = ilMethRef.EnclosingTypeRef.Scope + let typars1 = tcref.Typars(m) + let typars2 = [ 1 .. ilMethRef.GenericArity ] |> List.map (fun _ -> NewRigidTypar "T" m) + let tinst1 = typars1 |> generalizeTypars + let tinst2 = typars2 |> generalizeTypars + // TODO: this will not work for curried methods in F# classes. + // This is difficult to solve as the information in the ILMethodRef + // is not sufficient to resolve to a symbol unambiguously in these cases. + let argtys = [ ilMethRef.ArgTypes |> List.map (ImportTypeFromMetadata cenv.amap m scoref tinst1 tinst2) ] + let rty = + match ImportReturnTypeFromMetaData cenv.amap m ilMethRef.ReturnType scoref tinst1 tinst2 with + | None -> if isCtor then enclosingType else cenv.g.unit_ty + | Some ty -> ty + + let linkageType = + let ty = mkIteratedFunTy (List.map (mkTupledTy cenv.g) argtys) rty + let ty = if isStatic then ty else mkFunTy enclosingType ty + tryMkForallTy (typars1 @ typars2) ty + + let argCount = List.sum (List.map List.length argtys) + (if isStatic then 0 else 1) + let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= argCount },Some linkageType) + + let enclosingNonLocalRef = mkNonLocalEntityRef tcref.nlr.Ccu tcref.PublicPath.Value.EnclosingPath + let vref = mkNonLocalValRef enclosingNonLocalRef key + vref.Deref |> ignore // check we can dereference the value + let minfo = MethInfo.FSMeth(cenv.g, enclosingType, vref, None) + FSharpMemberOrFunctionOrValue(cenv, minfo) + else + let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= 0 },None) + let vref = mkNonLocalValRef tcref.nlr key + vref.Deref |> ignore // check we can dereference the value + FSharpMemberOrFunctionOrValue(cenv, vref) + + with _ -> + failwith (sprintf "A call to '%s' could not be resolved" (ilMethRef.ToString())) + + + +[] +module ExprTranslationImpl = + + type ExprTranslationEnv = + { //Map from Val to binding index + vs: ValMap; + //Map from typar stamps to binding index + tyvs: StampMap; + // Map for values bound by the + // 'let v = isinst e in .... if nonnull v then ...v .... ' + // construct arising out the compilation of pattern matching. We decode these back to the form + // 'if istype v then ...unbox v .... ' + isinstVals: ValMap + substVals: ValMap } + + static member Empty = + { vs=ValMap<_>.Empty; + tyvs = Map.empty ; + isinstVals = ValMap<_>.Empty + substVals = ValMap<_>.Empty } + + member env.BindTypar (v:Typar, gp) = + { env with tyvs = env.tyvs.Add(v.Stamp,gp ) } + + member env.BindTypars vs = + (env, vs) ||> List.fold (fun env v -> env.BindTypar v) // fold left-to-right because indexes are left-to-right + + member env.BindVal v = + { env with vs = env.vs.Add v () } + + member env.BindIsInstVal v (ty,e) = + { env with isinstVals = env.isinstVals.Add v (ty,e) } + + member env.BindSubstVal v e = + { env with substVals = env.substVals.Add v e } + + member env.BindVals vs = (env,vs) ||> List.fold (fun env v -> env.BindVal v) + member env.BindCurriedVals vsl = (env,vsl) ||> List.fold (fun env vs -> env.BindVals vs) + + exception IgnoringPartOfQuotedTermWarning of string * Range.range + + let wfail (msg,m:range) = failwith (msg + sprintf " at %s" (m.ToString())) + + +/// The core tree of data produced by converting F# compiler TAST expressions into the form which we make available through the compiler API +/// through active patterns. +type E = + | Value of FSharpMemberOrFunctionOrValue + | ThisValue of FSharpType + | BaseValue of FSharpType + | Application of FSharpExpr * FSharpType list * FSharpExpr list + | Lambda of FSharpMemberOrFunctionOrValue * FSharpExpr + | TypeLambda of FSharpGenericParameter list * FSharpExpr + | Quote of FSharpExpr + | IfThenElse of FSharpExpr * FSharpExpr * FSharpExpr + | DecisionTree of FSharpExpr * (FSharpMemberOrFunctionOrValue list * FSharpExpr) list + | DecisionTreeSuccess of int * FSharpExpr list + | Call of FSharpExpr option * FSharpMemberOrFunctionOrValue * FSharpType list * FSharpType list * FSharpExpr list + | NewObject of FSharpMemberOrFunctionOrValue * FSharpType list * FSharpExpr list + | LetRec of ( FSharpMemberOrFunctionOrValue * FSharpExpr) list * FSharpExpr + | Let of (FSharpMemberOrFunctionOrValue * FSharpExpr) * FSharpExpr + | NewRecord of FSharpType * FSharpExpr list + | ObjectExpr of FSharpType * FSharpExpr * FSharpObjectExprOverride list * (FSharpType * FSharpObjectExprOverride list) list + | FSharpFieldGet of FSharpExpr option * FSharpType * FSharpField + | FSharpFieldSet of FSharpExpr option * FSharpType * FSharpField * FSharpExpr + | NewUnionCase of FSharpType * FSharpUnionCase * FSharpExpr list + | UnionCaseGet of FSharpExpr * FSharpType * FSharpUnionCase * FSharpField + | UnionCaseSet of FSharpExpr * FSharpType * FSharpUnionCase * FSharpField * FSharpExpr + | UnionCaseTag of FSharpExpr * FSharpType + | UnionCaseTest of FSharpExpr * FSharpType * FSharpUnionCase + | TraitCall of FSharpType list * string * FSharpType list * FSharpType list * FSharpExpr list + | NewTuple of FSharpType * FSharpExpr list + | TupleGet of FSharpType * int * FSharpExpr + | Coerce of FSharpType * FSharpExpr + | NewArray of FSharpType * FSharpExpr list + | TypeTest of FSharpType * FSharpExpr + | AddressSet of FSharpExpr * FSharpExpr + | ValueSet of FSharpMemberOrFunctionOrValue * FSharpExpr + | Unused + | DefaultValue of FSharpType + | Const of obj * FSharpType + | AddressOf of FSharpExpr + | Sequential of FSharpExpr * FSharpExpr + | FastIntegerForLoop of FSharpExpr * FSharpExpr * FSharpExpr * bool + | WhileLoop of FSharpExpr * FSharpExpr + | TryFinally of FSharpExpr * FSharpExpr + | TryWith of FSharpExpr * FSharpMemberOrFunctionOrValue * FSharpExpr * FSharpMemberOrFunctionOrValue * FSharpExpr + | NewDelegate of FSharpType * FSharpExpr + | ILFieldGet of FSharpExpr option * FSharpType * string + | ILFieldSet of FSharpExpr option * FSharpType * string * FSharpExpr + | ILAsm of string * FSharpType list * FSharpExpr list + +/// Used to represent the information at an object expression member +and [] FSharpObjectExprOverride(sgn: FSharpAbstractSignature, gps: FSharpGenericParameter list, args:FSharpMemberOrFunctionOrValue list list, body: FSharpExpr) = + member __.Signature = sgn + member __.GenericParameters = gps + member __.CurriedParameterGroups = args + member __.Body = body + +/// The type of expressions provided through the compiler API. +and [] FSharpExpr (cenv, f: (unit -> FSharpExpr) option, e: E, m:range, ty) = + + member x.Range = m + member x.Type = FSharpType(cenv, ty) + member x.cenv = cenv + member x.E = match f with None -> e | Some f -> f().E + override x.ToString() = sprintf "%+A" x.E + + member x.ImmediateSubExpressions = + match x.E with + | E.Value _v -> [] + | E.Const (_constValue, _ty) -> [] + | E.TypeLambda (_v, body) -> [body] + | E.Lambda (_v, body) -> [body] + | E.Application (f, _tyargs, arg) -> f :: arg + | E.IfThenElse (e1, e2, e3) -> [e1;e2;e3] + | E.Let ((_bindingVar, bindingExpr), b) -> [bindingExpr;b] + | E.LetRec (ves, b) -> (List.map snd ves) @ [b] + | E.NewRecord (_recordType, es) -> es + | E.NewUnionCase (_unionType, _unionCase, es) -> es + | E.NewTuple (_tupleType, es) -> es + | E.TupleGet (_tupleType, _itemIndex, tupleExpr) -> [tupleExpr] + | E.Call (objOpt, _b, _c, _d, es) -> (match objOpt with None -> es | Some x -> x::es) + | E.NewObject (_a, _b, c) -> c + | E.FSharpFieldGet (objOpt, _b, _c) -> (match objOpt with None -> [] | Some x -> [x]) + | E.FSharpFieldSet (objOpt, _b, _c, d) -> (match objOpt with None -> [d] | Some x -> [x;d]) + | E.UnionCaseGet (obj, _b, _c, _d) -> [obj] + | E.UnionCaseTag (obj, _b) -> [obj] + | E.UnionCaseTest (obj, _b, _c) -> [obj] + | E.NewArray (_ty, elems) -> elems + | E.Coerce (_ty, b) -> [b] + | E.Quote (a) -> [a] + | E.TypeTest (_ty, b) -> [b] + | E.Sequential (a, b) -> [a;b] + | E.FastIntegerForLoop (a, b, c, _dir) -> [a;b;c] + | E.WhileLoop (guard, body) -> [guard; body] + | E.TryFinally (body, b) -> [body; b] + | E.TryWith (body, _b, _c, _d, handler) -> [body; handler] + | E.NewDelegate (_ty, body) -> [body] + | E.DefaultValue (_ty) -> [] + | E.AddressSet (lvalueExpr, rvalueExpr) -> [lvalueExpr; rvalueExpr] + | E.ValueSet (_v, rvalueExpr) -> [rvalueExpr] + | E.AddressOf (lvalueExpr) -> [lvalueExpr] + | E.ThisValue (_ty) -> [] + | E.BaseValue (_ty) -> [] + | E.ILAsm (_code, _tyargs, argExprs) -> argExprs + | E.ILFieldGet (objOpt, _ty, _fieldName) -> (match objOpt with None -> [] | Some x -> [x]) + | E.ILFieldSet (objOpt, _ty, _fieldName, d) -> (match objOpt with None -> [d] | Some x -> [x;d]) + | E.ObjectExpr (_ty, basecall, overrides, interfaceImpls) -> + [ yield basecall; + for m in overrides do yield m.Body + for (_, ms) in interfaceImpls do for m in ms do yield m.Body ] + | E.DecisionTree (inputExpr, targetCases) -> + [ yield inputExpr; + for (_targetVars, targetExpr) in targetCases do yield targetExpr ] + | E.DecisionTreeSuccess (_targetNumber, targetArgs) -> targetArgs + | E.UnionCaseSet (obj, _unionType, _unionCase, _unionField, valueExpr) -> [ yield obj; yield valueExpr ] + | E.TraitCall (_sourceTypes, _traitName, _paramTypes, _retTypes, args) -> args + | E.Unused -> [] // unexpected + + +/// The implementation of the conversion operation +module FSharpExprConvert = + + let IsStaticInitializationField (rfref: RecdFieldRef) = + rfref.RecdField.IsCompilerGenerated && + rfref.RecdField.IsStatic && + rfref.RecdField.IsMutable && + rfref.RecdField.Name.StartsWith "init" + + // Match "if [AI_clt](init@41,6) then IntrinsicFunctions.FailStaticInit () else ()" + let (|StaticInitializationCheck|_|) e = + match e with + | Expr.Match (_,_,TDSwitch(Expr.Op(TOp.ILAsm ([ AI_clt ],_),_,[Expr.Op(TOp.ValFieldGet rfref,_,_,_) ;_],_),_,_,_),_,_,_) when IsStaticInitializationField rfref -> Some () + | _ -> None + + // Match "init@41 <- 6" + let (|StaticInitializationCount|_|) e = + match e with + | Expr.Op(TOp.ValFieldSet rfref,_,_,_) when IsStaticInitializationField rfref -> Some () + | _ -> None + + let ConvType cenv typ = FSharpType(cenv, typ) + let ConvTypes cenv typs = List.map (ConvType cenv) typs + let ConvILTypeRefApp (cenv:Impl.cenv) m tref tyargs = + let tcref = Import.ImportILTypeRef cenv.amap m tref + ConvType cenv (mkAppTy tcref tyargs) + + let ConvUnionCaseRef cenv (ucref:UnionCaseRef) = FSharpUnionCase(cenv, ucref) + let ConvRecdFieldRef cenv (rfref:RecdFieldRef) = FSharpField(cenv,rfref ) + + let rec exprOfExprAddr (cenv:Impl.cenv) expr = + match expr with + | Expr.Op(op,tyargs,args,m) -> + match op, args, tyargs with + | TOp.LValueOp(LGetAddr,vref),_,_ -> exprForValRef m vref + | TOp.ValFieldGetAddr(rfref),[],_ -> mkStaticRecdFieldGet(rfref,tyargs,m) + | TOp.ValFieldGetAddr(rfref),[arg],_ -> mkRecdFieldGetViaExprAddr(exprOfExprAddr cenv arg,rfref,tyargs,m) + | TOp.ILAsm([ I_ldflda(fspec) ],rtys),[arg],_ -> mkAsmExpr([ mkNormalLdfld(fspec) ],tyargs, [exprOfExprAddr cenv arg], rtys, m) + | TOp.ILAsm([ I_ldsflda(fspec) ],rtys),_,_ -> mkAsmExpr([ mkNormalLdsfld(fspec) ],tyargs, args, rtys, m) + | TOp.ILAsm(([ I_ldelema(_ro,_isNativePtr,shape,_tyarg) ] ),_), (arr::idxs), [elemty] -> + match shape.Rank, idxs with + | 1, [idx1] -> mkCallArrayGet cenv.g m elemty arr idx1 + | 2, [idx1; idx2] -> mkCallArray2DGet cenv.g m elemty arr idx1 idx2 + | 3, [idx1; idx2; idx3] -> mkCallArray3DGet cenv.g m elemty arr idx1 idx2 idx3 + | 4, [idx1; idx2; idx3; idx4] -> mkCallArray4DGet cenv.g m elemty arr idx1 idx2 idx3 idx4 + | _ -> expr + | _ -> expr + | _ -> expr + + + let Mk cenv m ty e = FSharpExpr(cenv, None, e, m, ty) + + let Mk2 cenv (orig:Expr) e = FSharpExpr(cenv, None, e, orig.Range, tyOfExpr cenv.g orig) + + let rec ConvLValueExpr (cenv:Impl.cenv) env expr = ConvExpr cenv env (exprOfExprAddr cenv expr) + + and ConvExpr cenv env expr = + Mk2 cenv expr (ConvExprPrim cenv env expr) + + and ConvExprLinear cenv env expr contf = + ConvExprPrimLinear cenv env expr (fun exprR -> contf (Mk2 cenv expr exprR)) + + // Tail recursive function to process the subset of expressions considered "linear" + and ConvExprPrimLinear cenv env expr contf = + + match expr with + // Large lists + | Expr.Op(TOp.UnionCase ucref,tyargs,[e1;e2],_) -> + let mkR = ConvUnionCaseRef cenv ucref + let typR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) + let e1R = ConvExpr cenv env e1 + // tail recursive + ConvExprLinear cenv env e2 (contf << (fun e2R -> E.NewUnionCase(typR, mkR, [e1R; e2R]) )) + + // Large sequences of let bindings + | Expr.Let (bind,body,_,_) -> + match ConvLetBind cenv env bind with + | None, env -> ConvExprPrimLinear cenv env body contf + | Some(bindR),env -> + // tail recursive + ConvExprLinear cenv env body (contf << (fun bodyR -> E.Let(bindR,bodyR))) + + // Remove initialization checks + // Remove static initialization counter updates + // Remove static initialization counter checks + // + // Put in ConvExprPrimLinear because of the overlap with Expr.Sequential below + // + // TODO: allow clients to see static initialization checks if they want to + | Expr.Sequential(ObjectInitializationCheck cenv.g, x1, NormalSeq, _, _) + | Expr.Sequential (StaticInitializationCount,x1,NormalSeq,_,_) + | Expr.Sequential (StaticInitializationCheck,x1,NormalSeq,_,_) -> + ConvExprPrim cenv env x1 |> contf + + // Large sequences of sequential code + | Expr.Sequential (e1,e2,NormalSeq,_,_) -> + let e1R = ConvExpr cenv env e1 + // tail recursive + ConvExprLinear cenv env e2 (contf << (fun e2R -> E.Sequential(e1R, e2R))) + + | Expr.Sequential (x0,x1,ThenDoSeq,_,_) -> E.Sequential(ConvExpr cenv env x0, ConvExpr cenv env x1) + + | ModuleValueOrMemberUse cenv.g (vref,vFlags,_f,_fty,tyargs,curriedArgs) when (nonNil tyargs || nonNil curriedArgs) && vref.IsMemberOrModuleBinding -> + ConvModuleValueOrMemberUseLinear cenv env (expr,vref,vFlags,tyargs,curriedArgs) contf + + | Expr.Match (_spBind,m,dtree,tgs,_,retTy) -> + let dtreeR = ConvDecisionTree cenv env retTy dtree m + // tailcall + ConvTargetsLinear cenv env (List.ofArray tgs) (contf << fun (targetsR: _ list) -> + let (|E|) (x:FSharpExpr) = x.E + + // If the match is really an "if-then-else" then return it as such. + match dtreeR with + | E(E.IfThenElse(a,E(E.DecisionTreeSuccess(0,[])), E(E.DecisionTreeSuccess(1,[])))) -> E.IfThenElse(a,snd targetsR.[0],snd targetsR.[1]) + | _ -> E.DecisionTree(dtreeR,targetsR)) + + | _ -> + ConvExprPrim cenv env expr |> contf + + + /// A nasty function copied from creflect.fs. Made nastier by taking a continuation to process the + /// arguments to the call in a tail-recursive fashion. + and ConvModuleValueOrMemberUseLinear (cenv:Impl.cenv) env (expr:Expr,vref,vFlags,tyargs,curriedArgs) contf = + let m = expr.Range + + let (numEnclTypeArgs,_,isNewObj,_valUseFlags,_isSelfInit,takesInstanceArg,_isPropGet,_isPropSet) = + GetMemberCallInfo cenv.g (vref,vFlags) + + let isMember,curriedArgInfos = + + match vref.MemberInfo with + | Some _ when not vref.IsExtensionMember -> + // This is an application of a member method + // We only count one argument block for these. + let _tps,curriedArgInfos,_,_ = GetTypeOfMemberInFSharpForm cenv.g vref + true,curriedArgInfos + | _ -> + // This is an application of a module value or extension member + let arities = arityOfVal vref.Deref + let _tps,curriedArgInfos,_,_ = GetTopValTypeInFSharpForm cenv.g arities vref.Type m + false,curriedArgInfos + + // Compute the object arguments as they appear in a compiled call + // Strip off the object argument, if any. The curriedArgInfos are already adjusted to compiled member form + let objArgs,curriedArgs = + match takesInstanceArg,curriedArgs with + | false,curriedArgs -> [],curriedArgs + | true,(objArg::curriedArgs) -> [objArg],curriedArgs + | true,[] -> failwith ("warning: unexpected missing object argument when generating quotation for call to F# object member "+vref.LogicalName) + + // Check to see if there aren't enough arguments or if there is a tuple-arity mismatch + // If so, adjust and try again + if curriedArgs.Length < curriedArgInfos.Length || + ((List.take curriedArgInfos.Length curriedArgs,curriedArgInfos) ||> List.exists2 (fun arg argInfo -> (argInfo.Length > (tryDestTuple arg).Length))) then + + // Too few arguments or incorrect tupling? Convert to a lambda and beta-reduce the + // partially applied arguments to 'let' bindings + let topValInfo = + match vref.ValReprInfo with + | None -> failwith ("no arity information found for F# value "+vref.LogicalName) + | Some a -> a + + let expr,exprty = AdjustValForExpectedArity cenv.g m vref vFlags topValInfo + let splitCallExpr = MakeApplicationAndBetaReduce cenv.g (expr,exprty,[tyargs],curriedArgs,m) + // tailcall + ConvExprPrimLinear cenv env splitCallExpr contf + + else + let curriedArgs,laterArgs = List.chop curriedArgInfos.Length curriedArgs + + // detuple the args + let untupledCurriedArgs = + (curriedArgs,curriedArgInfos) ||> List.map2 (fun arg curriedArgInfo -> + let numUntupledArgs = curriedArgInfo.Length + (if numUntupledArgs = 0 then [] + elif numUntupledArgs = 1 then [arg] + else tryDestTuple arg)) + + let contf2 = + match laterArgs with + | [] -> contf + | _ -> (fun subCallR -> (subCallR, laterArgs) ||> List.fold (fun fR arg -> E.Application (Mk2 cenv arg fR,[],[ConvExpr cenv env arg])) |> contf) + + if isMember then + let callArgs = (objArgs::untupledCurriedArgs) |> List.concat + let enclTyArgs, methTyArgs = List.splitAfter numEnclTypeArgs tyargs + // tailcall + ConvObjectModelCallLinear cenv env (isNewObj, FSharpMemberOrFunctionOrValue(cenv,vref), enclTyArgs, methTyArgs, callArgs) contf2 + else + let v = FSharpMemberOrFunctionOrValue(cenv, vref) + // tailcall + ConvObjectModelCallLinear cenv env (false, v, [], tyargs, List.concat untupledCurriedArgs) contf2 + + and ConvExprPrim (cenv:Impl.cenv) (env:ExprTranslationEnv) expr = + // Eliminate integer 'for' loops + let expr = DetectAndOptimizeForExpression cenv.g OptimizeIntRangesOnly expr + + // Eliminate subsumption coercions for functions. This must be done post-typechecking because we need + // complete inference types. + let expr = NormalizeAndAdjustPossibleSubsumptionExprs cenv.g expr + + // Remove TExpr_ref nodes + let expr = stripExpr expr + + match expr with + + // Uses of possibly-polymorphic values which were not polymorphic in the end + | Expr.App(InnerExprPat(Expr.Val _ as ve),_fty,[],[],_) -> + ConvExprPrim cenv env ve + + // These cases are the start of a "linear" sequence where we use tail recursion to allow use to + // deal with large expressions. + | Expr.Op(TOp.UnionCase _,_,[_;_],_) // big lists + | Expr.Let _ // big linear sequences of 'let' + | Expr.Match _ // big linear sequences of 'match ... -> ....' + | Expr.Sequential _ -> + ConvExprPrimLinear cenv env expr (fun e -> e) + + | ModuleValueOrMemberUse cenv.g (vref,vFlags,_f,_fty,tyargs,curriedArgs) when (* (nonNil tyargs || nonNil curriedArgs) && *) vref.IsMemberOrModuleBinding -> + // Process applications of top-level values in a tail-recursive way + ConvModuleValueOrMemberUseLinear cenv env (expr,vref,vFlags,tyargs,curriedArgs) (fun e -> e) + + | Expr.Val(vref,_vFlags,m) -> + ConvValRef cenv env m vref + + // Simple applications + | Expr.App(f,_fty,tyargs,args,_m) -> + E.Application (ConvExpr cenv env f, ConvTypes cenv tyargs, ConvExprs cenv env args) + + | Expr.Const(c,m,ty) -> + ConvConst cenv env m c ty + + | Expr.LetRec(binds,body,_,_) -> + let vs = valsOfBinds binds + let vsR = vs |> FlatList.map (ConvVal cenv) + let env = env.BindVals vs + let bodyR = ConvExpr cenv env body + let bindsR = FlatList.zip vsR (binds |> FlatList.map (fun b -> b.Expr |> ConvExpr cenv env)) + E.LetRec(FlatList.toList bindsR,bodyR) + + | Expr.Lambda(_,_,_,vs,b,_,_) -> + let v,b = MultiLambdaToTupledLambda vs b + let vR = ConvVal cenv v + let bR = ConvExpr cenv (env.BindVal v) b + E.Lambda(vR, bR) + + | Expr.Quote(ast,_,_,_,_) -> + E.Quote(ConvExpr cenv env ast) + + | Expr.TyLambda (_,tps,b,_,_) -> + let gps = [ for tp in tps -> FSharpGenericParameter(cenv,tp) ] + let env = env.BindTypars (Seq.zip tps gps |> Seq.toList) + E.TypeLambda(gps, ConvExpr cenv env b) + + | Expr.Obj (_,typ,_,_,[TObjExprMethod(TSlotSig(_,ctyp, _,_,_,_),_,tps,[tmvs],e,_) as tmethod],_,m) when isDelegateTy cenv.g typ -> + let f = mkLambdas m tps tmvs (e,GetFSharpViewOfReturnType cenv.g (returnTyOfMethod cenv.g tmethod)) + let fR = ConvExpr cenv env f + let tyargR = ConvType cenv ctyp + E.NewDelegate(tyargR, fR) + + | Expr.StaticOptimization (_,_,x,_) -> + ConvExprPrim cenv env x + + | Expr.TyChoose _ -> + ConvExprPrim cenv env (ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) + + | Expr.Obj (_lambdaId,typ,_basev,basecall,overrides, iimpls,_m) -> + let basecallR = ConvExpr cenv env basecall + let ConvertMethods methods = + [ for (TObjExprMethod(slotsig,_,tps,tmvs,body,_)) in methods -> + let vslR = List.map (List.map (ConvVal cenv)) tmvs + let sgn = FSharpAbstractSignature(cenv, slotsig) + let tpsR = [ for tp in tps -> FSharpGenericParameter(cenv,tp) ] + let env = ExprTranslationEnv.Empty.BindTypars (Seq.zip tps tpsR |> Seq.toList) + let env = env.BindCurriedVals tmvs + let bodyR = ConvExpr cenv env body + FSharpObjectExprOverride(sgn, tpsR, vslR, bodyR) ] + let overridesR = ConvertMethods overrides + let iimplsR = List.map (fun (ty,impls) -> ConvType cenv ty, ConvertMethods impls) iimpls + + E.ObjectExpr(ConvType cenv typ, basecallR, overridesR, iimplsR) + + | Expr.Op(op,tyargs,args,m) -> + match op,tyargs,args with + | TOp.UnionCase ucref,_,_ -> + let mkR = ConvUnionCaseRef cenv ucref + let typR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) + let argsR = ConvExprs cenv env args + E.NewUnionCase(typR, mkR, argsR) + + | TOp.Tuple,tyargs,_ -> + let tyR = ConvType cenv (mkTupledTy cenv.g tyargs) + let argsR = ConvExprs cenv env args + E.NewTuple(tyR, argsR) + + | TOp.Recd (_,tcref),_,_ -> + let typR = ConvType cenv (mkAppTy tcref tyargs) + let argsR = ConvExprs cenv env args + E.NewRecord(typR, argsR) + + | TOp.UnionCaseFieldGet (ucref,n),tyargs,[e1] -> + let mkR = ConvUnionCaseRef cenv ucref + let typR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) + let projR = FSharpField(cenv, ucref, n) + E.UnionCaseGet(ConvExpr cenv env e1, typR, mkR, projR) + + | TOp.UnionCaseFieldSet (ucref,n),tyargs,[e1;e2] -> + let mkR = ConvUnionCaseRef cenv ucref + let typR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) + let projR = FSharpField(cenv, ucref, n) + E.UnionCaseSet(ConvExpr cenv env e1, typR, mkR, projR, ConvExpr cenv env e2) + + | TOp.ValFieldGetAddr(_rfref),_tyargs,_ -> + E.AddressOf(ConvLValueExpr cenv env expr) + + | TOp.ValFieldGet(rfref),tyargs,[] -> + let projR = ConvRecdFieldRef cenv rfref + let typR = ConvType cenv (mkAppTy rfref.TyconRef tyargs) + E.FSharpFieldGet(None, typR, projR) + + | TOp.ValFieldGet(rfref),tyargs,[obj] -> + let objR = ConvLValueExpr cenv env obj + let projR = ConvRecdFieldRef cenv rfref + let typR = ConvType cenv (mkAppTy rfref.TyconRef tyargs) + E.FSharpFieldGet(Some objR, typR, projR) + + | TOp.TupleFieldGet(n),tyargs,[e] -> + let tyR = ConvType cenv (mkTupledTy cenv.g tyargs) + E.TupleGet(tyR, n, ConvExpr cenv env e) + + | TOp.ILAsm([ I_ldfld(_,_,fspec) ],_), enclTypeArgs, [obj] -> + let typR = ConvILTypeRefApp cenv m fspec.EnclosingTypeRef enclTypeArgs + let objR = ConvLValueExpr cenv env obj + E.ILFieldGet(Some objR, typR, fspec.Name) + + | TOp.ILAsm(( [ I_ldsfld (_,fspec) ] | [ I_ldsfld (_,fspec); AI_nop ]),_),enclTypeArgs,[] -> + let typR = ConvILTypeRefApp cenv m fspec.EnclosingTypeRef enclTypeArgs + E.ILFieldGet(None, typR, fspec.Name) + + | TOp.ILAsm([ I_stfld(_,_,fspec) ],_),enclTypeArgs,[obj;arg] -> + let typR = ConvILTypeRefApp cenv m fspec.EnclosingTypeRef enclTypeArgs + let objR = ConvLValueExpr cenv env obj + let argR = ConvExpr cenv env arg + E.ILFieldSet(Some objR, typR, fspec.Name, argR) + + | TOp.ILAsm([ I_stsfld(_,fspec) ],_),enclTypeArgs,[arg] -> + let typR = ConvILTypeRefApp cenv m fspec.EnclosingTypeRef enclTypeArgs + let argR = ConvExpr cenv env arg + E.ILFieldSet(None, typR, fspec.Name, argR) + + + | TOp.ILAsm([ AI_ceq ],_),_,[arg1;arg2] -> + let ty = tyOfExpr cenv.g arg1 + let eq = mkCallEqualsOperator cenv.g m ty arg1 arg2 + ConvExprPrim cenv env eq + + | TOp.ILAsm([ I_throw ],_),_,[arg1] -> + let raiseExpr = mkCallRaise cenv.g m (tyOfExpr cenv.g expr) arg1 + ConvExprPrim cenv env raiseExpr + + | TOp.ILAsm(il,_),tyargs,args -> + E.ILAsm(sprintf "%+A" il, ConvTypes cenv tyargs, ConvExprs cenv env args) + + | TOp.ExnConstr tcref,tyargs,args -> + E.NewRecord(ConvType cenv (mkAppTy tcref tyargs), ConvExprs cenv env args) + + | TOp.ValFieldSet rfref, _tinst,[obj;arg] -> + let objR = ConvLValueExpr cenv env obj + let argR = ConvExpr cenv env arg + let typR = ConvType cenv (mkAppTy rfref.TyconRef tyargs) + let projR = ConvRecdFieldRef cenv rfref + E.FSharpFieldSet(Some objR, typR, projR, argR) + + | TOp.ValFieldSet rfref, _tinst,[arg] -> + let argR = ConvExpr cenv env arg + let typR = ConvType cenv (mkAppTy rfref.TyconRef tyargs) + let projR = ConvRecdFieldRef cenv rfref + E.FSharpFieldSet(None, typR, projR, argR) + + | TOp.ExnFieldGet(tcref,i),[],[obj] -> + let exnc = stripExnEqns tcref + let fspec = exnc.TrueInstanceFieldsAsList.[i] + let fref = mkRecdFieldRef tcref fspec.Name + let typR = ConvType cenv (mkAppTy tcref tyargs) + let objR = ConvExpr cenv env (mkCoerceExpr (obj, mkAppTy tcref [], m, cenv.g.exn_ty)) + E.FSharpFieldGet(Some objR, typR, ConvRecdFieldRef cenv fref) + + | TOp.ExnFieldSet(tcref,i),[],[obj;e2] -> + let exnc = stripExnEqns tcref + let fspec = exnc.TrueInstanceFieldsAsList.[i] + let fref = mkRecdFieldRef tcref fspec.Name + let typR = ConvType cenv (mkAppTy tcref tyargs) + let objR = ConvExpr cenv env (mkCoerceExpr (obj, mkAppTy tcref [], m, cenv.g.exn_ty)) + E.FSharpFieldSet(Some objR, typR, ConvRecdFieldRef cenv fref, ConvExpr cenv env e2) + + | TOp.Coerce,[tgtTy;srcTy],[x] -> + if typeEquiv cenv.g tgtTy srcTy then + ConvExprPrim cenv env x + else + E.Coerce(ConvType cenv tgtTy,ConvExpr cenv env x) + + | TOp.Reraise,[toTy],[] -> + // rebuild reraise() and Convert + mkReraiseLibCall cenv.g toTy m |> ConvExprPrim cenv env + + | TOp.LValueOp(LGetAddr,vref),[],[] -> + E.AddressOf(ConvExpr cenv env (exprForValRef m vref)) + + | TOp.LValueOp(LByrefSet,vref),[],[e] -> + E.AddressSet(ConvExpr cenv env (exprForValRef m vref), ConvExpr cenv env e) + + | TOp.LValueOp(LSet,vref),[],[e] -> + E.ValueSet(FSharpMemberOrFunctionOrValue(cenv, vref), ConvExpr cenv env e) + + | TOp.LValueOp(LByrefGet,vref),[],[] -> + ConvValRef cenv env m vref + + | TOp.Array,[ty],xa -> + E.NewArray(ConvType cenv ty,ConvExprs cenv env xa) + + | TOp.While _,[],[Expr.Lambda(_,_,_,[_],test,_,_);Expr.Lambda(_,_,_,[_],body,_,_)] -> + E.WhileLoop(ConvExpr cenv env test, ConvExpr cenv env body) + + | TOp.For(_, (FSharpForLoopUp |FSharpForLoopDown as dir) ), [], [Expr.Lambda(_,_,_,[_], lim0,_,_); Expr.Lambda(_,_,_,[_], SimpleArrayLoopUpperBound, lm,_); SimpleArrayLoopBody cenv.g (arr, elemTy, body)] -> + let lim1 = + let len = mkCallArrayLength cenv.g lm elemTy arr // Array.length arr + mkCallSubtractionOperator cenv.g lm cenv.g.int32_ty len (Expr.Const(Const.Int32 1, m, cenv.g.int32_ty)) // len - 1 + E.FastIntegerForLoop(ConvExpr cenv env lim0, ConvExpr cenv env lim1, ConvExpr cenv env body, (dir = FSharpForLoopUp)) + + | TOp.For(_,dir),[],[Expr.Lambda(_,_,_,[_],lim0,_,_);Expr.Lambda(_,_,_,[_],lim1,_,_);body] -> + match dir with + | FSharpForLoopUp -> E.FastIntegerForLoop(ConvExpr cenv env lim0,ConvExpr cenv env lim1, ConvExpr cenv env body,true) + | FSharpForLoopDown -> E.FastIntegerForLoop(ConvExpr cenv env lim0,ConvExpr cenv env lim1, ConvExpr cenv env body,false) + | _ -> failwith "unexpected for-loop form" + + | TOp.ILCall(_,_,_,isNewObj,_valUseFlags,_isProp,_,ilMethRef,enclTypeArgs,methTypeArgs,_tys),[],callArgs -> + let v = bindILMethodRefToSymbol cenv m ilMethRef + ConvObjectModelCallLinear cenv env (isNewObj, v, enclTypeArgs, methTypeArgs, callArgs) (fun e -> e) + + | TOp.TryFinally _,[_resty],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],e2,_,_)] -> + E.TryFinally(ConvExpr cenv env e1,ConvExpr cenv env e2) + + | TOp.TryCatch _,[_resty],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[vf],ef,_,_); Expr.Lambda(_,_,_,[vh],eh,_,_)] -> + let vfR = ConvVal cenv vf + let envf = env.BindVal vf + let vhR = ConvVal cenv vh + let envh = env.BindVal vh + E.TryWith(ConvExpr cenv env e1,vfR,ConvExpr cenv envf ef,vhR,ConvExpr cenv envh eh) + + | TOp.Bytes bytes,[],[] -> E.Const(box bytes, ConvType cenv (tyOfExpr cenv.g expr)) + + | TOp.UInt16s arr,[],[] -> E.Const(box arr, ConvType cenv (tyOfExpr cenv.g expr)) + + | TOp.UnionCaseProof _,_,[e] -> ConvExprPrim cenv env e // Note: we erase the union case proof conversions when converting to quotations + | TOp.UnionCaseTagGet tycr,tyargs,[arg1] -> + let typR = ConvType cenv (mkAppTy tycr tyargs) + E.UnionCaseTag(ConvExpr cenv env arg1, typR) + + | TOp.TraitCall (TTrait(tys,nm,_memFlags,argtys,_rty,_colution)),_,_ -> + let tysR = ConvTypes cenv tys + let tyargsR = ConvTypes cenv tyargs + let argtysR = ConvTypes cenv argtys + let argsR = ConvExprs cenv env args + E.TraitCall(tysR, nm, argtysR, tyargsR, argsR) + + | TOp.RefAddrGet,[ty],[e] -> + let replExpr = mkRecdFieldGetAddrViaExprAddr(e, mkRefCellContentsRef cenv.g, [ty],m) + ConvExprPrim cenv env replExpr + + | _ -> wfail (sprintf "unhandled construct in AST", m) + | _ -> + wfail (sprintf "unhandled construct in AST", expr.Range) + + + and ConvLetBind cenv env (bind : Binding) = + match bind.Expr with + // Map for values bound by the + // 'let v = isinst e in .... if nonnull v then ...v .... ' + // construct arising out the compilation of pattern matching. We decode these back to the form + // 'if istype e then ...unbox e .... ' + // It's bit annoying that pattern matching does this tranformation. Like all premature optimization we pay a + // cost here to undo it. + | Expr.Op(TOp.ILAsm([ I_isinst _ ],_),[ty],[e],_) -> + None, env.BindIsInstVal bind.Var (ty,e) + + // Remove let = from quotation tree + | Expr.Val _ when bind.Var.IsCompilerGenerated -> + None, env.BindSubstVal bind.Var bind.Expr + + // Remove let = () from quotation tree + | Expr.Const(Const.Unit,_,_) when bind.Var.IsCompilerGenerated -> + None, env.BindSubstVal bind.Var bind.Expr + + // Remove let unionCase = ... from quotation tree + | Expr.Op(TOp.UnionCaseProof _,_,[e],_) -> + None, env.BindSubstVal bind.Var e + + | _ -> + let v = bind.Var + let vR = ConvVal cenv v + let rhsR = ConvExpr cenv env bind.Expr + let envinner = env.BindVal v + Some(vR,rhsR),envinner + + and ConvObjectModelCallLinear cenv env (isNewObj, v:FSharpMemberOrFunctionOrValue, enclTyArgs, methTyArgs,callArgs) contf = + let enclTyArgsR = ConvTypes cenv enclTyArgs + let methTyArgsR = ConvTypes cenv methTyArgs + let obj, callArgs = + if v.IsInstanceMember then + match callArgs with + | obj :: rest -> Some obj, rest + | _ -> failwith (sprintf "unexpected shape of arguments: %A" callArgs) + else + None, callArgs + let objR = Option.map (ConvLValueExpr cenv env) obj + // tailcall + ConvExprsLinear cenv env callArgs (contf << fun callArgsR -> + if isNewObj then + E.NewObject(v, enclTyArgsR, callArgsR) + else + E.Call(objR, v, enclTyArgsR, methTyArgsR, callArgsR)) + + + and ConvExprs cenv env args = List.map (ConvExpr cenv env) args + + // Process a list of expressions in a tail-recursive way. Identical to "ConvExprs" but the result is eventually passed to contf. + and ConvExprsLinear cenv env args contf = + match args with + | [] -> contf [] + | [arg] -> ConvExprLinear cenv env arg (fun argR -> contf [argR]) + | arg::rest -> ConvExprLinear cenv env arg (fun argR -> ConvExprsLinear cenv env rest (fun restR -> contf (argR :: restR))) + + and ConvTargetsLinear cenv env tgs contf = + match tgs with + | [] -> contf [] + | TTarget(vars,rhs,_)::rest -> + let varsR = (List.rev vars) |> List.map (ConvVal cenv) + ConvExprLinear cenv env rhs (fun targetR -> + ConvTargetsLinear cenv env rest (fun restR -> + contf ((varsR, targetR) :: restR))) + + and ConvValRef cenv env m (vref:ValRef) = + let v = vref.Deref + if env.isinstVals.ContainsVal v then + let (ty,e) = env.isinstVals.[v] + ConvExprPrim cenv env (mkCallUnbox cenv.g m ty e) + elif env.substVals.ContainsVal v then + let e = env.substVals.[v] + ConvExprPrim cenv env e + elif v.BaseOrThisInfo = CtorThisVal then + E.ThisValue(ConvType cenv v.Type) + elif v.BaseOrThisInfo = BaseVal then + E.BaseValue(ConvType cenv v.Type) + else + E.Value(FSharpMemberOrFunctionOrValue(cenv, vref)) + + and ConvVal cenv (v:Val) = + let vref = mkLocalValRef v + FSharpMemberOrFunctionOrValue(cenv, vref) + + and ConvConst cenv env m c ty = + match TryEliminateDesugaredConstants cenv.g m c with + | Some e -> ConvExprPrim cenv env e + | None -> + let tyR = ConvType cenv ty + match c with + | Const.Bool i -> E.Const(box i, tyR) + | Const.SByte i -> E.Const(box i, tyR) + | Const.Byte i -> E.Const(box i, tyR) + | Const.Int16 i -> E.Const(box i, tyR) + | Const.UInt16 i -> E.Const(box i, tyR) + | Const.Int32 i -> E.Const(box i, tyR) + | Const.UInt32 i -> E.Const(box i, tyR) + | Const.Int64 i -> E.Const(box i, tyR) + | Const.IntPtr i -> E.Const(box (nativeint i), tyR) + | Const.UInt64 i -> E.Const(box i, tyR) + | Const.UIntPtr i -> E.Const(box (unativeint i), tyR) + | Const.Double i -> E.Const(box i, tyR) + | Const.Single i -> E.Const(box i, tyR) + | Const.String i -> E.Const(box i, tyR) + | Const.Char i -> E.Const(box i, tyR) + | Const.Unit -> E.Const(box (), tyR) + | Const.Zero -> E.DefaultValue (ConvType cenv ty) + | _ -> + wfail("FSharp.Compiler.Service cannot yet return this kind of constant", m) + + and ConvDecisionTree cenv env dtreeRetTy x m = + ConvDecisionTreePrim cenv env dtreeRetTy x |> Mk cenv m dtreeRetTy + + and ConvDecisionTreePrim cenv env dtreeRetTy x = + match x with + | TDSwitch(e1,csl,dfltOpt,m) -> + let acc = + match dfltOpt with + | Some d -> ConvDecisionTreePrim cenv env dtreeRetTy d + | None -> wfail( "FSharp.Compiler.Service cannot yet return this kind of pattern match", m) + (csl,acc) ||> List.foldBack (fun (TCase(discrim,dtree)) acc -> + let acc = acc |> Mk cenv m dtreeRetTy + match discrim with + | Test.UnionCase (ucref, tyargs) -> + let objR = ConvExpr cenv env e1 + let ucR = ConvUnionCaseRef cenv ucref + let utypR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) + E.IfThenElse (E.UnionCaseTest (objR, utypR, ucR) |> Mk cenv m cenv.g.bool_ty, ConvDecisionTree cenv env dtreeRetTy dtree m, acc) + | Test.Const (Const.Bool true) -> + let e1R = ConvExpr cenv env e1 + E.IfThenElse (e1R, ConvDecisionTree cenv env dtreeRetTy dtree m, acc) + | Test.Const (Const.Bool false) -> + let e1R = ConvExpr cenv env e1 + // Note, reverse the branches + E.IfThenElse (e1R, acc, ConvDecisionTree cenv env dtreeRetTy dtree m) + | Test.Const c -> + let ty = tyOfExpr cenv.g e1 + let eq = mkCallEqualsOperator cenv.g m ty e1 (Expr.Const (c, m, ty)) + let eqR = ConvExpr cenv env eq + E.IfThenElse (eqR, ConvDecisionTree cenv env dtreeRetTy dtree m, acc) + | Test.IsNull -> + // Decompile cached isinst tests + match e1 with + | Expr.Val(vref,_,_) when env.isinstVals.ContainsVal vref.Deref -> + let (ty,e) = env.isinstVals.[vref.Deref] + let tyR = ConvType cenv ty + let eR = ConvExpr cenv env e + // note: reverse the branches - a null test is a failure of an isinst test + E.IfThenElse (E.TypeTest (tyR,eR) |> Mk cenv m cenv.g.bool_ty, acc, ConvDecisionTree cenv env dtreeRetTy dtree m) + | _ -> + let ty = tyOfExpr cenv.g e1 + let eq = mkCallEqualsOperator cenv.g m ty e1 (Expr.Const (Const.Zero, m, ty)) + let eqR = ConvExpr cenv env eq + E.IfThenElse (eqR, ConvDecisionTree cenv env dtreeRetTy dtree m, acc) + | Test.IsInst (_srcty, tgty) -> + let e1R = ConvExpr cenv env e1 + E.IfThenElse (E.TypeTest (ConvType cenv tgty, e1R) |> Mk cenv m cenv.g.bool_ty, ConvDecisionTree cenv env dtreeRetTy dtree m, acc) + | Test.ActivePatternCase _ -> wfail("unexpected Test.ActivePatternCase test in quoted expression",m) + | Test.ArrayLength _ -> wfail("FSharp.Compiler.Service cannot yet return array pattern matching", m)) + + | TDSuccess (args,n) -> + // TAST stores pattern bindings in reverse order for some reason + // Reverse them here to give a good presentation to the user + let args = List.rev (FlatList.toList args) + let argsR = ConvExprs cenv env args + E.DecisionTreeSuccess(n, argsR) + + | TDBind(bind,rest) -> + // The binding may be a compiler-generated binding that gets removed in the quotation presentation + match ConvLetBind cenv env bind with + | None, env -> ConvDecisionTreePrim cenv env dtreeRetTy rest + | Some(bindR),env -> E.Let(bindR,ConvDecisionTree cenv env dtreeRetTy rest bind.Var.Range) + + /// Wrap the conversion in a function to make it on-demand. Any pattern matching on the FSharpExpr will + /// force the evaluation of the entire conversion process eagerly. + let ConvExprOnDemand cenv env expr = + FSharpExpr(cenv, Some(fun () -> ConvExpr cenv env expr), E.Unused, expr.Range, tyOfExpr cenv.g expr) + + + +/// The contents of the F# assembly as provided through the compiler API +type FSharpAssemblyContents(cenv: Impl.cenv, mimpls: TypedImplFile list) = + + new (g, thisCcu, tcImports, mimpls) = FSharpAssemblyContents(Impl.cenv(g,thisCcu,tcImports), mimpls) + + member __.ImplementationFiles = + [ for mimpl in mimpls -> FSharpImplementationFileContents(cenv, mimpl)] + +and FSharpImplementationFileDeclaration = + | Entity of FSharpEntity * FSharpImplementationFileDeclaration list + | MemberOrFunctionOrValue of FSharpMemberOrFunctionOrValue * FSharpMemberOrFunctionOrValue list list * FSharpExpr + | InitAction of FSharpExpr + +and FSharpImplementationFileContents(cenv, mimpl) = + let (TImplFile(qname,_pragmas,ModuleOrNamespaceExprWithSig(_mty,mdef,_),hasExplicitEntryPoint,isScript)) = mimpl + let rec getDecls2 (ModuleOrNamespaceExprWithSig(_mty,def,_m)) = getDecls def + and getBind (bind: Binding) = + let v = bind.Var + assert v.IsCompiledAsTopLevel + let topValInfo = InferArityOfExprBinding cenv.g v bind.Expr + let tps,_ctorThisValOpt,_baseValOpt,vsl,body,_bodyty = IteratedAdjustArityOfLambda cenv.g cenv.amap topValInfo bind.Expr + let v = FSharpMemberOrFunctionOrValue(cenv, mkLocalValRef v) + let gps = v.GenericParameters + let vslR = List.map (List.map (FSharpExprConvert.ConvVal cenv)) vsl + let env = ExprTranslationEnv.Empty.BindTypars (Seq.zip tps gps |> Seq.toList) + let env = env.BindCurriedVals vsl + let e = FSharpExprConvert.ConvExprOnDemand cenv env body + FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(v, vslR, e) + + and getDecls mdef = + match mdef with + | TMDefRec(tycons,binds,mbinds,_m) -> + [ for tycon in tycons do + let entity = FSharpEntity(cenv, mkLocalEntityRef tycon) + yield FSharpImplementationFileDeclaration.Entity(entity, []) + for bind in binds do + yield getBind bind + for (ModuleOrNamespaceBinding(mspec, def)) in mbinds do + let entity = FSharpEntity(cenv, mkLocalEntityRef mspec) + yield FSharpImplementationFileDeclaration.Entity (entity, getDecls def) ] + | TMAbstract(mexpr) -> getDecls2 mexpr + | TMDefLet(bind,_m) -> + [ yield getBind bind ] + | TMDefDo(expr,_m) -> + [ let expr = FSharpExprConvert.ConvExprOnDemand cenv ExprTranslationEnv.Empty expr + yield FSharpImplementationFileDeclaration.InitAction(expr) ] + | TMDefs(mdefs) -> + [ for mdef in mdefs do yield! getDecls mdef ] + + member __.QualifiedName = qname.Text + member __.FileName = qname.Range.FileName + member __.Declarations = getDecls mdef + member __.HasExplicitEntryPoint = hasExplicitEntryPoint + member __.IsScript = isScript + + +module BasicPatterns = + let (|Value|_|) (e:FSharpExpr) = match e.E with E.Value (v) -> Some (v) | _ -> None + let (|Const|_|) (e:FSharpExpr) = match e.E with E.Const (v,ty) -> Some (v,ty) | _ -> None + let (|TypeLambda|_|) (e:FSharpExpr) = match e.E with E.TypeLambda (v,e) -> Some (v,e) | _ -> None + let (|Lambda|_|) (e:FSharpExpr) = match e.E with E.Lambda (v,e) -> Some (v,e) | _ -> None + let (|Application|_|) (e:FSharpExpr) = match e.E with E.Application (f,tys,e) -> Some (f,tys,e) | _ -> None + let (|IfThenElse|_|) (e:FSharpExpr) = match e.E with E.IfThenElse (e1,e2,e3) -> Some (e1,e2,e3) | _ -> None + let (|Let|_|) (e:FSharpExpr) = match e.E with E.Let ((v,e),b) -> Some ((v,e),b) | _ -> None + let (|LetRec|_|) (e:FSharpExpr) = match e.E with E.LetRec (ves,b) -> Some (ves,b) | _ -> None + let (|NewRecord|_|) (e:FSharpExpr) = match e.E with E.NewRecord (ty,es) -> Some (ty,es) | _ -> None + let (|NewUnionCase|_|) (e:FSharpExpr) = match e.E with E.NewUnionCase (e,tys,es) -> Some (e,tys,es) | _ -> None + let (|NewTuple|_|) (e:FSharpExpr) = match e.E with E.NewTuple (ty,es) -> Some (ty,es) | _ -> None + let (|TupleGet|_|) (e:FSharpExpr) = match e.E with E.TupleGet (ty,n,es) -> Some (ty,n,es) | _ -> None + let (|Call|_|) (e:FSharpExpr) = match e.E with E.Call (a,b,c,d,e) -> Some (a,b,c,d,e) | _ -> None + let (|NewObject|_|) (e:FSharpExpr) = match e.E with E.NewObject (a,b,c) -> Some (a,b,c) | _ -> None + let (|FSharpFieldGet|_|) (e:FSharpExpr) = match e.E with E.FSharpFieldGet (a,b,c) -> Some (a,b,c) | _ -> None + let (|FSharpFieldSet|_|) (e:FSharpExpr) = match e.E with E.FSharpFieldSet (a,b,c,d) -> Some (a,b,c,d) | _ -> None + let (|UnionCaseGet|_|) (e:FSharpExpr) = match e.E with E.UnionCaseGet (a,b,c,d) -> Some (a,b,c,d) | _ -> None + let (|UnionCaseTag|_|) (e:FSharpExpr) = match e.E with E.UnionCaseTag (a,b) -> Some (a,b) | _ -> None + let (|UnionCaseTest|_|) (e:FSharpExpr) = match e.E with E.UnionCaseTest (a,b,c) -> Some (a,b,c) | _ -> None + let (|NewArray|_|) (e:FSharpExpr) = match e.E with E.NewArray (a,b) -> Some (a,b) | _ -> None + let (|Coerce|_|) (e:FSharpExpr) = match e.E with E.Coerce (a,b) -> Some (a,b) | _ -> None + let (|Quote|_|) (e:FSharpExpr) = match e.E with E.Quote (a) -> Some (a) | _ -> None + let (|TypeTest|_|) (e:FSharpExpr) = match e.E with E.TypeTest (a,b) -> Some (a,b) | _ -> None + let (|Sequential|_|) (e:FSharpExpr) = match e.E with E.Sequential (a,b) -> Some (a,b) | _ -> None + let (|FastIntegerForLoop|_|) (e:FSharpExpr) = match e.E with E.FastIntegerForLoop (a,b,c,d) -> Some (a,b,c,d) | _ -> None + let (|WhileLoop|_|) (e:FSharpExpr) = match e.E with E.WhileLoop (a,b) -> Some (a,b) | _ -> None + let (|TryFinally|_|) (e:FSharpExpr) = match e.E with E.TryFinally (a,b) -> Some (a,b) | _ -> None + let (|TryWith|_|) (e:FSharpExpr) = match e.E with E.TryWith (a,b,c,d,e) -> Some (a,b,c,d,e) | _ -> None + let (|NewDelegate|_|) (e:FSharpExpr) = match e.E with E.NewDelegate (ty,e) -> Some (ty,e) | _ -> None + let (|DefaultValue|_|) (e:FSharpExpr) = match e.E with E.DefaultValue (ty) -> Some (ty) | _ -> None + let (|AddressSet|_|) (e:FSharpExpr) = match e.E with E.AddressSet (a,b) -> Some (a,b) | _ -> None + let (|ValueSet|_|) (e:FSharpExpr) = match e.E with E.ValueSet (a,b) -> Some (a,b) | _ -> None + let (|AddressOf|_|) (e:FSharpExpr) = match e.E with E.AddressOf (a) -> Some (a) | _ -> None + let (|ThisValue|_|) (e:FSharpExpr) = match e.E with E.ThisValue (a) -> Some (a) | _ -> None + let (|BaseValue|_|) (e:FSharpExpr) = match e.E with E.BaseValue (a) -> Some (a) | _ -> None + let (|ILAsm|_|) (e:FSharpExpr) = match e.E with E.ILAsm (a,b,c) -> Some (a,b,c) | _ -> None + let (|ILFieldGet|_|) (e:FSharpExpr) = match e.E with E.ILFieldGet (a,b,c) -> Some (a,b,c) | _ -> None + let (|ILFieldSet|_|) (e:FSharpExpr) = match e.E with E.ILFieldSet (a,b,c,d) -> Some (a,b,c,d) | _ -> None + let (|ObjectExpr|_|) (e:FSharpExpr) = match e.E with E.ObjectExpr (a,b,c,d) -> Some (a,b,c,d) | _ -> None + let (|DecisionTree|_|) (e:FSharpExpr) = match e.E with E.DecisionTree (a,b) -> Some (a,b) | _ -> None + let (|DecisionTreeSuccess|_|) (e:FSharpExpr) = match e.E with E.DecisionTreeSuccess (a,b) -> Some (a,b) | _ -> None + let (|UnionCaseSet|_|) (e:FSharpExpr) = match e.E with E.UnionCaseSet (a,b,c,d,e) -> Some (a,b,c,d,e) | _ -> None + let (|TraitCall|_|) (e:FSharpExpr) = match e.E with E.TraitCall (a,b,c,d,e) -> Some (a,b,c,d,e) | _ -> None + + + diff --git a/src/fsharp/vs/Exprs.fsi b/src/fsharp/vs/Exprs.fsi new file mode 100644 index 00000000000..ee5c493f944 --- /dev/null +++ b/src/fsharp/vs/Exprs.fsi @@ -0,0 +1,209 @@ +// Copyright (c) Microsoft Corpration, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +namespace Microsoft.FSharp.Compiler.SourceCodeServices + +open System.Collections.Generic +open Microsoft.FSharp.Compiler +open Microsoft.FSharp.Compiler.TcGlobals +open Microsoft.FSharp.Compiler.Tast +open Microsoft.FSharp.Compiler.Range +open Microsoft.FSharp.Compiler.CompileOps + + +/// Represents the definitional contents of an assembly, as seen by the F# language +type [] FSharpAssemblyContents = + + internal new : tcGlobals: TcGlobals * thisCcu: CcuThunk * tcImports: TcImports * mimpls: TypedImplFile list -> FSharpAssemblyContents + + /// The contents of the implementation files in the assembly + member ImplementationFiles: FSharpImplementationFileContents list + +/// Represents the definitional contents of a single file or fragment in an assembly, as seen by the F# language +and [] FSharpImplementationFileContents = + + /// The qualified name acts to fully-qualify module specifications and implementations + member QualifiedName: string + + /// Get the system path of the implementation file + member FileName: string + + /// Get the declarations that make up this implementation file + member Declarations : FSharpImplementationFileDeclaration list + + /// Indicates if the implementation file is a script + member IsScript: bool + + /// Indicates if the implementation file has an explicit entry point + member HasExplicitEntryPoint: bool + +/// Represents a declaration in an implementation file, as seen by the F# language +and FSharpImplementationFileDeclaration = + /// Represents the declaration of a type + | Entity of FSharpEntity * FSharpImplementationFileDeclaration list + /// Represents the declaration of a member, function or value, including the parameters and body of the member + | MemberOrFunctionOrValue of FSharpMemberOrFunctionOrValue * FSharpMemberOrFunctionOrValue list list * FSharpExpr + /// Represents the declaration of a static initialization action + | InitAction of FSharpExpr + +/// Represents a checked and reduced expression, as seen by the F# language. The active patterns +/// in 'FSharp.Compiler.SourceCodeServices' can be used to analyze information about the expression. +/// +/// Pattern matching is reduced to decision trees and conditional tests. Some other +/// constructs may be represented in reduced form. +and [] FSharpExpr = + /// The range of the expression + member Range : range + + /// The type of the expression + member Type : FSharpType + + /// The immediate sub-expressions of the expression. + member ImmediateSubExpressions : FSharpExpr list + +/// Represents a checked method in an object expression, as seen by the F# language. +and [] FSharpObjectExprOverride = + /// The signature of the implemented abstract slot + member Signature : FSharpAbstractSignature + /// The generic parameters of the method + member GenericParameters : FSharpGenericParameter list + /// The parameters of the method + member CurriedParameterGroups : FSharpMemberOrFunctionOrValue list list + /// The expression that forms the body of the method + member Body : FSharpExpr + +/// A collection of active patterns to analyze expressions +module BasicPatterns = + + /// Matches expressions which are uses of values + val (|Value|_|) : FSharpExpr -> FSharpMemberOrFunctionOrValue option + + /// Matches expressions which are the application of function values + val (|Application|_|) : FSharpExpr -> (FSharpExpr * FSharpType list * FSharpExpr list) option + + /// Matches expressions which are type abstractions + val (|TypeLambda|_|) : FSharpExpr -> (FSharpGenericParameter list * FSharpExpr) option + + /// Matches expressions with a decision expression, each branch of which ends in DecisionTreeSuccess pasing control and values to one of the targets. + val (|DecisionTree|_|) : FSharpExpr -> (FSharpExpr * (FSharpMemberOrFunctionOrValue list * FSharpExpr) list) option + + /// Special expressions at the end of a conditional decision structure in the decision expression node of a DecisionTree . + /// The given expressions are passed as values to the decision tree target. + val (|DecisionTreeSuccess|_|) : FSharpExpr -> (int * FSharpExpr list) option + + /// Matches expressions which are lambda abstractions + val (|Lambda|_|) : FSharpExpr -> (FSharpMemberOrFunctionOrValue * FSharpExpr) option + + /// Matches expressions which are conditionals + val (|IfThenElse|_|) : FSharpExpr -> (FSharpExpr * FSharpExpr * FSharpExpr) option + + /// Matches expressions which are let definitions + val (|Let|_|) : FSharpExpr -> ((FSharpMemberOrFunctionOrValue * FSharpExpr) * FSharpExpr) option + + /// Matches expressions which are calls to members or module-defined functions. When calling curried functions and members the + /// arguments are collapsed to a single collection of arguments, as done in the compiled version of these. + val (|Call|_|) : FSharpExpr -> (FSharpExpr option * FSharpMemberOrFunctionOrValue * FSharpType list * FSharpType list * FSharpExpr list) option + + /// Matches expressions which are calls to object constructors + val (|NewObject|_|) : FSharpExpr -> (FSharpMemberOrFunctionOrValue * FSharpType list * FSharpExpr list) option + + /// Matches expressions which are uses of the 'this' value + val (|ThisValue|_|) : FSharpExpr -> FSharpType option + + /// Matches expressions which are uses of the 'base' value + val (|BaseValue|_|) : FSharpExpr -> FSharpType option + + /// Matches expressions which are quotation literals + val (|Quote|_|) : FSharpExpr -> FSharpExpr option + + /// Matches expressions which are let-rec definitions + val (|LetRec|_|) : FSharpExpr -> ((FSharpMemberOrFunctionOrValue * FSharpExpr) list * FSharpExpr) option + + /// Matches record expressions + val (|NewRecord|_|) : FSharpExpr -> (FSharpType * FSharpExpr list) option + + /// Matches expressions which get a field from a record or class + val (|FSharpFieldGet|_|) : FSharpExpr -> (FSharpExpr option * FSharpType * FSharpField) option + + /// Matches expressions which set a field in a record or class + val (|FSharpFieldSet|_|) : FSharpExpr -> (FSharpExpr option * FSharpType * FSharpField * FSharpExpr) option + + /// Matches expressions which create an object corresponding to a union case + val (|NewUnionCase|_|) : FSharpExpr -> (FSharpType * FSharpUnionCase * FSharpExpr list) option + + /// Matches expressions which get a field from a union case + val (|UnionCaseGet|_|) : FSharpExpr -> (FSharpExpr * FSharpType * FSharpUnionCase * FSharpField) option + + /// Matches expressions which set a field from a union case (only used in FSharp.Core itself) + val (|UnionCaseSet|_|) : FSharpExpr -> (FSharpExpr * FSharpType * FSharpUnionCase * FSharpField * FSharpExpr) option + + /// Matches expressions which gets the tag for a union case + val (|UnionCaseTag|_|) : FSharpExpr -> (FSharpExpr * FSharpType) option + + /// Matches expressions which test if an expression corresponds to a particular union case + val (|UnionCaseTest|_|) : FSharpExpr -> (FSharpExpr * FSharpType * FSharpUnionCase) option + + /// Matches tuple expressions + val (|NewTuple|_|) : FSharpExpr -> (FSharpType * FSharpExpr list) option + + /// Matches expressions which get a value from a tuple + val (|TupleGet|_|) : FSharpExpr -> (FSharpType * int * FSharpExpr) option + + /// Matches expressions which coerce the type of a value + val (|Coerce|_|) : FSharpExpr -> (FSharpType * FSharpExpr) option + + /// Matches array expressions + val (|NewArray|_|) : FSharpExpr -> (FSharpType * FSharpExpr list) option + + /// Matches expressions which test the runtime type of a value + val (|TypeTest|_|) : FSharpExpr -> (FSharpType * FSharpExpr) option + + /// Matches expressions which set the contents of an address + val (|AddressSet|_|) : FSharpExpr -> (FSharpExpr * FSharpExpr) option + + /// Matches expressions which set the contents of a mutable variable + val (|ValueSet|_|) : FSharpExpr -> (FSharpMemberOrFunctionOrValue * FSharpExpr) option + + /// Matches default-value expressions, including null expressions + val (|DefaultValue|_|) : FSharpExpr -> FSharpType option + + /// Matches constant expressions, including signed and unsigned integers, strings, characters, booleans, arrays + /// of bytes and arrays of unit16. + val (|Const|_|) : FSharpExpr -> (obj * FSharpType) option + + /// Matches expressions which take the address of a location + val (|AddressOf|_|) : FSharpExpr -> FSharpExpr option + + /// Matches sequential expressions + val (|Sequential|_|) : FSharpExpr -> (FSharpExpr * FSharpExpr) option + + /// Matches fast-integer loops (up or down) + val (|FastIntegerForLoop|_|) : FSharpExpr -> (FSharpExpr * FSharpExpr * FSharpExpr * bool) option + + /// Matches while loops + val (|WhileLoop|_|) : FSharpExpr -> (FSharpExpr * FSharpExpr) option + + /// Matches try/finally expressions + val (|TryFinally|_|) : FSharpExpr -> (FSharpExpr * FSharpExpr) option + + /// Matches try/with expressions + val (|TryWith|_|) : FSharpExpr -> (FSharpExpr * FSharpMemberOrFunctionOrValue * FSharpExpr * FSharpMemberOrFunctionOrValue * FSharpExpr) option + + /// Matches expressions which create an instance of a delegate type + val (|NewDelegate|_|) : FSharpExpr -> (FSharpType * FSharpExpr) option + + /// Matches expressions which are IL assembly code + val (|ILAsm|_|) : FSharpExpr -> (string * FSharpType list * FSharpExpr list) option + + /// Matches expressions which fetch a field from a .NET type + val (|ILFieldGet|_|) : FSharpExpr -> (FSharpExpr option * FSharpType * string) option + + /// Matches expressions which set a field in a .NET type + val (|ILFieldSet|_|) : FSharpExpr -> (FSharpExpr option * FSharpType * string * FSharpExpr) option + + /// Matches object expressions, returning the base type, the base call, the overrides and the interface implementations + val (|ObjectExpr|_|) : FSharpExpr -> (FSharpType * FSharpExpr * FSharpObjectExprOverride list * (FSharpType * FSharpObjectExprOverride list) list) option + + /// Matches expressions for an unresolved call to a trait + val (|TraitCall|_|) : FSharpExpr -> (FSharpType list * string * FSharpType list * FSharpType list * FSharpExpr list) option + + diff --git a/src/fsharp/vs/IncrementalBuild.fsi b/src/fsharp/vs/IncrementalBuild.fsi index f78637d67bb..c4b089bbfd0 100755 --- a/src/fsharp/vs/IncrementalBuild.fsi +++ b/src/fsharp/vs/IncrementalBuild.fsi @@ -14,12 +14,12 @@ open Microsoft.FSharp.Compiler.NameResolution [] -type internal FSharpErrorSeverity = +type (*internal*) FSharpErrorSeverity = | Warning | Error [] -type internal FSharpErrorInfo = +type (*internal*) FSharpErrorInfo = member FileName: string member StartLineAlternate:int member EndLineAlternate:int diff --git a/src/fsharp/vs/ServiceNavigation.fsi b/src/fsharp/vs/ServiceNavigation.fsi index bb38167d86a..e760842f4f9 100755 --- a/src/fsharp/vs/ServiceNavigation.fsi +++ b/src/fsharp/vs/ServiceNavigation.fsi @@ -43,7 +43,7 @@ type internal FSharpNavigationTopLevelDeclaration = /// all the members and currently selected indices. First level correspond to /// types & modules and second level are methods etc. [] -type internal FSharpNavigationItems = +type (*internal*) FSharpNavigationItems = member Declarations : FSharpNavigationTopLevelDeclaration[] // implementation details used by other code in the compiler diff --git a/src/fsharp/vs/ServiceParamInfoLocations.fsi b/src/fsharp/vs/ServiceParamInfoLocations.fsi index 2e1b60aeb98..5b10967876d 100755 --- a/src/fsharp/vs/ServiceParamInfoLocations.fsi +++ b/src/fsharp/vs/ServiceParamInfoLocations.fsi @@ -11,7 +11,7 @@ open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Range [] -type internal FSharpNoteworthyParamInfoLocations = +type (*internal*) FSharpNoteworthyParamInfoLocations = member LongId : string list member LongIdStartLocation : pos member LongIdEndLocation : pos diff --git a/src/fsharp/vs/ServiceUntypedParse.fsi b/src/fsharp/vs/ServiceUntypedParse.fsi index 3133f6b5a22..0962c36031a 100755 --- a/src/fsharp/vs/ServiceUntypedParse.fsi +++ b/src/fsharp/vs/ServiceUntypedParse.fsi @@ -14,7 +14,7 @@ open Microsoft.FSharp.Compiler.ErrorLogger [] /// Represents the results of parsing an F# file -type internal FSharpParseFileResults = +type (*internal*) FSharpParseFileResults = /// The syntax tree resulting from the parse member ParseTree : Ast.ParsedInput option diff --git a/src/fsharp/vs/Symbols.fsi b/src/fsharp/vs/Symbols.fsi index 6e9f9400448..0cbbbe906fd 100644 --- a/src/fsharp/vs/Symbols.fsi +++ b/src/fsharp/vs/Symbols.fsi @@ -29,7 +29,7 @@ module internal Impl = /// /// Acquired via GetDisplayEnvAtLocationAlternate and simialr methods. May be passed /// to the Format method on FSharpType and other methods. -type [] internal FSharpDisplayContext = +type [] FSharpDisplayContext = internal new : denv: (TcGlobals -> Tastops.DisplayEnv) -> FSharpDisplayContext static member Empty: FSharpDisplayContext @@ -38,7 +38,7 @@ type [] internal FSharpDisplayContext = /// The subtype of the symbol may reveal further information and can be one of FSharpEntity, FSharpUnionCase /// FSharpField, FSharpGenericParameter, FSharpStaticParameter, FSharpMemberOrFunctionOrValue, FSharpParameter, /// or FSharpActivePatternCase. -type [] internal FSharpSymbol = +type [] FSharpSymbol = /// Internal use only. static member internal Create : g:TcGlobals * thisCcu: CcuThunk * tcImports: TcImports * item:NameResolution.Item -> FSharpSymbol @@ -78,7 +78,7 @@ type [] internal FSharpSymbol = /// Represents an assembly as seen by the F# language -and [] internal FSharpAssembly = +and [] FSharpAssembly = internal new : tcGlobals: TcGlobals * tcImports: TcImports * ccu: CcuThunk -> FSharpAssembly @@ -99,7 +99,7 @@ and [] internal FSharpAssembly = /// Represents an inferred signature of part of an assembly as seen by the F# language -and [] internal FSharpAssemblySignature = +and [] FSharpAssemblySignature = internal new : tcGlobals: TcGlobals * thisCcu: CcuThunk * tcImports: TcImports * topAttribs: TypeChecker.TopAttribs option * contents: ModuleOrNamespaceType -> FSharpAssemblySignature @@ -112,7 +112,7 @@ and [] internal FSharpAssemblySignature = /// A subtype of FSharpSymbol that represents a type definition or module as seen by the F# language -and [] internal FSharpEntity = +and [] FSharpEntity = inherit FSharpSymbol internal new : Impl.cenv * EntityRef -> FSharpEntity @@ -274,7 +274,7 @@ and [] internal FSharpEntity = member RepresentationAccessibility: FSharpAccessibility /// Represents a delegate signature in an F# symbol -and [] internal FSharpDelegateSignature = +and [] FSharpDelegateSignature = /// Get the argument types of the delegate signature member DelegateArguments : IList @@ -282,7 +282,7 @@ and [] internal FSharpDelegateSignature = member DelegateReturnType : FSharpType /// Represents a parameter in an abstract method of a class or interface -and [] internal FSharpAbstractParameter = +and [] FSharpAbstractParameter = /// The optional name of the parameter member Name : string option @@ -303,7 +303,7 @@ and [] internal FSharpAbstractParameter = member Attributes : IList /// Represents the signature of an abstract slot of a class or interface -and [] internal FSharpAbstractSignature = +and [] FSharpAbstractSignature = internal new : Impl.cenv * SlotSig -> FSharpAbstractSignature /// Get the arguments of the abstract slot @@ -325,7 +325,7 @@ and [] internal FSharpAbstractSignature = member DeclaringType : FSharpType /// A subtype of FSharpSymbol that represents a union case as seen by the F# language -and [] internal FSharpUnionCase = +and [] FSharpUnionCase = inherit FSharpSymbol internal new : Impl.cenv * UnionCaseRef -> FSharpUnionCase @@ -361,7 +361,7 @@ and [] internal FSharpUnionCase = /// A subtype of FSharpSymbol that represents a record or union case field as seen by the F# language -and [] internal FSharpField = +and [] FSharpField = inherit FSharpSymbol internal new : Impl.cenv * RecdFieldRef -> FSharpField @@ -419,12 +419,12 @@ and [] internal FSharpField = member IsUnresolved : bool /// Represents the rights of a compilation to access symbols -and [] internal FSharpAccessibilityRights = +and [] FSharpAccessibilityRights = internal new : CcuThunk * Infos.AccessorDomain -> FSharpAccessibilityRights member internal Contents : Infos.AccessorDomain /// Indicates the accessibility of a symbol, as seen by the F# language -and [] internal FSharpAccessibility = +and [] FSharpAccessibility = /// Indicates the symbol has public accessibility member IsPublic : bool @@ -435,7 +435,7 @@ and [] internal FSharpAccessibility = member IsInternal : bool /// A subtype of FSharpSymbol that represents a generic parameter for an FSharpSymbol -and [] internal FSharpGenericParameter = +and [] FSharpGenericParameter = inherit FSharpSymbol internal new : Impl.cenv * Typar -> FSharpGenericParameter @@ -465,7 +465,7 @@ and [] internal FSharpGenericParameter = member Constraints: IList /// A subtype of FSharpSymbol that represents a static parameter to an F# type provider -and [] internal FSharpStaticParameter = +and [] FSharpStaticParameter = inherit FSharpSymbol @@ -505,7 +505,7 @@ and [] member MemberReturnType : FSharpType /// Represents further information about a delegate constraint on a generic type parameter -and [] internal FSharpGenericParameterDelegateConstraint = +and [] FSharpGenericParameterDelegateConstraint = /// Get the tupled argument type required by the constraint member DelegateTupledArgumentType : FSharpType @@ -514,7 +514,7 @@ and [] internal FSharpGenericParameterDelegateC member DelegateReturnType : FSharpType /// Represents further information about a 'defaults to' constraint on a generic type parameter -and [] internal FSharpGenericParameterDefaultsToConstraint = +and [] FSharpGenericParameterDefaultsToConstraint = /// Get the priority off the 'defaults to' constraint member DefaultsToPriority : int @@ -523,7 +523,7 @@ and [] internal FSharpGenericParameterDefaultsT member DefaultsToTarget : FSharpType /// Represents a constraint on a generic type parameter -and [] internal FSharpGenericParameterConstraint = +and [] FSharpGenericParameterConstraint = /// Indicates a constraint that a type is a subtype of the given type member IsCoercesToConstraint : bool @@ -582,7 +582,7 @@ and [] internal FSharpGenericParameterConstrain member DelegateConstraintData : FSharpGenericParameterDelegateConstraint -and [] internal FSharpInlineAnnotation = +and [] FSharpInlineAnnotation = /// Indictes the value is inlined and compiled code for the function does not exist | PseudoValue /// Indictes the value is inlined but compiled code for the function still exists, e.g. to satisfy interfaces on objects, but that it is also always inlined @@ -593,7 +593,7 @@ and [] internal FSharpInlineAnnotation = | NeverInline /// A subtype of F# symbol that represents an F# method, property, event, function or value, including extension members. -and [] internal FSharpMemberOrFunctionOrValue = +and [] FSharpMemberOrFunctionOrValue = inherit FSharpSymbol internal new : Impl.cenv * ValRef -> FSharpMemberOrFunctionOrValue @@ -760,7 +760,7 @@ and [] internal FSharpMemberOrFunctionOrValue = /// A subtype of FSharpSymbol that represents a parameter -and [] internal FSharpParameter = +and [] FSharpParameter = inherit FSharpSymbol /// The optional name of the parameter @@ -786,7 +786,7 @@ and [] internal FSharpParameter = /// A subtype of FSharpSymbol that represents a single case within an active pattern -and [] internal FSharpActivePatternCase = +and [] FSharpActivePatternCase = inherit FSharpSymbol /// The name of the active pattern case @@ -805,7 +805,7 @@ and [] internal FSharpActivePatternCase = member XmlDocSig: string /// Represents all cases within an active pattern -and [] internal FSharpActivePatternGroup = +and [] FSharpActivePatternGroup = /// The names of the active pattern cases member Names: IList @@ -818,7 +818,7 @@ and [] internal FSharpActivePatternGroup = /// Try to get the enclosing entity of the active pattern member EnclosingEntity : FSharpEntity option -and [] internal FSharpType = +and [] FSharpType = /// Internal use only. Create a ground type. internal new : g:TcGlobals * thisCcu: CcuThunk * tcImports: TcImports * typ:TType -> FSharpType internal new : Impl.cenv * typ:TType -> FSharpType @@ -893,7 +893,7 @@ and [] internal FSharpType = /// Represents a custom attribute attached to F# source code or a compiler .NET component -and [] internal FSharpAttribute = +and [] FSharpAttribute = /// The type of the attribute member AttributeType : FSharpEntity diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 0b1960a2343..5bc18d1a81d 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -1880,14 +1880,14 @@ type FSharpCheckProjectResults(_keepAssemblyContents, errors: FSharpErrorInfo[], let (tcGlobals, tcImports, thisCcu, ccuSig, _tcSymbolUses, topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr) = getDetails() FSharpAssemblySignature(tcGlobals, thisCcu, tcImports, topAttribs, ccuSig) - // member info.AssemblyContents = - // if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to tru on the FSharpChecker in order to access the checked contents of assemblies" - // let (tcGlobals, tcImports, thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr) = getDetails() - // let mimpls = - // match tcAssemblyExpr with - // | None -> [] - // | Some (TAssembly mimpls) -> mimpls - // FSharpAssemblyContents(tcGlobals, thisCcu, tcImports, mimpls) + member info.AssemblyContents = + if not _keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to tru on the FSharpChecker in order to access the checked contents of assemblies" + let (tcGlobals, tcImports, thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr) = getDetails() + let mimpls = + match tcAssemblyExpr with + | None -> [] + | Some (TAssembly mimpls) -> mimpls + FSharpAssemblyContents(tcGlobals, thisCcu, tcImports, mimpls) // Not, this does not have to be a SyncOp, it can be called from any thread member info.GetUsesOfSymbol(symbol:FSharpSymbol) = diff --git a/src/fsharp/vs/service.fsi b/src/fsharp/vs/service.fsi index 2b606577175..58a93cb2e8d 100755 --- a/src/fsharp/vs/service.fsi +++ b/src/fsharp/vs/service.fsi @@ -81,7 +81,7 @@ type internal FSharpFindDeclResult = /// Represents the checking context implied by the ProjectOptions [] -type internal FSharpProjectContext = +type (*internal*) FSharpProjectContext = /// Get the resolution and full contents of the assemblies referenced by the project options member GetReferencedAssemblies : unit -> FSharpAssembly list @@ -256,15 +256,15 @@ type internal FSharpCheckFileResults = /// A handle to the results of CheckFileInProject. [] -type internal FSharpCheckProjectResults = +type (*internal*) FSharpCheckProjectResults = /// The errors returned by processing the project member Errors : FSharpErrorInfo[] /// Get a view of the overall signature of the assembly. Only valid to use if HasCriticalErrors is false. member AssemblySignature : FSharpAssemblySignature - // /// Get a view of the overall contents of the assembly. Only valid to use if HasCriticalErrors is false. - // member AssemblyContents : FSharpAssemblyContents + /// Get a view of the overall contents of the assembly. Only valid to use if HasCriticalErrors is false. + member AssemblyContents : FSharpAssemblyContents /// Get the resolution of the ProjectOptions member ProjectContext : FSharpProjectContext @@ -283,7 +283,7 @@ type internal FSharpCheckProjectResults = type internal UnresolvedReferencesSet /// A set of information describing a project or script build configuration. -type internal FSharpProjectOptions = +type (*internal*) FSharpProjectOptions = { // Note that this may not reduce to just the project directory, because there may be two projects in the same directory. ProjectFileName: string @@ -323,7 +323,7 @@ type internal FSharpCheckFileAnswer = [] /// Used to parse and check F# source code. -type internal FSharpChecker = +type (*internal*) FSharpChecker = /// /// Create an instance of an FSharpChecker. /// diff --git a/src/utils/prim-lexing.fs b/src/utils/prim-lexing.fs index 0a4c5c2f111..6b9db4aabe5 100644 --- a/src/utils/prim-lexing.fs +++ b/src/utils/prim-lexing.fs @@ -10,7 +10,7 @@ namespace Internal.Utilities.Text.Lexing open System.Collections.Generic [] - type internal Position = + type (*internal*) Position = val FileIndex: int val Line: int val OriginalLine: int @@ -72,7 +72,7 @@ namespace Internal.Utilities.Text.Lexing type internal LexBufferFiller<'Char> = (LexBuffer<'Char> -> unit) and [] - internal LexBuffer<'Char>(filler: LexBufferFiller<'Char>) = + (*internal*) LexBuffer<'Char>(filler: LexBufferFiller<'Char>) = let context = new Dictionary(1) let mutable buffer=[||]; /// number of valid characters beyond bufferScanStart diff --git a/src/utils/prim-lexing.fsi b/src/utils/prim-lexing.fsi index 6898b3d9d1f..e6043f65845 100644 --- a/src/utils/prim-lexing.fsi +++ b/src/utils/prim-lexing.fsi @@ -11,7 +11,7 @@ open Microsoft.FSharp.Control /// Position information stored for lexing tokens [] -type internal Position = +type (*internal*) Position = /// The file index for the file associated with the input stream, use fileOfFileIndex in range.fs to decode val FileIndex : int /// The line number in the input stream, assuming fresh positions have been updated @@ -46,7 +46,7 @@ type internal Position = [] /// Input buffers consumed by lexers generated by fslex.exe -type internal LexBuffer<'Char> = +type (*internal*) LexBuffer<'Char> = /// The start position for the lexeme member StartPos: Position with get,set /// The end position for the lexeme diff --git a/src/utils/prim-parsing.fs b/src/utils/prim-parsing.fs index 938e3a12f3d..b370ba6be2d 100644 --- a/src/utils/prim-parsing.fs +++ b/src/utils/prim-parsing.fs @@ -11,7 +11,7 @@ exception RecoverableParseError exception Accept of obj [] -type internal IParseState(ruleStartPoss:Position[],ruleEndPoss:Position[],lhsPos:Position[],ruleValues:obj[],lexbuf:LexBuffer) = +type (*internal*) IParseState(ruleStartPoss:Position[],ruleEndPoss:Position[],lhsPos:Position[],ruleValues:obj[],lexbuf:LexBuffer) = member p.LexBuffer = lexbuf member p.InputRange n = ruleStartPoss.[n-1], ruleEndPoss.[n-1]; member p.InputStartPosition n = ruleStartPoss.[n-1] diff --git a/src/utils/prim-parsing.fsi b/src/utils/prim-parsing.fsi index 48981741849..b217813e5bf 100644 --- a/src/utils/prim-parsing.fsi +++ b/src/utils/prim-parsing.fsi @@ -7,7 +7,7 @@ open Internal.Utilities.Text.Lexing open System.Collections.Generic [] -type internal IParseState = +type (*internal*) IParseState = /// Get the start and end position for the terminal or non-terminal at a given index matched by the production member InputRange: index:int -> Position * Position /// Get the end position for the terminal or non-terminal at a given index matched by the production