I'm trying to make a type provider which generates types and doesn't erase them. I used the GeneratedTypeProvider example and made my own version.
What I try to accomplish is that some type is generate (e.g. Fact) which has one constructor for the type and its properties (e.g. an Id, a Timestamp, a Name). I use the Element type as basetype. The construction should result in an immutable Fact-object.
If I run it in an erased variant everything is fine, but I don't get the Fact type. When I make the non-erased version (setting typesTy.IsErased <- false and adding the type to the provided assembly providedAssembly.AddTypes([typesTy])), it no longer functions.
What I found out is that an extra argument is passed to the arguments of the constructor I provide. This is a Fact type. And the constrution complains there is no constructor for Fact. But what I'm providing is a construtor for Fact including it's properties.
What do I have to do to get this working?
My code so far:
type Element(values: obj []) =
let propertyMap = new Map<int, obj>(values |> Seq.mapi (fun i value -> (i, value)))
member this.GetValue propertyIndex : obj =
match propertyMap.TryFind propertyIndex with
| Some(value) -> value
| None -> box "property not found"
let private typeOf elementType =
match elementType with
| "String" -> typeof<string>
| "Guid" -> typeof<System.Guid>
| "DateTime" -> typeof<System.DateTime>
| _ -> typeof<string>
let internal makeTypeWith thisAssembly namespaceName group entityName =
let entityType =
ProvidedTypeDefinition(thisAssembly, namespaceName,
entityName,
baseType = Some typeof<Element>)
entityType.AddXmlDocDelayed (fun () -> sprintf "This %s" entityName)
let properties = [("Id", "Guid"); ("Timestamp", "DateTime"); ("Name", "String")]
let fieldsOfProperties =
properties
|> List.iteri (fun index (propertyName, propertyType) ->
let instanceProp =
ProvidedProperty(propertyName = propertyName,
propertyType = typeOf propertyType,
GetterCode = (fun args -> <## unbox ((%%(args.[0]) : Element).GetValue index) ##>))
instanceProp.AddXmlDocDelayed(fun () -> sprintf "%s" propertyName)
entityType.AddMember instanceProp)
let typeConstructor =
ProvidedConstructor(
parameters =
(properties
|> List.mapi (fun index (name, typ) -> ProvidedParameter(parameterName = name, parameterType = typeOf typ))),
InvokeCode =
(fun args ->
let boxedArgs =
args |> List.map (fun arg ->
match arg with
| Quotations.Patterns.Var var ->
if var.Type = typeof<int> then
<## (box (%%arg: int)) ##>
else if var.Type = typeof<string> then
<## (box (%%arg: string)) ##>
else if var.Type = typeof<System.Guid> then
<## (box (%%arg: System.Guid)) ##>
else if var.Type = typeof<System.DateTime> then
<## (box (%%arg: System.DateTime)) ##>
else
let argsVals =
args |> List.map (fun arg ->
match arg with
| Quotations.Patterns.Var var -> var.Type.ToString()
| _ -> "unknown")
|> List.reduce (fun all arg -> all + ", " + arg)
failwith ("Aha: " + argsVals)
| _ -> failwith ("Unknown Expr as parameter"))
<## Element(%%(Expr.NewArray(typeof<obj>, boxedArgs))) :> obj ##>))
typeConstructor.AddXmlDocDelayed(fun () -> "This is the constructor")
entityType.AddMember typeConstructor
entityType
[<TypeProvider>]
type public DataLayerProvider(cfg:TypeProviderConfig) as this =
inherit TypeProviderForNamespaces()
let thisAssembly = Assembly.GetExecutingAssembly()
let rootNamespace = "Types"
let providedAssembly = new ProvidedAssembly(System.IO.Path.ChangeExtension(System.IO.Path.GetTempFileName(), ".dll"))
let typesTy = makeTypeWith thisAssembly rootNamespace "Some" "Fact"
do
typesTy.IsErased <- false
providedAssembly.AddTypes([typesTy])
do System.AppDomain.CurrentDomain.add_AssemblyResolve(fun _ args ->
let name = System.Reflection.AssemblyName(args.Name)
let existingAssembly =
System.AppDomain.CurrentDomain.GetAssemblies()
|> Seq.tryFind(fun a -> System.Reflection.AssemblyName.ReferenceMatchesDefinition(name, a.GetName()))
match existingAssembly with
| Some a -> a
| None -> null)
do this.AddNamespace(rootNamespace, [typesTy])
[<TypeProviderAssembly>]
do ()
Related
I'm trying to substitute types in a F# Expr, before converting it to an Expression for consumption by a c# lib.
But upon the call to LeafExpressionConverter.QuotationToExpression I receive the error
InvalidOperationException: The variable 't' was not found in the translation context
Basically I'm trying to substitute the equivalent of
<# fun (t: Record) -> t.A = 10 #> to
<# fun (t: Dict) -> t["A"] = 10 #>
Here is the code
type Record = {
A: int
}
type Dict () = //this is the type the c# lib wants (a dictionary representation of a type)
inherit Dictionary<string, obj>()
let substitute<'a> (ex: Expr<'a->bool>) =
let replaceVar (v: Var) = if v.Type = typeof<'a> then Var(v.Name, typeof<Dict>) else v
let tEntityItem = typeof<Dict>.GetProperty("Item")
let isATypeShapeVar = function | ShapeVar var -> var.Type = typeof<'a> | _ -> false
let rec substituteExpr =
function
| PropertyGet(exOpt, propOrValInfo, c) ->
match exOpt with
| None -> Expr.PropertyGet(propOrValInfo)
| Some ex ->
let args = c |> List.map substituteExpr
let newex = substituteExpr ex
match isATypeShapeVar ex with
| true ->
let getter = Expr.PropertyGet(newex, tEntityItem, [Expr.Value(propOrValInfo.Name)] )
Expr.Coerce(getter, propOrValInfo.PropertyType)
| false -> Expr.PropertyGet(newex, propOrValInfo, args)
| ShapeVar var -> Expr.Var (var |> replaceVar)
| ShapeLambda (var, expr) -> Expr.Lambda(var |> replaceVar, substituteExpr expr)
| ShapeCombination(shapeComboObject, exprList) ->
RebuildShapeCombination(shapeComboObject, List.map substituteExpr exprList)
substituteExpr ex |> LeafExpressionConverter.QuotationToExpression
substitute<Record> (<# fun t -> t.A = 10 #>)
I suspect I've missed something in the substitution, but I'm stumped as to what.
The the .ToString() result of the substituted F# Expr is
Lambda (t,
Call (None, op_Equality,
[Coerce (PropertyGet (Some (t), Item, [Value ("A")]), Int32),
Value (10)]))
which looks correct. And other than the coersion, is the equivalent of <# fun (t: Dict) -> t["A"] = 10 #>.ToString()
Why is the QuotationToExpression failing ?
Every time you call replaceVar, you return a different instance of Var. So when you replace the lambda parameter, it's one instance of Var, and later, when you replace newex, that's another instance of Var.
Lambda (t, Call (None, op_Equality, [Coerce (PropertyGet (Some (t), ... ))
^ ^
| |
---------------------------------------------------------
These are different `t`, unrelated, despite the same name
To make this work, you have to make it the same t. The dumbest, most straightforward way would be this:
let substitute<'a> (ex: Expr<'a->bool>) =
let newArg = Var("arg", typeof<Dict>)
let replaceVar (v: Var) = if v.Type = typeof<'a> then newArg else v
...
This will make your particular example work as expected, but it is still unsound, because you're replacing not just specifically the lambda parameter, but any variable of the same type. Which means that if the expression happens to contain any variables of the same type as the parameter, you'd still hit the same problem. For example, try converting this:
<# fun t -> let z = { A = 15 } in z.A = 15 && t.A = 10 #>
You'll get a similar error, but this time complaining about variable z.
A better way would be to maintain a map of variable substitutions as you go, insert new variables as you encounter them for the first time, but get them from the map on subsequent encounters.
An alternative approach would be to fish out specifically the lambda parameter and then replace only it, rather than comparing variable types.
But then there's the next level of weirdness: you're converting any property accessor to an indexer accessor, but in my example above, z.A shouldn't be thus converted. So you have to somehow recognize whether the object of property access is in fact the argument, and that may not be as trivial.
If you're willing to settle for just the case of t.A and fail on more complicated cases like (if true then t else t).A, then you can just match on the lambda argument and pass through any other expression:
let substitute<'a> (ex: Expr<'a->bool>) =
let arg =
match ex with
| ShapeLambda (v, _) -> v
| _ -> failwith "This is not a lambda. Shouldn't happen."
let newArg = Var("arg", typeof<Dict>)
let replaceVar (v: Var) = if v = arg then newArg else v
let tEntityItem = typeof<Dict>.GetProperty("Item")
let isATypeShapeVar = function | ShapeVar var -> var.Type = typeof<'a> | _ -> false
let rec substituteExpr =
function
| PropertyGet(Some (ShapeVar a), propOrValInfo, c) when a = arg ->
let getter = Expr.PropertyGet(Expr.Var newArg, tEntityItem, [Expr.Value(propOrValInfo.Name)] )
Expr.Coerce(getter, propOrValInfo.PropertyType)
| ShapeVar var -> Expr.Var (var |> replaceVar)
| ShapeLambda (var, expr) -> Expr.Lambda(var |> replaceVar, substituteExpr expr)
| ShapeCombination(shapeComboObject, exprList) ->
RebuildShapeCombination(shapeComboObject, List.map substituteExpr exprList)
| ex -> ex
substituteExpr ex |> LeafExpressionConverter.QuotationToExpression
> substituteExpr <# fun t -> let z = { A = 15 } in z.A = 15 && t.A = 10 #>
val it: System.Linq.Expressions.Expression =
ToFSharpFunc(arg => z => ((z.A == 15) AndAlso (Convert(arg.get_Item("A"), Int32) == 10)).Invoke(new Record(15)))
I have the following types:
type Foo = { Name : string}
type Bar = {Name : string}
And I have the following Quoted expression:
<# fun (x : Foo) -> x.Name = "1" #>
Basically from this I would like to generate another quoted expression as:
<# fun (x : Bar) -> x.Name = "1" #>
How can I do this?
OK I got the following solution :
let subst expression newType =
let newVar name = Var.Global(name,newType)
let rec substituteExpr expression =
match expression with
| Call(Some (ShapeVar var),mi,other) ->
Expr.Call(Expr.Var(newVar var.Name), newType.GetMethod(mi.Name),other)
| PropertyGet (Some (ShapeVar var) ,pi, _) ->
Expr.PropertyGet(Expr.Var( newVar var.Name), newType.GetProperty(pi.Name),[])
| ShapeVar var -> Expr.Var <| newVar var.Name
| ShapeLambda (var, expr) ->
Expr.Lambda (newVar var.Name, substituteExpr expr)
| ShapeCombination(shapeComboObject, exprList) ->
RebuildShapeCombination(shapeComboObject, List.map substituteExpr exprList)
substituteExpr expression
then I can do
let f = <# fun (x : Foo) -> x.Name = "1" #>
let transformed = subst f typeof<Bar>
let typedExpression: Expr<Bar -> bool> = downcast <# %%transformed #>
I would like to extend the W algorithm to the inference of tuples and lists in F#, a priori, there are only two rules to add, which I did, however, the result is partially bad.
Indeed, if I test a code like these:
test = (8, "Hello", 0.3) -- test :: (TInt, TString, TFloat)
id :: a -> a
id x = x -- id :: a -> a
foo = id 8 -- foo :: TInt
it works, on the other hand, as detailed in the examples below, a code like this one will not work:
makePair = (\x -> (x, x)) -- makePair :: a -> (a, a)
pair = makePair 7
and pair will be inferred as (a, a) instead of (TInt, TInt).
Same for the lists.
I used this paper to write my type checker.
I really don't understand what's jamming.
Here is the minimum functional program used for these examples:
Inference.fs
module Typechecker
type Identifier = string
and Expr =
| Var of Identifier
| Lambda of Identifier * Expr
| Apply of Expr * Expr
| Let of Identifier * Expr * Expr
| Literal of Literal
| Tuple of Expr list
| List of Expr list
and Literal =
| Int of int
| Float of float
| String of string
and Statement =
| Signature of Identifier * Type
| Declaration of Identifier * Expr
and Type =
| TVar of Identifier
| TInt
| TFloat
| TString
| TArrow of Type * Type
| TTuple of Type list
| TList of Type
type Program = Program of Statement list
type Scheme = Scheme of string list * Type
and TypeEnv = Map<Identifier, Scheme>
and Subst = Map<string, Type>
type Env =
{ mutable _functions: Function list }
with
member this.containsFunction name =
this._functions |> List.exists (fun f -> f._name = name)
member this.getFunction name =
this._functions
|> List.find (fun (f: Function) -> f._name = name)
member this.getFunctionType name =
(this.getFunction name)._type
member this.hasFunctionImplementation name =
if this.containsFunction name
then (this.getFunction name)._value.IsSome
else false
member this.getFunctionValue name =
(this.getFunction name)._value.Value
/// Updates the value of a function in the environment
member this.updateFunction_value name value =
(this.getFunction name)._value <- Some value
this
/// Updates the type of a function in the environment
member this.updateFunction_type name ty =
(this.getFunction name)._type <- ty
this
member this.addFunction name ty value =
{ _functions =
List.append
this._functions
[{ _name = name;
_type = ty;
_value = value }] }
and Function =
{ _name: Identifier;
mutable _type: Type;
mutable _value: Expr option }
and DataType =
{ _name: Identifier;
_isAlias: bool;
_constructors: Ctor list option
_alias: Type option }
and Ctor = Term of Identifier | Product of Type list
let newEnv = { _functions = [] }
module Type =
let rec ftv = function
| TInt -> Set.empty
| TFloat -> Set.empty
| TString -> Set.empty
| TVar name -> Set.singleton name
| TArrow(t1, t2) -> Set.union (ftv t1) (ftv t2)
| TTuple ts -> List.fold (fun acc t -> Set.union acc (ftv t)) Set.empty ts
| TList t -> Set.singleton (toString t)
and apply s t =
match t with
| TVar name ->
match Map.tryFind name s with
| Some t -> t
| None -> TVar name
| TArrow (t1, t2) ->
TArrow(apply s t1, apply s t2)
| TInt | TFloat | TString -> t
| _ -> t
and parens s =
sprintf "(%s)" s
and braces s =
sprintf "{ %s }" s
and toString t =
let rec parenType t' =
match t' with
| TArrow(_, _) -> parens (toString t')
| _ -> toString t'
match t with
| TVar name -> name
| TInt -> "Integer"
| TFloat -> "Float"
| TString -> "String"
| TArrow(t1, t2) ->
(parenType t1) + " -> " + (toString t2)
| TTuple ts -> sprintf "(%s)" (System.String.Join(", ", List.map toString ts))
| TList t -> sprintf "[%s]" (toString t)
module Scheme =
let rec ftv (scheme: Scheme) =
match scheme with
| Scheme(variables, t) ->
Set.difference(Type.ftv t) (Set.ofList variables)
and apply (s: Subst) (scheme: Scheme) =
match scheme with
| Scheme(variables, t) ->
let newSubst = List.foldBack (fun key currentSubst -> Map.remove key currentSubst) variables s
let newType = Type.apply newSubst t
Scheme(variables, newType)
module TypeEnv =
let rec remove (env: TypeEnv) (var: Identifier) =
Map.remove var env
and ftv (typeEnv: TypeEnv) =
Seq.foldBack (fun (KeyValue(_, v)) state ->
Set.union state (Scheme.ftv v)) typeEnv Set.empty
and apply (s: Subst) (env: TypeEnv) =
Map.map (fun _ value -> Scheme.apply s value) env
module Subst =
let compose s1 s2 =
Map.union (Map.map (fun _ (v: Type) -> Type.apply s1 v) s2) s1
let rec generalize (env: TypeEnv) (t: Type) =
let variables =
Set.difference (Type.ftv t) (TypeEnv.ftv env)
|> Seq.toList
Scheme(variables, t)
and private currentId = ref 'a'
and nextId () =
let id = !currentId
currentId := (char ((int !currentId) + 1))
id
and resetId () = currentId := 'a'
and newTyVar () =
TVar(sprintf "%c" (nextId ()))
and instantiate (ts: Scheme) =
match ts with
| Scheme(variables, t) ->
let nvars = variables |> List.map (fun name -> newTyVar ())
let s = List.zip variables nvars |> Map.ofList
Type.apply s t
and varBind a t =
match t with
| TVar name when name = a -> Map.empty
| _ when Set.contains a (Type.ftv t) ->
failwithf "Occur check fails: `%s` vs `%s`" a (Type.toString t)
| _ -> Map.singleton a t
and unify (t1: Type) (t2: Type) : Subst =
match t1, t2 with
| TVar a, t | t, TVar a -> varBind a t
| TInt, TInt -> Map.empty
| TFloat, TFloat -> Map.empty
| TString, TString -> Map.empty
| TArrow(l, r), TArrow(l', r') ->
let s1 = unify l l'
let s2 = unify (Type.apply s1 r) (Type.apply s1 r')
Subst.compose s2 s1
| TTuple ts, TTuple ts' ->
if ts.Length <> ts'.Length
then failwithf "Types do not unify: `%s` vs `%s`" (Type.toString t1) (Type.toString t2)
else List.fold Subst.compose Map.empty (List.map2 unify ts ts')
| TList t, TList t' ->
unify t t'
| _ -> failwithf "Types do not unify: `%s` vs `%s`" (Type.toString t1) (Type.toString t2)
and tiLit = function
| Literal.Int _ -> Type.TInt
| Literal.Float _ -> Type.TFloat
| Literal.String _ -> Type.TString
and tiExpr (env: TypeEnv) (exp: Expr) : Subst * Type =
match exp with
| Var name ->
match Map.tryFind name env with
| Some sigma ->
let t = instantiate sigma
(Map.empty, t)
| None -> failwithf "Unbound variable: `%s`" name
| Literal lit -> (Map.empty, tiLit lit)
| Let(id, expr, in') ->
let s1, t1 = tiExpr env expr
let env1 = TypeEnv.remove env id
let scheme = generalize (TypeEnv.apply s1 env) t1
let env2 = Map.add id scheme env1
let s2, t2 = tiExpr (TypeEnv.apply s1 env2) in'
(Subst.compose s2 s1, t2)
| Lambda(id, value) ->
let tv = newTyVar ()
let env1 = TypeEnv.remove env id
let env2 = Map.union env1 (Map.singleton id (Scheme([], tv)))
let s1, t1 = tiExpr env2 value
(s1, TArrow(Type.apply s1 tv, t1))
| Tuple values ->
(Map.empty, TTuple(List.map (fun v -> snd (tiExpr env v)) values))
| List ts ->
let tv = newTyVar ()
if ts.IsEmpty
then (Map.empty, TList tv)
else
let _, t1 = tiExpr env ts.[0]
if List.forall (fun t -> snd (tiExpr env t) = t1) ts
then (Map.empty, TList t1)
else failwith "Not all items in the list are of the same type"
| Apply(e1, e2) ->
let s1, t1 = tiExpr env e1
let s2, t2 = tiExpr (TypeEnv.apply s1 env) e2
let tv = newTyVar ()
let s3 = unify (Type.apply s2 t1) (TArrow(t2, tv))
(Subst.compose (Subst.compose s3 s2) s1, Type.apply s3 tv)
and expression_typeInference env exp =
let s, t = tiExpr env exp
Type.apply s t
and updateExprEnv (env: Env) =
let mutable env' = Map.empty
List.iter
(fun (f: Function) ->
env' <- env'.Add(f._name, Scheme([f._name], f._type))
) env._functions
env'
let rec public statement_typecheck (env: Env) stmt =
let exprEnv = updateExprEnv env
match stmt with
| Signature(id, dastType) ->
typecheck_signature env id dastType
| Declaration(id, value) ->
typecheck_decl env id value exprEnv
and private typecheck_signature (env: Env) id ty =
if env.hasFunctionImplementation id
then failwithf "The type of a function cannot be defined after its implementation (`%s`)" id
else env.addFunction id ty None
and private typecheck_decl (env: Env) id value exprEnv =
let _, t_exp = tiExpr exprEnv value
if env.containsFunction id
then if env.hasFunctionImplementation id
then failwithf "Already declared function: `%s`" id
else
let t_sgn = (env.getFunction id)._type
let unapp = try (Type.apply ((unify t_sgn t_exp)) t_exp)
|> Ok with exn -> failwithf "%s" exn.Message
if match unapp with Result.Ok _ -> true
then env.updateFunction_value id value
else failwithf "The signature of `%s` is different than the type of its value\n (`%s` vs `%s`)"
id (Type.toString t_sgn) (Type.toString t_exp)
else env.addFunction id t_exp (Some value)
let typecheck_document (document: Program) =
let mutable docenv = newEnv
match document with Program stmts ->
List.iter (fun stmt -> docenv <- statement_typecheck docenv stmt) stmts
docenv
Main.fs
module Main
open Inference
[<EntryPoint>]
let main _ =
let test1 =
[Declaration("makePair", Lambda("x", Tuple([Var "x"; Var "x"]))); // makePair = (\x -> (x, x))
Declaration("pair", Apply(Var "makePair", Literal (Int 7)))] // pair = makePair 7
let infer1 = typecheck_document (Program test1)
printfn "Env1: %A" infer1
let test2 =
[Signature("id", TArrow(TVar "a", TVar "a")); // id :: a -> a
Declaration("id", Lambda("x", Var "x")) // id x = x
Declaration("foo", Apply(Var "id", Literal (Int 7)))] // foo = id 7
let infer2 = typecheck_document (Program test2)
printfn "Env2: %A" infer2
0
Here is the output:
Env1: {_functions =
[{_name = "makePair";
_type = TArrow (TVar "a",TTuple [TVar "a"; TVar "a"]);
_value = Some (Lambda ("x",Tuple [Var "x"; Var "x"]));};
{_name = "pair";
_type = TTuple [TVar "a"; TVar "a"];
_value = Some (Apply (Var "makePair",Literal (Int 7)));}];}
Env2: {_functions =
[{_name = "id";
_type = TArrow (TVar "a",TVar "a");
_value = Some (Lambda ("x",Var "x"));};
{_name = "test";
_type = TInt;
_value = Some (Apply (Var "id",Literal (Int 7)));}];}
So we can see that the inference works correctly for the first test, but not for the second (as shown above).
I would like to solve and understand this bug, and I thank you in advance for your help.
As far as I read in your code, it seems like you're missing a branch in apply.
Indeed, when t is a Tuple [], you're basically only returning it...which well will of course not work. :)
I suggest adding one branch to the match, with t as a Tuple types, with a map (\t -> apply s t) types (sorry, I don't know much F# syntax).
Hope it helps. :)
When I'm working in the F# REPL fsharpi whenever I enter a new function the signature is printed after I've entered them:
> let foo x = x;;
val foo : x:'a -> 'a
Is there a way to retrieve this as a string? The reason I'm asking is that I'm using IfSharp for Jupyter notebooks which doesn't display the signatures, but I'd like to be able to show the types of functions for demonstration purposes.
I've messed around a bit but can't get anything useful, I've tried:
let foo x = (x, x)
printfn "%A" (foo.GetType())
printfn "%A" foo
But this isn't quite what I need:
FSI_0013+clo#3-1
<fun:it#5-2>
Is it possible to access this at all?
AFAIK, there's no function in FSharp.Core for getting a type's string representation as it would appear to the compiler (though maybe there's something in FSharp.Compiler.Services -- I haven't checked). Here's a small function that works for most simple uses:
open System
let (|TFunc|_|) (typ: Type) =
if typ.IsGenericType && typ.GetGenericTypeDefinition () = typeof<int->int>.GetGenericTypeDefinition () then
match typ.GetGenericArguments() with
| [|targ1; targ2|] -> Some (targ1, targ2)
| _ -> None
else
None
let rec typeStr (typ: Type) =
match typ with
| TFunc (TFunc(_, _) as tfunc, t) -> sprintf "(%s) -> %s" (typeStr tfunc) (typeStr t)
| TFunc (t1, t2) -> sprintf "%s -> %s" (typeStr t1) (typeStr t2)
| typ when typ = typeof<int> -> "int"
| typ when typ = typeof<string> -> "string"
| typ when typ.IsGenericParameter -> sprintf "'%s" (string typ)
| typ -> string typ
typeStr typeof<(string -> (string -> int) -> int) -> int>
// val it: string = "string -> (string -> int) -> int"
typeStr (typeof<int->int>.GetGenericTypeDefinition())
// val it: string = "'T -> 'TResult"
You can easily write a function on top of this to use typeStr on a value's type:
let valTypeString x = typStr (x.GetType ())
You can analyze types representing F# functions, with the help of the Microsoft.FSharp.Reflection namespace. There is the caveat that generic function arguments default to System.Object, and that other F# types which may form incomplete patterns (e.g. union cases, records) are not included.
open Microsoft.FSharp.Reflection
let funString o =
let rec loop nested t =
if FSharpType.IsTuple t then
FSharpType.GetTupleElements t
|> Array.map (loop true)
|> String.concat " * "
elif FSharpType.IsFunction t then
let fs = if nested then sprintf "(%s -> %s)" else sprintf "%s -> %s"
let domain, range = FSharpType.GetFunctionElements t
fs (loop true domain) (loop false range)
else
t.FullName
loop false (o.GetType())
let foo x = x
funString foo
// val it : string = "System.Object -> System.Object"
How can I get get a list of names visible in the scope with FSC?
I tried this:
#r "../../packages/FSharp.Compiler.Service.16.0.2/lib/net45/FSharp.Compiler.Service.dll"
open Microsoft.FSharp.Compiler
open Microsoft.FSharp.Compiler.SourceCodeServices
do
let file = "TestFileName.fsx"
let checker = SourceCodeServices.FSharpChecker.Create()
let code =
"""
let testStr = "x"
t
"""
async{
let! options, _ = checker.GetProjectOptionsFromScript(file,code)
let! parseRes,checkAnser = checker.ParseAndCheckFileInProject(file, 0, code, options)
match checkAnser with
| FSharpCheckFileAnswer.Succeeded checkRes ->
let! decls =
checkRes.GetDeclarationListInfo(
Some parseRes, //ParsedFileResultsOpt
3 , //line
1 , //colAtEndOfPartialName
"t" , //lineText
[ "t" ] , //qualifyingNames
"" , //partialName
( fun _ -> [] ) //getAllSymbols: (unit -> AssemblySymbol list)
)
if Seq.isEmpty decls.Items then
printfn "*no declarations found*"
else
decls.Items
|> Seq.sortBy (fun d -> d.Name)
|> Seq.truncate 10
|> Seq.iter (fun d -> printfn "decl: %s" d.Name)
| _ -> failwithf "*Parsing did not finish... "
} |> Async.RunSynchronously
but it only prints "no declarations found". I would expect not only testStr but also all the other names that are available by default.
I did not find an example in the documentation.
qualifyingNames should be an empty list, it’s for dot separated prefix, excluding the last (possibly partial) ident. However, there is no a method in FCS that returns unfiltered list of names for scope, yet it’s really easy to add one.
With the answer of vasily-kirichenko and using the current FCS 17.0.1 I came up with this solution:
#r "../../packages/FSharp.Compiler.Service.17.0.1/lib/net45/FSharp.Compiler.Service.dll"
open Microsoft.FSharp.Compiler
open Microsoft.FSharp.Compiler.SourceCodeServices
do
let file = "TestFileName.fsx"
let checker = SourceCodeServices.FSharpChecker.Create()
let code =
"""
let testStr = "x"
testStr.
"""
async{
let! options, _ = checker.GetProjectOptionsFromScript(file,code)
let! parseRes,checkAnser = checker.ParseAndCheckFileInProject(file, 0, code, options)
match checkAnser with
| FSharpCheckFileAnswer.Succeeded checkRes ->
let! decls =
let partialName = PartialLongName.Empty 6 //use any location before before the dot to get all declarations in scope
//let partialName = PartialLongName.Empty 7 //use the loacation of the dot (7) to get memebers of string
checkRes.GetDeclarationListInfo(
Some parseRes, // ParsedFileResultsOpt
3 , // line
"testStr." , // lineText
partialName, // PartialLongName
( fun _ -> [] ) // getAllSymbols: (unit -> AssemblySymbol list)
)
if Seq.isEmpty decls.Items then
printfn "*no declarations found*"
else
decls.Items
|> Seq.sortBy (fun d -> d.Name)
|> Seq.truncate 10
|> Seq.iter (fun d -> printfn "decl: %s" d.Name)
| _ -> failwithf "*Parsing did not finish... "
} |> Async.RunSynchronously