Skip to content

[WIP] use Layout as a source data of classification related tasks #2070

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 17 commits into from
Jan 3, 2017
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
32 changes: 17 additions & 15 deletions src/fsharp/FSharp.Core/quotations.fs
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ open Microsoft.FSharp.Reflection
open Microsoft.FSharp.Core.Printf
open Microsoft.FSharp.Text.StructuredPrintfImpl
open Microsoft.FSharp.Text.StructuredPrintfImpl.LayoutOps
open Microsoft.FSharp.Text.StructuredPrintfImpl.TaggedTextOps

#nowarn "52" // The value has been copied to ensure the original is not mutated by this operation

Expand Down Expand Up @@ -227,22 +228,23 @@ and [<CompiledName("FSharpExpr")>]
let expr (e:Expr ) = e.GetLayout(long)
let exprs (es:Expr list) = es |> List.map expr
let parens ls = bracketL (commaListL ls)
let pairL l1 l2 = bracketL (l1 ^^ sepL "," ^^ l2)
let pairL l1 l2 = bracketL (l1 ^^ sepL Literals.comma ^^ l2)
let listL ls = squareBracketL (commaListL ls)
let combL nm ls = wordL nm ^^ parens ls
let noneL = wordL "None"
let someL e = combL "Some" [expr e]
let typeL (o: Type) = wordL (if long then o.FullName else o.Name)
let objL (o: 'T) = wordL (sprintf "%A" o)
let varL (v:Var) = wordL v.Name
let combTaggedL nm ls = wordL nm ^^ parens ls
let combL nm ls = combTaggedL (tagKeyword nm) ls
let noneL = wordL (tagProperty "None")
let someL e = combTaggedL (tagMethod "Some") [expr e]
let typeL (o: Type) = wordL (tagClass (if long then o.FullName else o.Name))
let objL (o: 'T) = wordL (tagText (sprintf "%A" o))
let varL (v:Var) = wordL (tagLocal v.Name)
let (|E|) (e: Expr) = e.Tree
let (|Lambda|_|) (E x) = match x with LambdaTerm(a,b) -> Some (a,b) | _ -> None
let (|IteratedLambda|_|) (e: Expr) = qOneOrMoreRLinear (|Lambda|_|) e
let ucaseL (unionCase:UnionCaseInfo) = (if long then objL unionCase else wordL unionCase.Name)
let minfoL (minfo: MethodInfo) = if long then objL minfo else wordL minfo.Name
let cinfoL (cinfo: ConstructorInfo) = if long then objL cinfo else wordL cinfo.DeclaringType.Name
let pinfoL (pinfo: PropertyInfo) = if long then objL pinfo else wordL pinfo.Name
let finfoL (finfo: FieldInfo) = if long then objL finfo else wordL finfo.Name
let ucaseL (unionCase:UnionCaseInfo) = (if long then objL unionCase else wordL (tagUnionCase unionCase.Name))
let minfoL (minfo: MethodInfo) = if long then objL minfo else wordL (tagMethod minfo.Name)
let cinfoL (cinfo: ConstructorInfo) = if long then objL cinfo else wordL (tagMethod cinfo.DeclaringType.Name)
let pinfoL (pinfo: PropertyInfo) = if long then objL pinfo else wordL (tagProperty pinfo.Name)
let finfoL (finfo: FieldInfo) = if long then objL finfo else wordL (tagField finfo.Name)
let rec (|NLambdas|_|) n (e:Expr) =
match e with
| _ when n <= 0 -> Some([],e)
Expand All @@ -259,7 +261,7 @@ and [<CompiledName("FSharpExpr")>]
| CombTerm(UnionCaseTestOp(unionCase),args) -> combL "UnionCaseTest" (exprs args@ [ucaseL unionCase])
| CombTerm(NewTupleOp _,args) -> combL "NewTuple" (exprs args)
| CombTerm(TupleGetOp (_,i),[arg]) -> combL "TupleGet" ([expr arg] @ [objL i])
| CombTerm(ValueOp(v,_,Some nm),[]) -> combL "ValueWithName" [objL v; wordL nm]
| CombTerm(ValueOp(v,_,Some nm),[]) -> combL "ValueWithName" [objL v; wordL (tagLocal nm)]
| CombTerm(ValueOp(v,_,None),[]) -> combL "Value" [objL v]
| CombTerm(WithValueOp(v,_),[defn]) -> combL "WithValue" [objL v; expr defn]
| CombTerm(InstanceMethodCallOp(minfo),obj::args) -> combL "Call" [someL obj; minfoL minfo; listL (exprs args)]
Expand Down Expand Up @@ -291,9 +293,9 @@ and [<CompiledName("FSharpExpr")>]
| NLambdas n (vs,e) -> combL "NewDelegate" ([typeL ty] @ (vs |> List.map varL) @ [expr e])
| _ -> combL "NewDelegate" [typeL ty; expr e]
//| CombTerm(_,args) -> combL "??" (exprs args)
| VarTerm(v) -> wordL v.Name
| VarTerm(v) -> wordL (tagLocal v.Name)
| LambdaTerm(v,b) -> combL "Lambda" [varL v; expr b]
| HoleTerm _ -> wordL "_"
| HoleTerm _ -> wordL (tagLocal "_")
| CombTerm(QuoteOp _,args) -> combL "Quote" (exprs args)
| _ -> failwithf "Unexpected term in layout %A" x.Tree

Expand Down
4 changes: 3 additions & 1 deletion src/fsharp/MethodCalls.fs
Original file line number Diff line number Diff line change
Expand Up @@ -597,7 +597,9 @@ let BuildFSharpMethodApp g m (vref: ValRef) vexp vexprty (args: Exprs) =
match arity,args with
| (0|1),[] when typeEquiv g (domainOfFunTy g fty) g.unit_ty -> mkUnit g m, (args, rangeOfFunTy g fty)
| 0,(arg::argst)->
warning(InternalError(sprintf "Unexpected zero arity, args = %s" (Layout.showL (Layout.sepListL (Layout.rightL ";") (List.map exprL args))),m));


warning(InternalError(sprintf "Unexpected zero arity, args = %s" (Layout.showL (Layout.sepListL (Layout.rightL (Layout.TaggedTextOps.tagText ";")) (List.map exprL args))),m));
arg, (argst, rangeOfFunTy g fty)
| 1,(arg :: argst) -> arg, (argst, rangeOfFunTy g fty)
| 1,[] -> error(InternalError("expected additional arguments here",m))
Expand Down
Loading