Fixed forward in closure and added tests

src/back/CodeGen/Closure.hs

@@ -43,10 +43,13 @@ translateClosure closure typeVars table
            params      = A.eparams closure
            body        = A.body closure
            id          = Meta.getMetaId . A.getMeta $ closure
+           idAsync     = id ++ "_async"
            funName     = closureFunName id
+           funNameAsync = closureFunName idAsync
            nameForwarding = forwardingClosureImplName $ (ID.Name . show) funName
            envName     = closureEnvName id
            traceName   = closureTraceName id
+           traceNameAsync = closureTraceName idAsync
            boundVars   = map (ID.qName . show . A.pname) params
            freeVars    = map (first ID.qnlocal) $
                          filter (ID.isLocalQName . fst) $
@@ -79,7 +82,7 @@ translateClosure closure typeVars table
                         ,returnStmnt bodyName resultType]
                       )
            forwardingClosureImpl =
-             Function (Static $ Typ "value_t") funName
+             Function (Static $ Typ "value_t") funNameAsync
                       [(Ptr (Ptr encoreCtxT), encoreCtxVar),
                        (Ptr (Ptr ponyTypeT), encoreRuntimeType),
                        (Typ "value_t", Var "_args[]"),
@@ -92,12 +95,13 @@ translateClosure closure typeVars table
                         ,dtraceClosureExit
                         ,returnStmnt forwardingBodyName unitType])
        in
-         Concat $  [buildEnvironmentForward envName freeVars fTypeVars] ++
+         Concat $ [buildEnvironmentForward envName freeVars fTypeVars] ++
+                  [tracefunDecl traceName envName freeVars fTypeVars extractEnvironment,
+                          normalClosureImpl] ++
                    if null $ Util.filter A.isForward body
-                   then [tracefunDecl traceName envName freeVars fTypeVars extractEnvironment,
-                         normalClosureImpl]
-                   else [tracefunDecl traceName envName freeVars fTypeVars extractEnvironmentForward,
-                         forwardingClosureImpl]
+                   then []
+                   else [tracefunDecl traceNameAsync envName freeVars fTypeVars extractEnvironmentForward,
+                          forwardingClosureImpl]
   | otherwise =
         error
         "Tried to translate a closure from something that was not a closure"

src/back/CodeGen/Expr.hs

@@ -221,7 +221,7 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
       let string = head args
           rest = tail args
       unless (Ty.isStringType $ A.getType string) $
-          error "Expr.hs: Print expects first argument to be a string literal"
+          error $ "Expr.hs: Print expects first argument to be a string literal"
       targs <- mapM translate rest
       let argNames = map (AsExpr . fst) targs
           argDecls = map snd targs
@@ -1032,7 +1032,8 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
                        If futVar
                          (Seq [Statement forwardingCall])
                          (Seq [Statement oneWayMsg])] ++
-                       result)
+                       result
+             )
     else do
       (sendn, sendt) <- translate A.MessageSend{A.emeta
                                                ,A.target
@@ -1059,18 +1060,19 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
     isAsyncForward <- gets Ctx.isAsyncForward
     let ty = getRuntimeType chain
         dtraceExit = getDtraceExit eCtx
-        result =
-          case eCtx of
-            Ctx.ClosureContext clos -> []
-            _ -> [dtraceExit, Return Skip]
+        result = case eCtx of
+                    Ctx.ClosureContext clos -> []
+                    _ -> [dtraceExit, Return Skip]
         futureChain =
           if Util.isForwardInExpr chain
-          then
-            Call futureChainActor
-              [AsExpr encoreCtxVar, AsExpr nfuture, ty, AsExpr nchain]
-          else
-            Call futureChainWithFut
-             [AsExpr encoreCtxVar, AsExpr nfuture, ty, AsExpr nchain, AsExpr futVar]
+          then Call futureChainActor
+                    [AsExpr encoreCtxVar, AsExpr nfuture, ty, AsExpr nchain]
+          else Call futureChainWithFut
+                    [AsExpr encoreCtxVar, AsExpr nfuture, ty, AsExpr nchain
+                    ,AsExpr futVar, AsExpr $ AsLval $ Nam "false"]
+    when (A.isVarAccess chain) $
+      unless (A.isIdClosure chain) $
+        error $ "Expr.hs: The closure that contains forward must be defined in chain."
     if isAsyncForward
     then do
       return (unit, Seq $
@@ -1146,15 +1148,21 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
     (nfuture,tfuture) <- translate future
     (nchain, tchain)  <- translate chain
     result <- Ctx.genSym
+    isAsyncForward <- gets Ctx.isAsyncForward
     let ty = getRuntimeType chain
     return $ (Var result,
       Seq $ [tfuture,
              tchain,
-             (Assign (Decl (C.future, Var result))
-                     (Call futureChainActor
-                       [AsExpr encoreCtxVar, AsExpr nfuture, ty, AsExpr nchain]
-                       ))] ++
-            if (Util.isForwardInExpr chain) then [assignVar futNam (Nam result)]
+              if (Util.isForwardInExpr chain && isAsyncForward)
+              then Statement $
+                      (Call futureChainWithFut
+                            [AsExpr encoreCtxVar, AsExpr nfuture, ty, AsExpr nchain,
+                             AsExpr ((Deref envName) `Dot` futNam), AsExpr $ AsLval $ Nam "true"])
+              else Assign (Decl (C.future, Var result))
+                          (Call futureChainActor [AsExpr encoreCtxVar, AsExpr nfuture, ty, AsExpr nchain])
+            ] ++
+            if (Util.isForwardInExpr chain && isAsyncForward)
+            then [assignVar futNam (Decl (C.future, Var result))]
             else [])
     where
       metaId    = Meta.getMetaId . A.getMeta $ chain
@@ -1163,31 +1171,38 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
 
   translate clos@(A.Closure{A.eparams, A.body}) = do
     tmp <- Ctx.genSym
-    fut <- Ctx.genNamedSym "fut"
+    futClos <- Ctx.genNamedSym "fut_closure"
     globalFunctionNames <- gets Ctx.getGlobalFunctionNames
     isAsyncForward <- gets Ctx.isAsyncForward
     let bound = map (ID.qLocal . A.pname) eparams
         freeVars = filter (ID.isLocalQName . fst) $
                    Util.freeVariables bound body
         ty = runtimeType . A.getType $ body
-        futArg = if isAsyncForward
-                 then futVar
-                 else (Var fut)
     fillEnv <- insertAllVars freeVars fTypeVars
     return
       (Var tmp,
-      Seq $
-        mkEnv envName : fillEnv ++
-        (if isAsyncForward || (not $ Util.isForwardInExpr body)
-         then []
-         else [Assign (Decl (future, Var fut))
-                (Call futureMkFn [AsExpr encoreCtxVar, ty])]) ++
-        (if Util.isForwardInExpr body
-         then [assignVar futNam futArg]
-         else []) ++
-        [Assign (Decl (closure, Var tmp))
-          (Call closureMkFn [encoreCtxName, funName, envName, traceName, nullName])])
+       Seq $
+          mkEnv envName : fillEnv ++
+          if isAsyncForward then
+              if forwardInBody
+              then [Assign (Decl (future, Var futClos))
+                           (Call futureMkFn [AsExpr encoreCtxVar, ty])
+                    ,assignVar futNam (Var futClos)
+                    ,Assign (Decl (closure, Var tmp))
+                           (Call closureMkFn [encoreCtxName, funNameAsync, envName, traceNameAsync, nullName])]
+              else [Assign (Decl (closure, Var tmp))
+                     (Call closureMkFn [encoreCtxName, funName, envName, traceName, nullName])]
+           else
+               [Assign (Decl (closure, Var tmp))
+                 (Call closureMkFn [encoreCtxName, funName, envName, traceName, nullName])])
     where
+      forwardInBody  = Util.isForwardInExpr body
+      metaIdAsync    = metaId ++ "_async"
+      idClos         = A.isIdClosure body
+      funNameAsync   = if idClos || not forwardInBody then funName
+                       else closureFunName metaIdAsync
+      traceNameAsync = if idClos || not forwardInBody then traceName
+                       else closureTraceName metaIdAsync
       metaId    = Meta.getMetaId . A.getMeta $ clos
       funName   = closureFunName metaId
       envName   = closureEnvName metaId

src/back/CodeGen/MethodDecl.hs

@@ -73,12 +73,14 @@ translateGeneral mdecl@(A.Method {A.mbody, A.mlocals})
                       ,returnStatement mType bodyn])
         forwardingMethodImpl =
             Function void nameForwarding (args ++ [(future, futVar)])
-                 (Seq [dtraceMethodEntry thisVar mName argNames
+                (Seq $[dtraceMethodEntry thisVar mName argNames
                       ,parametricMethodTypeVars
                       ,extractTypeVars
                       ,forwardingBody
                       ,dtraceMethodExit thisVar mName
-                      ,Return Skip])
+                      ,Statement $ returnForForwardingMethod returnType
+                      ,Return Skip]
+                  )
     in
       code ++ return (Concat $ locals ++ closures ++
                                [normalMethodImpl] ++
@@ -133,6 +135,14 @@ translateGeneral mdecl@(A.Method {A.mbody, A.mlocals})
                                 show oldName
         in A.setFunctionName newName fun
 
+      returnForForwardingMethod returnType =
+          let fulfilArgs = [AsExpr encoreCtxVar
+                            ,AsExpr $ futVar
+                            ,asEncoreArgT returnType
+                                (Cast returnType forwardingBodyName)]
+          in
+              If futVar (Statement $ Call futureFulfil fulfilArgs) Skip
+
 callMethodWithFuture m cdecl@(A.Class {A.cname}) code
   | A.isActive cdecl ||
     A.isShared cdecl =

src/ir/AST/AST.hs

@@ -676,7 +676,7 @@ data Expr = Skip {emeta :: Meta Expr}
                    val :: Expr}
           | Suspend {emeta :: Meta Expr}
           | FutureChain {emeta :: Meta Expr,
-                        future :: Expr,
+                         future :: Expr,
                          chain :: Expr}
           | FieldAccess {emeta :: Meta Expr,
                          target :: Expr,
@@ -765,14 +765,26 @@ isThisAccess :: Expr -> Bool
 isThisAccess VarAccess {qname = QName{qnlocal}} = qnlocal == Name "this"
 isThisAccess _ = False
 
+isIdClos :: Expr -> Bool
+isIdClos VarAccess{qname = QName{qnlocal}} = qnlocal == Name "_id_fun_tmp"
+isIdClos _ = False
+
 isClosure :: Expr -> Bool
 isClosure Closure {} = True
 isClosure _ = False
 
+isIdClosure :: Expr -> Bool
+isIdClosure VarAccess{qname = QName{qnlocal}} = qnlocal == Name "_id_fun_tmp"
+isIdClosure _ = False
+
 isForward :: Expr -> Bool
 isForward Forward {} = True
 isForward _ = False
 
+isVarAccess :: Expr -> Bool
+isVarAccess VarAccess{} = True
+isVarAccess _ = False
+
 isNull :: Expr -> Bool
 isNull Null{} = True
 isNull _ = False

src/runtime/future/future.c

@@ -102,7 +102,7 @@ static void future_finalizer(future_t *fut);
 static inline void future_gc_send_value(pony_ctx_t *ctx, future_t *fut);
 static inline void future_gc_recv_value(pony_ctx_t *ctx, future_t *fut);
 static void future_chain(pony_ctx_t **ctx, future_t *fut, pony_type_t *type,
-    closure_t *c, future_t *r);
+    closure_t *c, future_t *r, bool withForward);
 
 pony_type_t future_type = {
   .id = ID_FUTURE,
@@ -197,6 +197,12 @@ static inline encore_arg_t run_closure(pony_ctx_t **ctx, closure_t *c, encore_ar
   return closure_call(ctx, c, (value_t[1]) { value });
 }
 
+static inline void run_closure_fwd(pony_ctx_t **ctx, closure_t *c, encore_arg_t value)
+{
+  closure_call(ctx, c, (value_t[1]) { value });
+  return;
+}
+
 bool future_fulfilled(future_t *fut)
 {
   perr("future_fulfilled");
@@ -305,30 +311,35 @@ future_t *future_chain_actor(pony_ctx_t **ctx, future_t *fut, pony_type_t *type,
 {
   ENC_DTRACE3(FUTURE_CHAINING, (uintptr_t) *ctx, (uintptr_t) fut, (uintptr_t) type);
   future_t *r = future_mk(ctx, type);
-  future_chain(ctx, fut, type, c, r);
+  future_chain(ctx, fut, type, c, r, false);
   return r;
 }
 
 void future_chain_with_fut(pony_ctx_t **ctx, future_t *fut, pony_type_t *type,
-        closure_t *c, future_t *r)
+        closure_t *c, future_t *r, bool keepFwd)
 {
   ENC_DTRACE3(FUTURE_CHAINING, (uintptr_t) *ctx, (uintptr_t) fut, (uintptr_t) type);
   (void)type;
-  future_chain(ctx, fut, type, c, r);
+  future_chain(ctx, fut, type, c, r, keepFwd);
   return;
 }
 
 static void future_chain(pony_ctx_t **ctx, future_t *fut, pony_type_t *type,
-        closure_t *c, future_t *r)
+        closure_t *c, future_t *r, bool withForward)
 {
   (void)type;
   perr("future_chain_actor");
   BLOCK;
 
   if (fut->fulfilled) {
     acquire_future_value(ctx, fut);
-    value_t result = run_closure(ctx, c, fut->value);
-    future_fulfil(ctx, r, result);
+    if (withForward) {
+      run_closure_fwd(ctx, c, fut->value);
+    }
+    else {
+      value_t result = run_closure(ctx, c, fut->value);
+      future_fulfil(ctx, r, result);
+    }
     UNBLOCK;
     return;
   }

src/runtime/future/future.h

@@ -55,7 +55,7 @@ future_t *future_chain_actor(pony_ctx_t **ctx, future_t *fut, pony_type_t *type,
         closure_t *c);
 
 void future_chain_with_fut(pony_ctx_t **ctx, future_t *fut, pony_type_t *type,
-        closure_t *c, future_t *r);
+        closure_t *c, future_t *r, bool keepFwd);
 
 /** Registers a callback and returns void
  *

src/tests/encore/forward/failedPolyTypeStreamWithObject.enc

@@ -0,0 +1,58 @@
+-- Error related to unknown _enc_type_t in method produce()
+-- read class Bar
+--   val v : int
+--   def init(v : int) : unit
+--     this.v = v
+--   end
+--   def getter() : int
+--     this.v
+--   end
+-- end
+active class Foo[t]
+  stream produce(var n : int, v : t) : t
+    while n>0 do
+      yield(v)
+      n -= 1
+    end
+  end
+end
+active class Main
+  def main() : unit
+    val foo = new Foo[int]
+    val s = foo!produce(10, 42)
+  end
+end
+
+-- With the concrete type of stream, it works properly.
+{-
+read class Bar
+  val v : int
+  def init(v : int) : unit
+    this.v = v
+  end
+  def getter() : int
+    this.v
+  end
+end
+active class Foo
+  stream produce(var n : int) : Bar
+    while n>0 do
+      yield(new Bar(n))
+      n -= 1
+    end
+  end
+end
+active class Main
+  def printStream(var s : Stream[Bar]) : unit
+    while not(eos(s)) do
+      println("{}", (get(s)).getter())
+      s = getNext(s)
+    end
+  end
+  def main() : unit
+    val foo = new Foo
+    val s = foo!produce(10)
+    this.printStream(s)
+  end
+end
+-}

src/tests/encore/forward/forwardArgInClosure.enc

@@ -6,8 +6,11 @@ end
 
 active class Foo
   def join(ff : Fut[Fut[int]]) : int
-    (ff ~~> (fun (f : Fut[int]) : unit => forward(f)))
-    0 -- Will be disregarded since it is used to bypass the typechecker.
+    await(ff)
+    get(ff ~~> fun (f : Fut[int]) : int
+                  await(f)
+                  forward(f)
+               end)
   end
 
   def duplicate() : Fut[int]

src/tests/encore/forward/forwardClosMaybe.enc

@@ -9,8 +9,7 @@ active class Crop
 end
 active class Pepper
   def green(arg : Fut[Maybe[int]]) : Maybe[int]
-    get(arg ~~> fun(x : Maybe[int]) : unit => forward((new Crop(x)) ! collect()))
-    Nothing : Maybe[int]
+    get(arg ~~> fun(x : Maybe[int]) : Maybe[int] => forward((new Crop(x)) ! collect()))
   end
 end
 active class Main