Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit53f99c2

Browse files
forkiKevinRansom
authored andcommitted
cleanup (#3217)
1 parent97e2910 commit53f99c2

File tree

1 file changed

+57
-49
lines changed

1 file changed

+57
-49
lines changed

‎src/fsharp/QuotationTranslator.fs‎

Lines changed: 57 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -54,8 +54,8 @@ type QuotationGenerationScope =
5454

5555
static memberCreate(g:TcGlobals,amap,scope,isReflectedDefinition)=
5656
{ g= g
57-
scope=scope
58-
amap=amap
57+
scope=scope
58+
amap=amap
5959
referencedTypeDefs=new ResizeArray<_>()
6060
referencedTypeDefsTable=new Dictionary<_,_>()
6161
typeSplices=new ResizeArray<_>()
@@ -90,8 +90,8 @@ type QuotationTranslationEnv =
9090
substVals:ValMap<Expr>}
9191

9292
static memberEmpty=
93-
{ vs=ValMap<_>.Empty
94-
nvs=0
93+
{ vs=ValMap<_>.Empty
94+
nvs=0
9595
tyvs= Map.empty
9696
isinstVals= ValMap<_>.Empty
9797
substVals= ValMap<_>.Empty}
@@ -103,15 +103,16 @@ type QuotationTranslationEnv =
103103
memberenv.BindTypars vs=
104104
(env, vs)||> List.fold(fun env v-> env.BindTypar v)// fold left-to-right because indexes are left-to-right
105105

106-
letBindFormalTypars(env:QuotationTranslationEnv)vs=
107-
{ envwith tyvs=Map.empty}.BindTypars vs
106+
letBindFormalTypars(env:QuotationTranslationEnv)vs=
107+
{ envwith tyvs=Map.empty}.BindTypars vs
108108

109-
letBindVal env v=
110-
letidx= env.nvs
111-
{ envwith vs= env.vs.Add v idx; nvs= env.nvs+1}
109+
letBindVal env v=
110+
{ envwith
111+
vs= env.vs.Add v env.nvs
112+
nvs= env.nvs+1}
112113

113114
letBindIsInstVal env v(ty,e)=
114-
{ envwith isinstVals=env.isinstVals.Add v(ty,e)}
115+
{ envwith isinstVals= env.isinstVals.Add v(ty,e)}
115116

116117
letBindSubstVal env v e=
117118
{ envwith substVals= env.substVals.Add v e}
@@ -123,13 +124,13 @@ let BindFlatVals env vs = List.fold BindVal env vs // fold left-to-right because
123124
exception InvalidQuotedTermofexn
124125
exception IgnoringPartOfQuotedTermWarningofstring*Range.range
125126

126-
letwfail e= raise(InvalidQuotedTerm(e))
127+
letwfail e= raise(InvalidQuotedTerm e)
127128

128129
let(|ModuleValueOrMemberUse|_|)g expr=
129130
let recloop expr args=
130131
match stripExpr exprwith
131-
| Expr.App((InnerExprPat(Expr.Val(vref,vFlags,_)as f)),fty,tyargs,actualArgs,_m)when vref.IsMemberOrModuleBinding->
132-
Some(vref,vFlags,f,fty,tyargs,actualArgs@args)
132+
| Expr.App((InnerExprPat(Expr.Val(vref,vFlags,_)as f)),fty,tyargs,actualArgs,_m)when vref.IsMemberOrModuleBinding->
133+
Some(vref,vFlags,f,fty,tyargs,actualArgs@args)
133134
| Expr.App(f,_fty,[],actualArgs,_)->
134135
loop f(actualArgs@ args)
135136
|(Expr.Val(vref,vFlags,_m)as f)when(match vref.ActualParentwith ParentNone->false|_->true)->
@@ -186,10 +187,12 @@ let rec EmitDebugInfoIfNecessary cenv env m astExpr : QP.ExprData =
186187
mkInt cenv.g m m.StartLine
187188
mkInt cenv.g m m.StartColumn
188189
mkInt cenv.g m m.EndLine
189-
mkInt cenv.g m m.EndColumn;]
190+
mkInt cenv.g m m.EndColumn]
190191
letattrExpr=
191192
mk_tuple cenv.g m
192-
[ mkString cenv.g m"DebugRange"; rangeExpr]
193+
[ mkString cenv.g m"DebugRange"
194+
rangeExpr]
195+
193196
letattrExprR= ConvExprCore cenv env attrExpr
194197

195198
QP.mkAttributedExpression(astExpr, attrExprR)
@@ -221,9 +224,10 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.
221224
letidx= cenv.exprSplices.Count
222225
letty= tyOfExpr cenv.g expr
223226

224-
match(freeInExpr CollectTyparsAndLocalsNoCaching x0).FreeLocals|> Seq.tryPick(fun v->if env.vs.ContainsVal vthen Some(v)else None)with
227+
match(freeInExpr CollectTyparsAndLocalsNoCaching x0).FreeLocals|> Seq.tryPick(fun v->if env.vs.ContainsVal vthen Some velse None)with
225228
| Some v-> errorR(Error(FSComp.SR.crefBoundVarUsedInSplice(v.DisplayName), v.Range))
226229
| None->()
230+
227231
cenv.exprSplices.Add((x0, m))
228232
lethole= QP.mkHole(ConvType cenv env m ty,idx)
229233
(hole, rest)||> List.fold(fun fR arg-> QP.mkApp(fR,ConvExpr cenv env arg))
@@ -235,8 +239,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.
235239
let(numEnclTypeArgs,_,isNewObj,valUseFlags,isSelfInit,takesInstanceArg,isPropGet,isPropSet)=
236240
GetMemberCallInfo cenv.g(vref,vFlags)
237241

238-
letisMember,tps,curriedArgInfos,retTy=
239-
242+
letisMember,tps,curriedArgInfos,retTy=
240243
match vref.MemberInfowith
241244
| Some_whennot vref.IsExtensionMember->
242245
// This is an application of a member method
@@ -264,8 +267,8 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.
264267
// If so, adjust and try again
265268
if curriedArgs.Length< curriedArgInfos.Length||
266269
((List.take curriedArgInfos.Length curriedArgs,curriedArgInfos)||> List.exists2(fun arg argInfo->
267-
(argInfo.Length>(tryDestRefTupleExpr arg).Length)))then
268-
270+
(argInfo.Length>(tryDestRefTupleExpr arg).Length)))
271+
then
269272
if verboseCReflectthen
270273
dprintfn"vref.DisplayName =%A was under applied" vref.DisplayName
271274
// Too few arguments or incorrect tupling? Convert to a lambda and beta-reduce the
@@ -278,7 +281,6 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.
278281
letexpr,exprty= AdjustValForExpectedArity cenv.g m vref vFlags topValInfo
279282
ConvExpr cenv env(MakeApplicationAndBetaReduce cenv.g(expr,exprty,[tyargs],curriedArgs,m))
280283
else
281-
282284
// Too many arguments? Chop
283285
let(curriedArgs:Expr list),laterArgs= List.chop curriedArgInfos.Length curriedArgs
284286

@@ -303,40 +305,40 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.
303305
letcallArgs=(objArgs::untupledCurriedArgs)|> List.concat
304306

305307
letparentTyconR= ConvTyconRef cenv vref.TopValActualParent m
306-
letisNewObj=(isNewObj|| valUseFlags|| isSelfInit)
308+
letisNewObj= isNewObj|| valUseFlags|| isSelfInit
307309
// The signature types are w.r.t. to the formal context
308310
letenvinner= BindFormalTypars env tps
309-
letargTys=curriedArgInfos|> List.concat|> List.map fst
311+
letargTys= curriedArgInfos|> List.concat|> List.map fst
310312
letmethArgTypesR= ConvTypes cenv envinner m argTys
311313
letmethRetTypeR= ConvReturnType cenv envinner m retTy
312314
letmethName= vref.CompiledName
313-
letnumGenericArgs= tyargs.Length-numEnclTypeArgs
315+
letnumGenericArgs= tyargs.Length-numEnclTypeArgs
314316
ConvObjectModelCall cenv env m(isPropGet,isPropSet,isNewObj,parentTyconR,methArgTypesR,methRetTypeR,methName,tyargs,numGenericArgs,callArgs)
315317
else
316318
// This is an application of the module value.
317319
ConvModuleValueApp cenv env m vref tyargs untupledCurriedArgs
318320
match curriedArgs,curriedArgInfoswith
319321
// static member and module value unit argument elimination
320-
|[arg:Expr],[[]]->
321-
// we got here if quotation is represents a call with unit argument
322-
// let f () = ()
323-
// <@ f @> // => (\arg -> f arg) => arg is Expr.Val - no-effects, first case
324-
// <@ f() @> // Expr.Const(Unit) - no-effects - first case
325-
// <@ f (someFunctionThatReturnsUnit) @> - potential effects - second case
326-
match argwith
327-
| Expr.Val_
328-
| Expr.Const(Const.Unit,_,_)-> subCall
329-
|_->
330-
letargQ= ConvExpr cenv env arg
331-
QP.mkSequential(argQ, subCall)
332-
|_-> subCall
322+
|[arg:Expr],[[]]->
323+
// we got here if quotation is represents a call with unit argument
324+
// let f () = ()
325+
// <@ f @> // => (\arg -> f arg) => arg is Expr.Val - no-effects, first case
326+
// <@ f() @> // Expr.Const(Unit) - no-effects - first case
327+
// <@ f (someFunctionThatReturnsUnit) @> - potential effects - second case
328+
match argwith
329+
| Expr.Val_
330+
| Expr.Const(Const.Unit,_,_)-> subCall
331+
|_->
332+
letargQ= ConvExpr cenv env arg
333+
QP.mkSequential(argQ, subCall)
334+
|_-> subCall
333335

334336
List.fold(fun fR arg-> QP.mkApp(fR,ConvExpr cenv env arg)) callR laterArgs
335337

336338

337339
// Blast type application nodes and expression application nodes apart so values are left with just their type arguments
338340
| Expr.App(f,fty,(_::_as tyargs),(_::_as args),m)->
339-
letrfty= applyForallTy cenv.gfty tyargs
341+
letrfty= applyForallTy cenv.g fty tyargs
340342
ConvExpr cenv env(primMkApp(primMkApp(f,fty) tyargs[] m, rfty)[] args m)
341343

342344
// Uses of possibly-polymorphic values
@@ -352,12 +354,10 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.
352354
| Expr.Const(c,m,ty)->
353355
ConvConst cenv env m c ty
354356

355-
| Expr.Val(vref,_vFlags,m)->
356-
357+
| Expr.Val(vref,_vFlags,m)->
357358
ConvValReftrue cenv env m vref[]
358359

359-
| Expr.Let(bind,body,_,_)->
360-
360+
| Expr.Let(bind,body,_,_)->
361361
// The binding may be a compiler-generated binding that gets removed in the quotation presentation
362362
match ConvLetBind cenv env bindwith
363363
| None, env-> ConvExpr cenv env body
@@ -368,18 +368,18 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.
368368
letvsR= vs|> List.map(ConvVal cenv env)
369369
letenv= BindFlatVals env vs
370370
letbodyR= ConvExpr cenv env body
371-
letbindsR= List.zip vsR(binds|> List.map(fun b->b.Expr|>ConvExpr cenv env))
371+
letbindsR= List.zip vsR(binds|> List.map(fun b-> ConvExpr cenv env b.Expr))
372372
QP.mkLetRec(bindsR,bodyR)
373373

374374
| Expr.Lambda(_,_,_,vs,b,_,_)->
375375
letv,b= MultiLambdaToTupledLambda cenv.g vs b
376376
letvR= ConvVal cenv env v
377-
letbR= ConvExpr cenv(BindVal env v) b
377+
letbR= ConvExpr cenv(BindVal env v) b
378378
QP.mkLambda(vR, bR)
379379

380380
| Expr.Quote(ast,_,_,_,ety)->
381381
// F# 2.0-3.1 had a bug with nested 'raw' quotations. F# 4.0 + FSharp.Core 4.4.0.0+ allows us to do the right thing.
382-
if cenv.quotationFormat= QuotationSerializationFormat.FSharp_40_Plus&&
382+
if cenv.quotationFormat= QuotationSerializationFormat.FSharp_40_Plus&&
383383
// Look for a 'raw' quotation
384384
tyconRefEq cenv.g(tcrefOfAppTy cenv.g ety) cenv.g.raw_expr_tcr
385385
then
@@ -415,15 +415,18 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.
415415
lettyargsR= ConvTypes cenv env m tyargs
416416
letargsR= ConvExprs cenv env args
417417
QP.mkSum(mkR,tyargsR,argsR)
418+
418419
| TOp.Tuple tupInfo,tyargs,_->
419420
lettyR= ConvType cenv env m(mkAnyTupledTy cenv.g tupInfo tyargs)
420421
letargsR= ConvExprs cenv env args
421422
QP.mkTuple(tyR,argsR)// TODO: propagate to quotations
423+
422424
| TOp.Recd(_,tcref),_,_->
423425
letrgtypR= ConvTyconRef cenv tcref m
424426
lettyargsR= ConvTypes cenv env m tyargs
425427
letargsR= ConvExprs cenv env args
426428
QP.mkRecdMk(rgtypR,tyargsR,argsR)
429+
427430
| TOp.UnionCaseFieldGet(ucref,n),tyargs,[e]->
428431
lettyargsR= ConvTypes cenv env m tyargs
429432
lettcR,s= ConvUnionCaseRef cenv ucref m
@@ -560,14 +563,15 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.
560563

561564
| TOp.ILCall(_,_,_,isNewObj,valUseFlags,isProp,_,ilMethRef,enclTypeArgs,methTypeArgs,_tys),[],callArgs->
562565
letparentTyconR= ConvILTypeRefUnadjusted cenv m ilMethRef.EnclosingTypeRef
563-
letisNewObj=(isNewObj||(match valUseFlagswith CtorValUsedAsSuperInit| CtorValUsedAsSelfInit->true|_->false))
566+
letisNewObj= isNewObj||(match valUseFlagswith CtorValUsedAsSuperInit| CtorValUsedAsSelfInit->true|_->false)
564567
letmethArgTypesR= List.map(ConvILType cenv env m) ilMethRef.ArgTypes
565568
letmethRetTypeR= ConvILType cenv env m ilMethRef.ReturnType
566569
letmethName= ilMethRef.Name
567570
letisPropGet= isProp&& methName.StartsWith("get_",System.StringComparison.Ordinal)
568571
letisPropSet= isProp&& methName.StartsWith("set_",System.StringComparison.Ordinal)
569572
lettyargs=(enclTypeArgs@methTypeArgs)
570573
ConvObjectModelCall cenv env m(isPropGet,isPropSet,isNewObj,parentTyconR,methArgTypesR,methRetTypeR,methName,tyargs,methTypeArgs.Length,callArgs)
574+
571575
| TOp.TryFinally_,[_resty],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],e2,_,_)]->
572576
QP.mkTryFinally(ConvExpr cenv env e1,ConvExpr cenv env e2)
573577

@@ -580,6 +584,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.
580584

581585
| TOp.Bytes bytes,[],[]->
582586
ConvExpr cenv env(Expr.Op(TOp.Array,[cenv.g.byte_ty], List.ofArray(Array.map(mkByte cenv.g m) bytes), m))
587+
583588
| TOp.UInt16s arr,[],[]->
584589
ConvExpr cenv env(Expr.Op(TOp.Array,[cenv.g.uint16_ty], List.ofArray(Array.map(mkUInt16 cenv.g m) arr), m))
585590

@@ -595,7 +600,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.
595600
|_->
596601
wfail(InternalError(sprintf"unhandled construct in AST:%A" expr,expr.Range))
597602

598-
andConvLdfldcenv env m(fspec:ILFieldSpec)enclTypeArgs args=
603+
andConvLdfld cenv env m(fspec:ILFieldSpec)enclTypeArgs args=
599604
lettyargsR= ConvTypes cenv env m enclTypeArgs
600605
letparentTyconR= ConvILTypeRefUnadjusted cenv m fspec.EnclosingTypeRef
601606
letargsR= ConvLValueArgs cenv env args
@@ -619,6 +624,7 @@ and private ConvRFieldGetCore cenv env m rfref tyargs args =
619624
letenvinner= BindFormalTypars env tcref.TyparsNoRange
620625
letpropRetTypeR= ConvType cenv envinner m fspec.FormalType
621626
QP.mkPropGet((parentTyconR, fldOrPropName,propRetTypeR,[]),tyargsR, argsR)
627+
622628
andConvLetBind cenv env(bind:Binding)=
623629
match bind.Exprwith
624630
// Map for values bound by the
@@ -637,6 +643,7 @@ and ConvLetBind cenv env (bind : Binding) =
637643
// Remove let unionCase = ... from quotation tree
638644
| Expr.Op(TOp.UnionCaseProof_,_,[e],_)->
639645
None, BindSubstVal env bind.Var e
646+
640647
|_->
641648
letv= bind.Var
642649
letvR= ConvVal cenv env v
@@ -651,6 +658,7 @@ and ConvLValueArgs cenv env args =
651658

652659
andConvLValueExpr cenv env expr=
653660
EmitDebugInfoIfNecessary cenv env expr.Range(ConvLValueExprCore cenv env expr)
661+
654662
// This function has to undo the work of mkExprAddrOfExpr
655663
andConvLValueExprCore cenv env expr=
656664
match exprwith
@@ -674,7 +682,6 @@ and ConvObjectModelCall cenv env m callInfo =
674682
EmitDebugInfoIfNecessary cenv env m(ConvObjectModelCallCore cenv env m callInfo)
675683

676684
andConvObjectModelCallCore cenv env m(isPropGet,isPropSet,isNewObj,parentTyconR,methArgTypesR,methRetTypeR,methName,tyargs,numGenericArgs,callArgs)=
677-
678685
lettyargsR= ConvTypes cenv env m tyargs
679686
letcallArgsR= ConvLValueArgs cenv env callArgs
680687

@@ -698,11 +705,12 @@ and ConvObjectModelCallCore cenv env m (isPropGet,isPropSet,isNewObj,parentTycon
698705
methArgTypes= methArgTypesR
699706
methRetType= methRetTypeR
700707
methName= methName
701-
numGenericArgs=numGenericArgs}
708+
numGenericArgs=numGenericArgs}
702709
QP.mkMethodCall(methR, tyargsR, callArgsR)
703710

704711
andConvModuleValueApp cenv env m(vref:ValRef)tyargs(args:Expr list list)=
705712
EmitDebugInfoIfNecessary cenv env m(ConvModuleValueAppCore cenv env m vref tyargs args)
713+
706714
andConvModuleValueAppCore cenv env m(vref:ValRef)tyargs(args:Expr list list)=
707715
match vref.ActualParentwith
708716
| ParentNone-> failwith"ConvModuleValueApp"

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp