fix(js/ts/python): preserve JS/TS generic unit arguments and Python unit continuations

src/Fable.Transforms/Babel/Fable2Babel.fs

@@ -47,6 +47,7 @@ type Context =
         TailCallOpportunity: ITailCallOpportunity option
         OptimizeTailCall: unit -> unit
         ScopedTypeParams: Set<string>
+        BoundTypes: Map<string, Fable.Type>
         ForcedIdents: Set<string>
     }
 
@@ -2451,17 +2452,35 @@ but thanks to the optimisation done below we get
                 | Some(TransformExpr com ctx thisArg) ->
                     callFunction com ctx range callee callInfo.GenericArgs (thisArg :: args)
 
-    let transformCurriedApply com ctx range (TransformExpr com ctx applied) args =
-        (applied, args)
-        ||> List.fold (fun expr arg ->
-            match arg with
-            // TODO: If arg type is unit but it's an expression with potential
-            // side-effects, we need to extract it and execute it before the call
-            | Fable.Value(Fable.UnitConstant, _) -> []
-            | Fable.IdentExpr ident when ident.Type = Fable.Unit -> []
-            | TransformExpr com ctx arg -> [ arg ]
-            |> callFunction com ctx range expr []
+    let transformCurriedApply (com: IBabelCompiler) ctx range (applied: Fable.Expr) args =
+        // decision: declaration types preserve generic unit arguments despite specialized identifier types at call sites
+        let appliedType =
+            match applied with
+            // invariant: FSharp2Fable makes local names unique within a declaration (getIdentUniqueName)
+            | MaybeCasted(Fable.IdentExpr id) -> Map.tryFind id.Name ctx.BoundTypes |> Option.defaultValue id.Type
+            | _ -> applied.Type
+
+        let applied = com.TransformAsExpr(ctx, applied)
+
+        ((applied, appliedType), args)
+        ||> List.fold (fun (expr, calleeType) arg ->
+            let argType, returnType =
+                match calleeType with
+                | Fable.LambdaType(argType, returnType) -> Some argType, returnType
+                | _ -> None, Fable.Any
+
+            let args =
+                match arg, argType with
+                | _, Some argType when argType <> Fable.Unit -> [ com.TransformAsExpr(ctx, arg) ]
+                // TODO: If arg type is unit but it's an expression with potential
+                // side-effects, we need to extract it and execute it before the call
+                | Fable.Value(Fable.UnitConstant, _), _ -> []
+                | Fable.IdentExpr ident, _ when ident.Type = Fable.Unit -> []
+                | TransformExpr com ctx arg, _ -> [ arg ]
+
+            callFunction com ctx range expr [] args, returnType
         )
+        |> fst
 
     let transformCallAsStatements com ctx range typ returnStrategy callee callInfo =
         let argsLen (i: Fable.CallInfo) =
@@ -3197,13 +3216,21 @@ but thanks to the optimisation done below we get
         | Fable.Let(ident, value, body) ->
             if ctx.HoistVars [ ident ] then
                 let assignment = transformBindingAsExpr com ctx ident value
+                let ctx = { ctx with BoundTypes = Map.add ident.Name ident.Type ctx.BoundTypes }
 
                 Expression.sequenceExpression ([| assignment; com.TransformAsExpr(ctx, body) |])
             else
                 iife com ctx expr
 
         | Fable.LetRec(bindings, body) ->
             if ctx.HoistVars(List.map fst bindings) then
+                let ctx =
+                    { ctx with
+                        BoundTypes =
+                            (ctx.BoundTypes, bindings)
+                            ||> List.fold (fun types (id, _) -> Map.add id.Name id.Type types)
+                    }
+
                 let values =
                     bindings
                     |> List.mapToArray (fun (id, value) -> transformBindingAsExpr com ctx id value)
@@ -3310,10 +3337,18 @@ but thanks to the optimisation done below we get
 
         | Fable.Let(ident, value, body) ->
             let binding = transformBindingAsStatements com ctx ident value
+            let ctx = { ctx with BoundTypes = Map.add ident.Name ident.Type ctx.BoundTypes }
 
             Array.append binding (transformAsStatements com ctx returnStrategy body)
 
         | Fable.LetRec(bindings, body) ->
+            let ctx =
+                { ctx with
+                    BoundTypes =
+                        (ctx.BoundTypes, bindings)
+                        ||> List.fold (fun types (id, _) -> Map.add id.Name id.Type types)
+                }
+
             let bindings =
                 bindings
                 |> Seq.collect (fun (i, v) -> transformBindingAsStatements com ctx i v)
@@ -3419,6 +3454,9 @@ but thanks to the optimisation done below we get
             { ctx with
                 TailCallOpportunity = tailcallChance
                 OptimizeTailCall = fun () -> isTailCallOptimized <- true
+                BoundTypes =
+                    (ctx.BoundTypes, args)
+                    ||> List.fold (fun types id -> Map.add id.Name id.Type types)
             }
 
         let returnStrategy =
@@ -5052,6 +5090,7 @@ module Compiler =
                 TailCallOpportunity = None
                 OptimizeTailCall = fun () -> ()
                 ScopedTypeParams = Set.empty
+                BoundTypes = Map.empty
                 ForcedIdents = Set.empty
             }
 

src/Fable.Transforms/Python/Fable2Python.Transforms.fs

@@ -3374,8 +3374,15 @@ let transformFunction
                 args = [ Arg.arg (Identifier("__unit"), annotation = unitType) ],
                 defaults = [ unitDefault ]
             )
-        // No args but has tail-call args: skip __unit, tcArgs are sufficient
-        | [], _, _ -> Arguments.arguments (args = tcArgs, defaults = tcDefaults)
+        // invariant: a runtime unit argument never overwrites a captured TCO default
+        | [], _, _ ->
+            let unitType = com.GetImportExpr(ctx, getLibPath com "util", "Unit")
+            let unitName = getUniqueNameInDeclarationScope ctx "__unit"
+
+            Arguments.arguments (
+                args = Arg.arg (Identifier unitName, annotation = unitType) :: tcArgs,
+                defaults = unitDefault :: tcDefaults
+            )
         // Single generic/unit arg with no tail-call args: keep it with () default
         | [ arg ], true, [] -> Arguments.arguments (args = args, defaults = [ unitDefault ])
         // Single generic/unit arg with tail-call args: keep arg (body may reference it)

src/Fable.Transforms/Python/Replacements.fs

@@ -3675,6 +3675,13 @@ let asyncBuilder (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Exp
 
 let asyncs com (ctx: Context) r t (i: CallInfo) (_: Expr option) (args: Expr list) =
     match i.CompiledName with
+    | "FromContinuations" when
+        (match t with
+         | Fable.DeclaredType(_, [ Fable.Unit ]) -> true
+         | _ -> false)
+        ->
+        Helper.LibCall(com, "async_", "from_continuations_unit", t, args, i.SignatureArgTypes, ?loc = r)
+        |> Some
     | "Start" ->
         Helper.LibCall(com, "async_", "start", t, args, i.SignatureArgTypes, ?loc = r)
         |> Some

src/fable-library-py/fable_library/async_.py

@@ -188,6 +188,21 @@ def cont(ctx: IAsyncContext[T]) -> None:
     return protected_cont(cont)
 
 
+def from_continuations_unit(
+    f: Callable[
+        [tuple[Callable[[], None], Callable[[Exception], None], Callable[[OperationCanceledError], None]]],
+        None,
+    ],
+) -> Async[None]:
+    def cont(ctx: IAsyncContext[None]) -> None:
+        def success(value: None = None) -> None:
+            ctx.on_success(value)
+
+        f((success, ctx.on_error, ctx.on_cancel))
+
+    return protected_cont(cont)
+
+
 def await_task[T](task: Awaitable[T]) -> Async[T]:
     """Return an asynchronous computation that will wait for the given
     task to complete and return its result.

tests/Beam/AsyncTests.fs

@@ -757,3 +757,25 @@ let ``test Async.AwaitEvent with cancelAction invokes it on cancellation`` () =
     equal true cancelCalled
 
 #endif
+[<Fact>]
+let ``test FromContinuations unit and generic values`` () =
+    let fromValue value = Async.FromContinuations(fun (ok, _, _) -> ok value)
+    let mutable completed = 0
+    let unitWork: Async<unit> = Async.FromContinuations(fun (ok, _, _) -> ok ())
+    Async.StartWithContinuations(unitWork, (fun () -> completed <- completed + 1), raise, raise)
+    Async.StartWithContinuations(fromValue (), (fun () -> completed <- completed + 1), raise, raise)
+    Async.StartWithContinuations(fromValue 42, (fun value -> equal 42 value; completed <- completed + 1), raise, raise)
+    equal 3 completed
+
+[<Fact>]
+let ``test unit continuations preserve captured callbacks`` () =
+    let mutable calls = 0
+    let rec genericDeadline callback value remaining =
+        if remaining > 0 then genericDeadline callback value (remaining - 1)
+        else Async.StartWithContinuations(async { return value }, (fun result -> callback result), raise, raise)
+    let rec unitDeadline (callback: unit -> unit) remaining =
+        if remaining > 0 then unitDeadline callback (remaining - 1)
+        else Async.StartWithContinuations(async { return () }, (fun () -> callback ()), raise, raise)
+    genericDeadline (fun () -> calls <- calls + 1) () 2
+    unitDeadline (fun () -> calls <- calls + 1) 2
+    equal 2 calls

tests/Js/Main/AsyncTests.fs

@@ -47,6 +47,67 @@ let asyncMap f a = async {
 
 let tests =
   testList "Async" [
+    testCase "FromContinuations unit and generic values" <| fun () ->
+        let fromValue value = Async.FromContinuations(fun (ok, _, _) -> ok value)
+        let mutable completed = 0
+        let unitWork: Async<unit> = Async.FromContinuations(fun (ok, _, _) -> ok ())
+        Async.StartWithContinuations(unitWork, (fun () -> completed <- completed + 1), raise, raise)
+        Async.StartWithContinuations(fromValue (), (fun () -> completed <- completed + 1), raise, raise)
+        Async.StartWithContinuations(fromValue 42, (fun value -> equal 42 value; completed <- completed + 1), raise, raise)
+        equal 3 completed
+
+    testCase "Generic unit continuations work through recursive bindings and aliases" <| fun () ->
+        let mutable recurse = true
+        let rec fromValue value =
+            if recurse then
+                recurse <- false
+                fromValue value
+            else Async.FromContinuations(fun (ok, _, _) -> ok value)
+        let alias = fromValue
+        let mutable completed = 0
+        Async.StartWithContinuations(fromValue (), (fun () -> completed <- completed + 1), raise, raise)
+        recurse <- true
+        Async.StartWithContinuations(alias (), (fun () -> completed <- completed + 1), raise, raise)
+        Async.StartWithContinuations(alias 42, (fun value -> equal 42 value; completed <- completed + 1), raise, raise)
+        equal 3 completed
+
+    testCase "Generic unit continuations work through tuple pattern bindings" <| fun () ->
+        let fromValue, fromOther =
+            (fun (value: 'T) -> Async.FromContinuations(fun (ok, _, _) -> ok value)),
+            (fun (value: 'U) -> Async.FromContinuations(fun (ok, _, _) -> ok value))
+        let mutable completed = 0
+        Async.StartWithContinuations(fromValue (), (fun () -> completed <- completed + 1), raise, raise)
+        Async.StartWithContinuations(fromValue 42, (fun value -> equal 42 value; completed <- completed + 1), raise, raise)
+        Async.StartWithContinuations(fromOther (), (fun () -> completed <- completed + 1), raise, raise)
+        Async.StartWithContinuations(fromOther "a", (fun value -> equal "a" value; completed <- completed + 1), raise, raise)
+        equal 4 completed
+
+    testCase "Generic unit continuations work inside nested lambdas and object expressions" <| fun () ->
+        let fromValue value = Async.FromContinuations(fun (ok, _, _) -> ok value)
+        let mutable completed = 0
+        let startUnit () = Async.StartWithContinuations(fromValue (), (fun () -> completed <- completed + 1), raise, raise)
+        let disposable =
+            { new IDisposable with
+                member _.Dispose() =
+                    Async.StartWithContinuations(fromValue (), (fun () -> completed <- completed + 1), raise, raise) }
+        startUnit ()
+        startUnit ()
+        disposable.Dispose()
+        Async.StartWithContinuations(fromValue 42, (fun value -> equal 42 value; completed <- completed + 1), raise, raise)
+        equal 4 completed
+
+    testCase "Unit continuations preserve captured callbacks" <| fun () ->
+        let mutable calls = 0
+        let rec genericDeadline callback value remaining =
+            if remaining > 0 then genericDeadline callback value (remaining - 1)
+            else Async.StartWithContinuations(async { return value }, (fun result -> callback result), raise, raise)
+        let rec unitDeadline (callback: unit -> unit) remaining =
+            if remaining > 0 then unitDeadline callback (remaining - 1)
+            else Async.StartWithContinuations(async { return () }, (fun () -> callback ()), raise, raise)
+        genericDeadline (fun () -> calls <- calls + 1) () 2
+        unitDeadline (fun () -> calls <- calls + 1) 2
+        equal 2 calls
+
     testCase "Simple async translates without exception" <| fun () ->
         async { return () }
         |> Async.StartImmediate

tests/Python/TestAsync.fs

@@ -678,3 +678,31 @@ let ``test Async.AwaitEvent with cancelAction invokes it on cancellation`` () =
     }, cts.Token)
     cts.Cancel()
     equal true cancelCalled
+
+[<Fact>]
+let ``test FromContinuations unit and generic values`` () =
+    let fromValue value = Async.FromContinuations(fun (ok, _, _) -> ok value)
+    let mutable completed = 0
+    let unitWork: Async<unit> = Async.FromContinuations(fun (ok, _, _) -> ok ())
+    Async.StartWithContinuations(unitWork, (fun () -> completed <- completed + 1), raise, raise)
+    Async.StartWithContinuations(fromValue (), (fun () -> completed <- completed + 1), raise, raise)
+    Async.StartWithContinuations(fromValue 42, (fun value -> equal 42 value; completed <- completed + 1), raise, raise)
+    equal 3 completed
+
+[<Fact>]
+let ``test unit continuations preserve captured callbacks`` () =
+    let mutable calls = 0
+    let rec genericDeadline callback value remaining =
+        if remaining > 0 then genericDeadline callback value (remaining - 1)
+        else Async.StartWithContinuations(async { return value }, (fun result -> callback result), raise, raise)
+    let rec unitDeadline (callback: unit -> unit) remaining =
+        if remaining > 0 then unitDeadline callback (remaining - 1)
+        else Async.StartWithContinuations(async { return () }, (fun () -> callback ()), raise, raise)
+    genericDeadline (fun () -> calls <- calls + 1) () 2
+    unitDeadline (fun () -> calls <- calls + 1) 2
+    let rec namedUnitCapture (__unit: int) remaining =
+        if remaining > 0 then namedUnitCapture __unit (remaining - 1)
+        else Async.StartWithContinuations(async { return () }, (fun () -> calls <- calls + __unit), raise, raise)
+    namedUnitCapture 3 2
+    equal 5 calls
+