Skip to content

Commit 219fc4b

Browse files
PhucVH888PhucVH888
committed
Fixed forward in closure and added tests
1 parent 84b763f commit 219fc4b

19 files changed

+290
-80
lines changed

‎src/back/CodeGen/Closure.hs

+10-6
Original file line numberDiff line numberDiff line change
@@ -43,10 +43,13 @@ translateClosure closure typeVars table
4343
params = A.eparams closure
4444
body = A.body closure
4545
id = Meta.getMetaId . A.getMeta $ closure
46+
idAsync = id ++ "_async"
4647
funName = closureFunName id
48+
funNameAsync = closureFunName idAsync
4749
nameForwarding = forwardingClosureImplName $ (ID.Name . show) funName
4850
envName = closureEnvName id
4951
traceName = closureTraceName id
52+
traceNameAsync = closureTraceName idAsync
5053
boundVars = map (ID.qName . show . A.pname) params
5154
freeVars = map (first ID.qnlocal) $
5255
filter (ID.isLocalQName . fst) $
@@ -79,7 +82,7 @@ translateClosure closure typeVars table
7982
,returnStmnt bodyName resultType]
8083
)
8184
forwardingClosureImpl =
82-
Function (Static $ Typ "value_t") funName
85+
Function (Static $ Typ "value_t") funNameAsync
8386
[(Ptr (Ptr encoreCtxT), encoreCtxVar),
8487
(Ptr (Ptr ponyTypeT), encoreRuntimeType),
8588
(Typ "value_t", Var "_args[]"),
@@ -92,12 +95,13 @@ translateClosure closure typeVars table
9295
,dtraceClosureExit
9396
,returnStmnt forwardingBodyName unitType])
9497
in
95-
Concat $ [buildEnvironmentForward envName freeVars fTypeVars] ++
98+
Concat $ [buildEnvironmentForward envName freeVars fTypeVars] ++
99+
[tracefunDecl traceName envName freeVars fTypeVars extractEnvironment,
100+
normalClosureImpl] ++
96101
if null $ Util.filter A.isForward body
97-
then [tracefunDecl traceName envName freeVars fTypeVars extractEnvironment,
98-
normalClosureImpl]
99-
else [tracefunDecl traceName envName freeVars fTypeVars extractEnvironmentForward,
100-
forwardingClosureImpl]
102+
then []
103+
else [tracefunDecl traceNameAsync envName freeVars fTypeVars extractEnvironmentForward,
104+
forwardingClosureImpl]
101105
| otherwise =
102106
error
103107
"Tried to translate a closure from something that was not a closure"

‎src/back/CodeGen/Expr.hs

+67-34
Original file line numberDiff line numberDiff line change
@@ -221,7 +221,7 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
221221
let string = head args
222222
rest = tail args
223223
unless (Ty.isStringType $ A.getType string) $
224-
error "Expr.hs: Print expects first argument to be a string literal"
224+
error $ "Expr.hs: Print expects first argument to be a string literal"
225225
targs <- mapM translate rest
226226
let argNames = map (AsExpr . fst) targs
227227
argDecls = map snd targs
@@ -1032,7 +1032,8 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
10321032
If futVar
10331033
(Seq [Statement forwardingCall])
10341034
(Seq [Statement oneWayMsg])] ++
1035-
result)
1035+
result
1036+
)
10361037
else do
10371038
(sendn, sendt) <- translate A.MessageSend{A.emeta
10381039
,A.target
@@ -1059,25 +1060,26 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
10591060
isAsyncForward <- gets Ctx.isAsyncForward
10601061
let ty = getRuntimeType chain
10611062
dtraceExit = getDtraceExit eCtx
1062-
result =
1063-
case eCtx of
1064-
Ctx.ClosureContext clos -> []
1065-
_ -> [dtraceExit, Return Skip]
1063+
result = case eCtx of
1064+
Ctx.ClosureContext clos -> []
1065+
_ -> [dtraceExit, Return Skip]
10661066
futureChain =
10671067
if Util.isForwardInExpr chain
1068-
then
1069-
Call futureChainActor
1070-
[AsExpr encoreCtxVar, AsExpr nfuture, ty, AsExpr nchain]
1071-
else
1072-
Call futureChainWithFut
1073-
[AsExpr encoreCtxVar, AsExpr nfuture, ty, AsExpr nchain, AsExpr futVar]
1068+
then Call futureChainActor
1069+
[AsExpr encoreCtxVar, AsExpr nfuture, ty, AsExpr nchain]
1070+
else Call futureChainWithFut
1071+
[AsExpr encoreCtxVar, AsExpr nfuture, ty, AsExpr nchain
1072+
,AsExpr futVar, AsExpr $ AsLval $ Nam "false"]
1073+
when (A.isVarAccess chain) $
1074+
unless (A.isIdClosure chain) $
1075+
error $ "Expr.hs: The closure that contains forward must be defined in chain."
10741076
if isAsyncForward
10751077
then do
10761078
return (unit, Seq $
10771079
[tfuture,
10781080
tchain,
10791081
Statement futureChain] ++
1080-
result)
1082+
closResult)
10811083
else do
10821084
tmp <- Ctx.genSym
10831085
result <- Ctx.genSym
@@ -1146,53 +1148,84 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
11461148
(nfuture,tfuture) <- translate future
11471149
(nchain, tchain) <- translate chain
11481150
result <- Ctx.genSym
1151+
isAsyncForward <- gets Ctx.isAsyncForward
11491152
let ty = getRuntimeType chain
1153+
fwdInClos = case eCtx of
1154+
Ctx.ClosureContext _ -> True
1155+
_ -> False
1156+
when (A.isVarAccess chain && isAsyncForward) $
1157+
if (fwdInClos)
1158+
then error $ "Expr.hs: The closure that contains forward must be defined in chain."
1159+
else return ()
11501160
return $ (Var result,
11511161
Seq $ [tfuture,
11521162
tchain,
1153-
(Assign (Decl (C.future, Var result))
1154-
(Call futureChainActor
1155-
[AsExpr encoreCtxVar, AsExpr nfuture, ty, AsExpr nchain]
1156-
))] ++
1157-
if (Util.isForwardInExpr chain) then [assignVar futNam (Nam result)]
1163+
if (Util.isForwardInExpr chain && isAsyncForward)
1164+
then Statement $
1165+
(Call futureChainWithFut
1166+
[AsExpr encoreCtxVar, AsExpr nfuture, ty, AsExpr nchain,
1167+
AsExpr ((Deref envName) `Dot` futNam), AsExpr $ AsLval $ Nam "true"])
1168+
else Assign (Decl (C.future, Var result))
1169+
(Call futureChainActor [AsExpr encoreCtxVar, AsExpr nfuture, ty, AsExpr nchain])
1170+
] ++
1171+
if (Util.isForwardInExpr chain && isAsyncForward)
1172+
then [assignVar futNam (Decl (C.future, Var result))]
11581173
else [])
11591174
where
11601175
metaId = Meta.getMetaId . A.getMeta $ chain
11611176
envName = closureEnvName metaId
1162-
assignVar lhs rhs = Assign rhs ((Deref envName) `Dot` lhs)
1177+
assignVar lhs rhs = Assign (Decl (C.future, lhs)) ((Deref envName) `Dot` rhs)
11631178

11641179
translate clos@(A.Closure{A.eparams, A.body}) = do
11651180
tmp <- Ctx.genSym
1166-
fut <- Ctx.genNamedSym "fut"
1181+
futClos <- Ctx.genNamedSym "fut_closure"
11671182
globalFunctionNames <- gets Ctx.getGlobalFunctionNames
11681183
isAsyncForward <- gets Ctx.isAsyncForward
11691184
let bound = map (ID.qLocal . A.pname) eparams
11701185
freeVars = filter (ID.isLocalQName . fst) $
11711186
Util.freeVariables bound body
11721187
ty = runtimeType . A.getType $ body
1173-
futArg = if isAsyncForward
1174-
then futVar
1175-
else (Var fut)
11761188
fillEnv <- insertAllVars freeVars fTypeVars
11771189
return
11781190
(Var tmp,
1179-
Seq $
1180-
mkEnv envName : fillEnv ++
1181-
(if isAsyncForward || (not $ Util.isForwardInExpr body)
1182-
then []
1183-
else [Assign (Decl (future, Var fut))
1184-
(Call futureMkFn [AsExpr encoreCtxVar, ty])]) ++
1185-
(if Util.isForwardInExpr body
1186-
then [assignVar futNam futArg]
1187-
else []) ++
1188-
[Assign (Decl (closure, Var tmp))
1189-
(Call closureMkFn [encoreCtxName, funName, envName, traceName, nullName])])
1191+
Seq $
1192+
mkEnv envName : fillEnv ++
1193+
if isAsyncForward then
1194+
if forwardInBody
1195+
then [Assign (Decl (future, Var futClos))
1196+
(Call futureMkFn [AsExpr encoreCtxVar, ty])
1197+
,assignVar futNam (Var futClos)
1198+
,Assign (Decl (closure, Var tmp))
1199+
(Call closureMkFn [encoreCtxName, funNameAsync, envName, traceNameAsync, nullName])]
1200+
else [Assign (Decl (closure, Var tmp))
1201+
(Call closureMkFn [encoreCtxName, funName, envName, traceName, nullName])]
1202+
else
1203+
[Assign (Decl (closure, Var tmp))
1204+
(Call closureMkFn [encoreCtxName, funName, envName, traceName, nullName])])
11901205
where
1206+
forwardInBody = Util.isForwardInExpr body
1207+
metaIdAsync = metaId ++ "_async"
1208+
idClos = A.isIdClosure body
1209+
funNameAsync = if idClos || not forwardInBody then funName
1210+
else closureFunName metaIdAsync
1211+
traceNameAsync = if idClos || not forwardInBody then traceName
1212+
else closureTraceName metaIdAsync
11911213
metaId = Meta.getMetaId . A.getMeta $ clos
11921214
funName = closureFunName metaId
11931215
envName = closureEnvName metaId
11941216
traceName = closureTraceName metaId
1217+
metaIdAsync = metaId ++ "_async"
1218+
idClos = A.isIdClos body
1219+
fwdInBody = Util.isForwardInExpr body
1220+
funNameAsync = if idClos || not fwdInBody
1221+
then funName
1222+
else closureFunName metaIdAsync
1223+
traceNameAsync = if idClos || not fwdInBody
1224+
then traceName
1225+
else closureTraceName metaIdAsync
11951226
fTypeVars = Util.freeTypeVars body
1227+
futureMake f ty = Assign (Decl (future, Var f))
1228+
(Call futureMkFn [AsExpr encoreCtxVar, ty])
11961229
mkEnv name =
11971230
Assign (Decl (Ptr $ Struct name, AsLval name))
11981231
(Call encoreAllocName [AsExpr (Deref encoreCtxVar), Sizeof $ Struct name])

‎src/back/CodeGen/MethodDecl.hs

+19-2
Original file line numberDiff line numberDiff line change
@@ -73,12 +73,14 @@ translateGeneral mdecl@(A.Method {A.mbody, A.mlocals})
7373
,returnStatement mType bodyn])
7474
forwardingMethodImpl =
7575
Function void nameForwarding (args ++ [(future, futVar)])
76-
(Seq [dtraceMethodEntry thisVar mName argNames
76+
(Seq $[dtraceMethodEntry thisVar mName argNames
7777
,parametricMethodTypeVars
7878
,extractTypeVars
7979
,forwardingBody
8080
,dtraceMethodExit thisVar mName
81-
,Return Skip])
81+
,Statement $ returnForForwardingMethod returnType
82+
,Return Skip]
83+
)
8284
in
8385
code ++ return (Concat $ locals ++ closures ++
8486
[normalMethodImpl] ++
@@ -87,6 +89,13 @@ translateGeneral mdecl@(A.Method {A.mbody, A.mlocals})
8789
then []
8890
else [forwardingMethodImpl])
8991
where
92+
returnForForwardingMethod returnType =
93+
let fulfilArgs = [AsExpr encoreCtxVar
94+
,AsExpr $ futVar
95+
,asEncoreArgT returnType
96+
(Cast returnType forwardingBodyName)]
97+
in
98+
If futVar (Statement $ Call futureFulfil fulfilArgs) Skip
9099
mName = A.methodName mdecl
91100
localNames = map (ID.qLocal . A.functionName) mlocals
92101
localized = map (localize cname (A.methodName mdecl)) mlocals
@@ -133,6 +142,14 @@ translateGeneral mdecl@(A.Method {A.mbody, A.mlocals})
133142
show oldName
134143
in A.setFunctionName newName fun
135144

145+
returnForForwardingMethod returnType =
146+
let fulfilArgs = [AsExpr encoreCtxVar
147+
,AsExpr $ futVar
148+
,asEncoreArgT returnType
149+
(Cast returnType forwardingBodyName)]
150+
in
151+
If futVar (Statement $ Call futureFulfil fulfilArgs) Skip
152+
136153
callMethodWithFuture m cdecl@(A.Class {A.cname}) code
137154
| A.isActive cdecl ||
138155
A.isShared cdecl =

‎src/ir/AST/AST.hs

+13-1
Original file line numberDiff line numberDiff line change
@@ -676,7 +676,7 @@ data Expr = Skip {emeta :: Meta Expr}
676676
val :: Expr}
677677
| Suspend {emeta :: Meta Expr}
678678
| FutureChain {emeta :: Meta Expr,
679-
future :: Expr,
679+
future :: Expr,
680680
chain :: Expr}
681681
| FieldAccess {emeta :: Meta Expr,
682682
target :: Expr,
@@ -765,14 +765,26 @@ isThisAccess :: Expr -> Bool
765765
isThisAccess VarAccess {qname = QName{qnlocal}} = qnlocal == Name "this"
766766
isThisAccess _ = False
767767

768+
isIdClos :: Expr -> Bool
769+
isIdClos VarAccess{qname = QName{qnlocal}} = qnlocal == Name "_id_fun_tmp"
770+
isIdClos _ = False
771+
768772
isClosure :: Expr -> Bool
769773
isClosure Closure {} = True
770774
isClosure _ = False
771775

776+
isIdClosure :: Expr -> Bool
777+
isIdClosure VarAccess{qname = QName{qnlocal}} = qnlocal == Name "_id_fun_tmp"
778+
isIdClosure _ = False
779+
772780
isForward :: Expr -> Bool
773781
isForward Forward {} = True
774782
isForward _ = False
775783

784+
isVarAccess :: Expr -> Bool
785+
isVarAccess VarAccess{} = True
786+
isVarAccess _ = False
787+
776788
isNull :: Expr -> Bool
777789
isNull Null{} = True
778790
isNull _ = False

‎src/runtime/future/future.c

+18-7
Original file line numberDiff line numberDiff line change
@@ -102,7 +102,7 @@ static void future_finalizer(future_t *fut);
102102
static inline void future_gc_send_value(pony_ctx_t *ctx, future_t *fut);
103103
static inline void future_gc_recv_value(pony_ctx_t *ctx, future_t *fut);
104104
static void future_chain(pony_ctx_t **ctx, future_t *fut, pony_type_t *type,
105-
closure_t *c, future_t *r);
105+
closure_t *c, future_t *r, bool withForward);
106106

107107
pony_type_t future_type = {
108108
.id = ID_FUTURE,
@@ -197,6 +197,12 @@ static inline encore_arg_t run_closure(pony_ctx_t **ctx, closure_t *c, encore_ar
197197
return closure_call(ctx, c, (value_t[1]) { value });
198198
}
199199

200+
static inline void run_closure_fwd(pony_ctx_t **ctx, closure_t *c, encore_arg_t value)
201+
{
202+
closure_call(ctx, c, (value_t[1]) { value });
203+
return;
204+
}
205+
200206
bool future_fulfilled(future_t *fut)
201207
{
202208
perr("future_fulfilled");
@@ -305,30 +311,35 @@ future_t *future_chain_actor(pony_ctx_t **ctx, future_t *fut, pony_type_t *type,
305311
{
306312
ENC_DTRACE3(FUTURE_CHAINING, (uintptr_t) *ctx, (uintptr_t) fut, (uintptr_t) type);
307313
future_t *r = future_mk(ctx, type);
308-
future_chain(ctx, fut, type, c, r);
314+
future_chain(ctx, fut, type, c, r, false);
309315
return r;
310316
}
311317

312318
void future_chain_with_fut(pony_ctx_t **ctx, future_t *fut, pony_type_t *type,
313-
closure_t *c, future_t *r)
319+
closure_t *c, future_t *r, bool keepFwd)
314320
{
315321
ENC_DTRACE3(FUTURE_CHAINING, (uintptr_t) *ctx, (uintptr_t) fut, (uintptr_t) type);
316322
(void)type;
317-
future_chain(ctx, fut, type, c, r);
323+
future_chain(ctx, fut, type, c, r, keepFwd);
318324
return;
319325
}
320326

321327
static void future_chain(pony_ctx_t **ctx, future_t *fut, pony_type_t *type,
322-
closure_t *c, future_t *r)
328+
closure_t *c, future_t *r, bool withForward)
323329
{
324330
(void)type;
325331
perr("future_chain_actor");
326332
BLOCK;
327333

328334
if (fut->fulfilled) {
329335
acquire_future_value(ctx, fut);
330-
value_t result = run_closure(ctx, c, fut->value);
331-
future_fulfil(ctx, r, result);
336+
if (withForward) {
337+
run_closure_fwd(ctx, c, fut->value);
338+
}
339+
else {
340+
value_t result = run_closure(ctx, c, fut->value);
341+
future_fulfil(ctx, r, result);
342+
}
332343
UNBLOCK;
333344
return;
334345
}

‎src/runtime/future/future.h

+1-1
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,7 @@ future_t *future_chain_actor(pony_ctx_t **ctx, future_t *fut, pony_type_t *type,
5555
closure_t *c);
5656

5757
void future_chain_with_fut(pony_ctx_t **ctx, future_t *fut, pony_type_t *type,
58-
closure_t *c, future_t *r);
58+
closure_t *c, future_t *r, bool keepFwd);
5959

6060
/** Registers a callback and returns void
6161
*

0 commit comments

Comments
 (0)