@@ -18,6 +18,7 @@ open Microsoft.FSharp.Reflection
1818open Microsoft.FSharp .Core .Printf
1919open Microsoft.FSharp .Text .StructuredPrintfImpl
2020open Microsoft.FSharp .Text .StructuredPrintfImpl .LayoutOps
21+ open Microsoft.FSharp .Text .StructuredPrintfImpl .TaggedTextOps
2122
2223#nowarn " 52" // The value has been copied to ensure the original is not mutated by this operation
2324
@@ -227,22 +228,23 @@ and [<CompiledName("FSharpExpr")>]
227228 let expr ( e : Expr ) = e.GetLayout( long)
228229 let exprs ( es : Expr list ) = es |> List.map expr
229230 let parens ls = bracketL ( commaListL ls)
230- let pairL l1 l2 = bracketL ( l1 ^^ sepL " , " ^^ l2)
231+ let pairL l1 l2 = bracketL ( l1 ^^ sepL Literals.comma ^^ l2)
231232 let listL ls = squareBracketL ( commaListL ls)
232- let combL nm ls = wordL nm ^^ parens ls
233- let noneL = wordL " None"
234- let someL e = combL " Some" [ expr e]
235- let typeL ( o : Type ) = wordL ( if long then o.FullName else o.Name)
236- let objL ( o : 'T ) = wordL ( sprintf " %A " o)
237- let varL ( v : Var ) = wordL v.Name
233+ let combTaggedL nm ls = wordL nm ^^ parens ls
234+ let combL nm ls = combTaggedL ( tagKeyword nm) ls
235+ let noneL = wordL ( tagProperty " None" )
236+ let someL e = combTaggedL ( tagMethod " Some" ) [ expr e]
237+ let typeL ( o : Type ) = wordL ( tagClass ( if long then o.FullName else o.Name))
238+ let objL ( o : 'T ) = wordL ( tagText ( sprintf " %A " o))
239+ let varL ( v : Var ) = wordL ( tagLocal v.Name)
238240 let (| E |) ( e : Expr ) = e.Tree
239241 let (| Lambda | _ |) ( E x ) = match x with LambdaTerm( a, b) -> Some ( a, b) | _ -> None
240242 let (| IteratedLambda | _ |) ( e : Expr ) = qOneOrMoreRLinear (| Lambda|_|) e
241- let ucaseL ( unionCase : UnionCaseInfo ) = ( if long then objL unionCase else wordL unionCase.Name)
242- let minfoL ( minfo : MethodInfo ) = if long then objL minfo else wordL minfo.Name
243- let cinfoL ( cinfo : ConstructorInfo ) = if long then objL cinfo else wordL cinfo.DeclaringType.Name
244- let pinfoL ( pinfo : PropertyInfo ) = if long then objL pinfo else wordL pinfo.Name
245- let finfoL ( finfo : FieldInfo ) = if long then objL finfo else wordL finfo.Name
243+ let ucaseL ( unionCase : UnionCaseInfo ) = ( if long then objL unionCase else wordL ( tagUnionCase unionCase.Name) )
244+ let minfoL ( minfo : MethodInfo ) = if long then objL minfo else wordL ( tagMethod minfo.Name)
245+ let cinfoL ( cinfo : ConstructorInfo ) = if long then objL cinfo else wordL ( tagMethod cinfo.DeclaringType.Name)
246+ let pinfoL ( pinfo : PropertyInfo ) = if long then objL pinfo else wordL ( tagProperty pinfo.Name)
247+ let finfoL ( finfo : FieldInfo ) = if long then objL finfo else wordL ( tagField finfo.Name)
246248 let rec (| NLambdas | _ |) n ( e : Expr ) =
247249 match e with
248250 | _ when n <= 0 -> Some([], e)
@@ -259,7 +261,7 @@ and [<CompiledName("FSharpExpr")>]
259261 | CombTerm( UnionCaseTestOp( unionCase), args) -> combL " UnionCaseTest" ( exprs args@ [ ucaseL unionCase])
260262 | CombTerm( NewTupleOp _, args) -> combL " NewTuple" ( exprs args)
261263 | CombTerm( TupleGetOp (_, i),[ arg]) -> combL " TupleGet" ([ expr arg] @ [ objL i])
262- | CombTerm( ValueOp( v,_, Some nm),[]) -> combL " ValueWithName" [ objL v; wordL nm ]
264+ | CombTerm( ValueOp( v,_, Some nm),[]) -> combL " ValueWithName" [ objL v; wordL ( tagLocal nm ) ]
263265 | CombTerm( ValueOp( v,_, None),[]) -> combL " Value" [ objL v]
264266 | CombTerm( WithValueOp( v,_),[ defn]) -> combL " WithValue" [ objL v; expr defn]
265267 | CombTerm( InstanceMethodCallOp( minfo), obj:: args) -> combL " Call" [ someL obj; minfoL minfo; listL ( exprs args)]
@@ -291,9 +293,9 @@ and [<CompiledName("FSharpExpr")>]
291293 | NLambdas n ( vs, e) -> combL " NewDelegate" ([ typeL ty] @ ( vs |> List.map varL) @ [ expr e])
292294 | _ -> combL " NewDelegate" [ typeL ty; expr e]
293295 //| CombTerm(_,args) -> combL "??" (exprs args)
294- | VarTerm( v) -> wordL v.Name
296+ | VarTerm( v) -> wordL ( tagLocal v.Name)
295297 | LambdaTerm( v, b) -> combL " Lambda" [ varL v; expr b]
296- | HoleTerm _ -> wordL " _"
298+ | HoleTerm _ -> wordL ( tagLocal " _" )
297299 | CombTerm( QuoteOp _, args) -> combL " Quote" ( exprs args)
298300 | _ -> failwithf " Unexpected term in layout %A " x.Tree
299301
0 commit comments