Skip to content
This repository
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

executable file 2678 lines (2285 sloc) 126.116 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677
// Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information.

#if FX_NO_CANCELLATIONTOKEN_CLASSES
namespace System
    open System
    open Microsoft.FSharp.Core
    open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
    open Microsoft.FSharp.Core.Operators
    open Microsoft.FSharp.Control
    open Microsoft.FSharp.Collections

    type [<Class>] AggregateException (exns : seq<exn>) =
        inherit Exception()
        let exnsList = new System.Collections.Generic.List<exn>(exns)
        member this.InnerExceptions = new System.Collections.ObjectModel.ReadOnlyCollection<exn>(exnsList :> System.Collections.Generic.IList<exn>)

namespace System.Threading
    #nowarn "864" // this is for typed Equals() in CancellationTokenRegistration and CancellationToken

    open System
    open Microsoft.FSharp.Core
    open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
    open Microsoft.FSharp.Core.Operators
    open Microsoft.FSharp.Control
    open Microsoft.FSharp.Collections
    
    
    module internal CancellationState =
        [<Literal>]
        let ACTIVE = 0
        [<Literal>]
        let DISPOSED_ACTIVE = 1
        [<Literal>]
        let CANCELED = 2
        [<Literal>]
        let DISPOSED_CANCELED = 3

    [<Struct>]
    [<CustomEquality; NoComparison>]
    type CancellationTokenRegistration =
            val private source : CancellationTokenSource
            val private id : int64
            
            internal new(source,id) = { source = source; id = id }
            
            member this.Dispose() =
                match this.source with
                | null -> ()
                | _ -> this.source.Deregister(this.id)
                    
            member this.Equals(ctr:CancellationTokenRegistration) =
                match this.source with
                | null -> ctr.source = null
                | _ -> this.source.Equals(ctr.source) && this.id = ctr.id
                
            override this.Equals(o:obj) =
                match o with
                | :? CancellationTokenRegistration as ctr -> this.Equals(ctr)
                | _ -> false
            
            override this.GetHashCode() =
                match this.source with
                | null -> 0
                | _ -> this.source.GetHashCode()^^^this.id.GetHashCode()
                
            static member (=) (left:CancellationTokenRegistration,right:CancellationTokenRegistration) = left.Equals(right)
            static member (<>) (left:CancellationTokenRegistration,right:CancellationTokenRegistration) = not (left.Equals(right))
            
            interface System.IDisposable with
                member this.Dispose() = this.Dispose()
                        
    and [<Struct>]
        [<CustomEquality; NoComparison>]
        CancellationToken =
        
            val private source : CancellationTokenSource
            
            internal new (source) = { source = source }
            
            member this.IsCancellationRequested =
                match this.source with
                | null -> false
                | source -> source.IsCancellationRequested
                
            member this.CanBeCanceled = this.source <> Unchecked.defaultof<_>
            
            member this.Register (action:Action<obj>, state:obj) =
                match this.source with
                | null -> Unchecked.defaultof<_>
                | source -> source.Register(action, state)
                    
            member this.Equals(ct:CancellationToken) =
                match this.source with
                | null -> ct.source = null
                | _ -> this.source.Equals(ct.source)
                
            override this.Equals(o:obj) =
                match o with
                | :? CancellationToken as ct -> this.Equals(ct)
                | _ -> false
            
            override this.GetHashCode() =
                match this.source with
                | null -> 0
                | _ -> this.source.GetHashCode()
                
            static member (=) (left:CancellationToken,right:CancellationToken) = left.Equals(right)
            static member (<>) (left:CancellationToken,right:CancellationToken) = not (left.Equals(right))
                    
            static member None = new CancellationToken(null)
                
    and [<Struct>]
        [<NoEquality; NoComparison>]
        internal CallbackInfo =
        val private id : int64
        val private action : Action<obj>
        val private state : obj
        
        new (id,action,state) = { id = id; action = action; state = state }
        
        member this.ID = this.id
        member this.Action = this.action
        member this.State = this.state
            
    and [<Class>][<Sealed>][<AllowNullLiteral>]
        CancellationTokenSource private (token1 : CancellationToken, token2 : CancellationToken) as this =
                        
            [<VolatileField>]
            let mutable state = CancellationState.ACTIVE
            
            // next registration id
            let mutable nextID = 0L;
            // lazily initialized list of registrations
            let registrations = lazy (new System.Collections.Generic.List<CallbackInfo>())
            
            // linking to tokens
            
            let mutable linkedCtr1 = Unchecked.defaultof<CancellationTokenRegistration>
            let mutable linkedCtr2 = Unchecked.defaultof<CancellationTokenRegistration>
            do
                let handler = Action<obj>(fun _ ->
                        // Avoinding a race for Dispose versus Cancel for linked token sources:
                        // - CTS.Dispose deregisters its CTRs and sets state to DISPOSED_*
                        // - However if the cancellation is in progress in the source it is linked to, deregistration is a no-op and CTS may still receive cancellation notification
                        // - That cancellation notification arrives in disposed state
                        // We ignore cancellation notifications from linked sources in disposed state (so if cancellation/disposal race happens, disposal wins).
                        this.Cancel(dontThrowIfDisposed = true)
                    )
                linkedCtr1 <- token1.Register(handler,null)
                linkedCtr2 <- token2.Register(handler,null)
                            
            public new() = new CancellationTokenSource(Unchecked.defaultof<_>,Unchecked.defaultof<_>)
            
            member this.Token = new CancellationToken(this)
            
            member this.Cancel() = this.Cancel(dontThrowIfDisposed = false)
            member private this.Cancel (dontThrowIfDisposed) : unit =
                let oldState = Interlocked.CompareExchange(&state, CancellationState.CANCELED, CancellationState.ACTIVE)
                match oldState with
                | CancellationState.ACTIVE ->
                    if registrations.IsValueCreated then // we have at least one registration
                        let list = registrations.Value
                        let toRun =
                            // building a list of callback to run, in LIFO order
                            lock list (fun () ->
                                let toRun = list |> Seq.fold (fun l info -> (fun () -> info.Action.Invoke(info.State))::l) []
                                list.Clear()
                                toRun)
                        let doRun l f = // run callback, add any thrown exception to the list
                            try f(); l
                            with e -> e::l
                        let exns = List.fold doRun [] toRun
                        match exns with
                        | [] -> ()
                        | _ ->
                            // exns are in reverse order to the callbacks in toRun
                            // we rev here; mainline case (no exceptions at all) runs without any allocations for exception list
                            new AggregateException(exns |> List.rev) |> raise
                    else () // no registrations - do nothing
                | CancellationState.CANCELED ->
                    () // cancellation already happened
                | _ ->
                    // DISPOSED_ACTIVE or DISPOSED_CANCELED
                    if not dontThrowIfDisposed then
                        new ObjectDisposedException(typeof<CancellationTokenSource>.FullName) |> raise
                    else ()
                
            member this.Dispose() =
                try
                    // Unregister from linked sources before changing state. Otherwise callback may still execute and we will be canceled in disposed state
                    // Multiple CTR disposal is a no-op
                    try
                        linkedCtr2.Dispose()
                    finally
                        linkedCtr1.Dispose()
                finally
                    let disposeNow =
                        let oldState = Interlocked.CompareExchange(&state, CancellationState.DISPOSED_ACTIVE, CancellationState.ACTIVE)
                        if oldState = CancellationState.ACTIVE then
                            true // previous state was ACTIVE, now disposing
                        else
                            let oldState = Interlocked.CompareExchange(&state, CancellationState.DISPOSED_CANCELED, CancellationState.CANCELED)
                            // if previous state was CANCELED, dispose now. Otherwise previous state was one of DISPOSED_* states, so already disposed
                            oldState = CancellationState.CANCELED
                    if disposeNow then
                        if registrations.IsValueCreated then
                            let list = registrations.Value
                            lock list (fun () -> list.Clear())
            
            member private this.InternalIsCanceled throwOnDisposed =
                match state with
                | CancellationState.ACTIVE -> false
                | CancellationState.CANCELED -> true
                | CancellationState.DISPOSED_CANCELED ->
                        if throwOnDisposed then
                            new ObjectDisposedException(typeof<CancellationTokenSource>.FullName) |> raise
                        else
                            true
                | _ ->
                        if throwOnDisposed then
                            new ObjectDisposedException(typeof<CancellationTokenSource>.FullName) |> raise
                        else
                            false

            
            member internal this.IsCancellationRequested = state = CancellationState.CANCELED || state = CancellationState.DISPOSED_CANCELED
            
            member internal this.Register(action:Action<obj>, state:obj) =
                if this.InternalIsCanceled true then // do not register, invoke immediately
                    action.Invoke(state)
                    Unchecked.defaultof<_>
                else
                    let list = registrations.Value
                    let invokeNow, r =
                        lock list (fun () ->
                            if this.InternalIsCanceled true then
                                true, new CancellationTokenRegistration(Unchecked.defaultof<_>, 0L)
                            else
                                let id = nextID
                                nextID <- nextID + 1L
                                list.Add(new CallbackInfo(id, action, state))
                                false, new CancellationTokenRegistration(this, id)
                        )
                    if invokeNow then action.Invoke(state)
                    r
            
            member internal this.Deregister(id) =
                if this.InternalIsCanceled false then // ok to deregister after Dispose
                    () // After cancellation is requested no deregistration needed;
                else
                    let list = registrations.Value
                    lock list (fun () ->
                        if this.InternalIsCanceled false then // ok to deregister after Dispose
                            ()
                        else
                            let index =
                                // Search backwards; we assume Register/Deregister are scoped
                                // so registered last will be deregistred first
                                let rec loop i =
                                    if i < 0 then (-1)
                                    else
                                        let callbackInfo = list.[i]
                                        if callbackInfo.ID = id then i
                                        else loop (i-1)
                                loop (list.Count - 1)
                            if index >= 0 then
                                list.RemoveAt(index)
                            else
                                () // we do not punish double deregistering
                    )
                 
            
            interface System.IDisposable with
                member this.Dispose() = this.Dispose()
            static member CreateLinkedTokenSource (token1:CancellationToken,token2:CancellationToken) =
                new CancellationTokenSource(token1,token2)
#endif

namespace Microsoft.FSharp.Control

    #nowarn "40"
    #nowarn "21"
    #nowarn "47"
    #nowarn "44" // This construct is deprecated.
    #nowarn "52" // The value has been copied to ensure the original is not mutated by this operation
    #nowarn "67" // This type test or downcast will always hold
    #nowarn "864" // IObservable.Subscribe
 
    open System
    open System.Diagnostics
    open System.Diagnostics.CodeAnalysis
    open System.Threading
    open System.IO
    open Microsoft.FSharp.Core
    open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
    open Microsoft.FSharp.Core.Operators
    open Microsoft.FSharp.Control
    open Microsoft.FSharp.Collections

#if FX_RESHAPED_REFLECTION
    open ReflectionAdapters
    type BindingFlags = ReflectionAdapters.BindingFlags
#else
    type BindingFlags = System.Reflection.BindingFlags
#endif

#if FX_NO_TASK
#else
    open System.Threading
    open System.Threading.Tasks
    
    //[<assembly:System.Runtime.CompilerServices.TypeForwardedTo(typeof<System.Threading.CancellationTokenRegistration>)>]
    //[<assembly:System.Runtime.CompilerServices.TypeForwardedTo(typeof<System.Threading.CancellationToken>)>]
    //[<assembly:System.Runtime.CompilerServices.TypeForwardedTo(typeof<System.Threading.CancellationTokenSource>)>]
    //do ()
#endif

#if FX_NO_OPERATION_CANCELLED
    type OperationCanceledException(s : System.String) =
        inherit System.Exception(s)
        new () = new OperationCanceledException("The operation has been canceled")
#endif

    


    /// We use our own internal implementation of queues to avoid a dependency on System.dll
    type Queue<'T>() = //: IEnumerable<T>, ICollection, IEnumerable
    
        let mutable array = [| |]
        let mutable head = 0
        let mutable size = 0
        let mutable tail = 0

        let SetCapacity(capacity) =
            let destinationArray = Array.zeroCreate capacity;
            if (size > 0) then
                if (head < tail) then
                    System.Array.Copy(array, head, destinationArray, 0, size);
        
                else
                    System.Array.Copy(array, head, destinationArray, 0, array.Length - head);
                    System.Array.Copy(array, 0, destinationArray, array.Length - head, tail);
            array <- destinationArray;
            head <- 0;
            tail <- if (size = capacity) then 0 else size;

        member x.Dequeue() =
            if (size = 0) then
                failwith "Dequeue"
            let local = array.[head];
            array.[head] <- Unchecked.defaultof<'T>
            head <- (head + 1) % array.Length;
            size <- size - 1;
            local

        member this.Enqueue(item) =
            if (size = array.Length) then
                let capacity = int ((int64 array.Length * 200L) / 100L);
                let capacity = max capacity (array.Length + 4)
                SetCapacity(capacity);
            array.[tail] <- item;
            tail <- (tail + 1) % array.Length;
            size <- size + 1

        member x.Count = size

    type LinkedSubSource(ct : CancellationToken) =
        
        let failureCTS = new CancellationTokenSource()
        let linkedCTS = CancellationTokenSource.CreateLinkedTokenSource(ct, failureCTS.Token)
        
        member this.Token = linkedCTS.Token
        member this.Cancel() = failureCTS.Cancel()
        member this.Dispose() =
            linkedCTS.Dispose()
            failureCTS.Dispose()
        
        interface IDisposable with
            member this.Dispose() = this.Dispose()

    
    // F# don't always take tailcalls to functions returning 'unit' because this
    // is represented as type 'void' in the underlying IL.
    // Hence we don't use the 'unit' return type here, and instead invent our own type.
    [<NoEquality; NoComparison>]
    type FakeUnitValue =
        | FakeUnit


    type cont<'T> = ('T -> FakeUnitValue)
    type econt = (exn -> FakeUnitValue)
    type ccont = (OperationCanceledException -> FakeUnitValue)



    //----------------------------------
    // PRIMITIVE ASYNC TRAMPOLINE

    [<AllowNullLiteral>]
    type Trampoline() =

        let mutable cont = None
        let mutable bindCount = 0
        
        static let unfake FakeUnit = ()

        [<Literal>]
        static let bindLimitBeforeHijack = 300
#if FX_NO_THREAD_STATIC
#else
        [<ThreadStatic>]
        [<DefaultValue>]
        static val mutable private thisThreadHasTrampoline : bool
#endif

        static member ThisThreadHasTrampoline =
#if FX_NO_THREAD_STATIC
            true
#else
            Trampoline.thisThreadHasTrampoline
#endif
        
        // Install a trampolineStack if none exists
        member this.ExecuteAction (firstAction : unit -> FakeUnitValue) =
            let rec loop action =
                action() |> unfake
                match cont with
                | None -> ()
                | Some newAction ->
                    cont <- None
                    loop newAction
#if FX_NO_THREAD_STATIC
#else
            let thisIsTopTrampoline =
                if Trampoline.thisThreadHasTrampoline then
                    false
                else
                    Trampoline.thisThreadHasTrampoline <- true
                    true
#endif
            try
                loop firstAction
            finally
#if FX_NO_THREAD_STATIC
                ()
#else
                if thisIsTopTrampoline then
                    Trampoline.thisThreadHasTrampoline <- false
#endif
            FakeUnit
            
        // returns true if time to jump on trampoline
        member this.IncrementBindCount() =
            bindCount <- bindCount + 1
            bindCount >= bindLimitBeforeHijack
            
        member this.Set action =
            match cont with
            | None ->
                    bindCount <- 0
                    cont <- Some action
            | _ -> failwith "Internal error: attempting to install continuation twice"


#if FSHARP_CORE_NETCORE_PORTABLE
    // Imitation of desktop functionality for .NETCore
    // 1. QueueUserWorkItem reimplemented as Task.Run
    // 2. Thread.CurrentThread type in the code is typically used to check if continuation is called on the same thread that initiated the async computation
    // if this condition holds we may decide to invoke continuation directly rather than queueing it.
    // Thread type here is barely a wrapper over CurrentManagedThreadId value - it should be enough to uniquely identify the actual thread

    [<NoComparison; NoEquality>]
    type internal WaitCallback = WaitCallback of (obj -> unit)

    type ThreadPool =
        static member QueueUserWorkItem(WaitCallback(cb), state : obj) =
            System.Threading.Tasks.Task.Run (fun () -> cb(state)) |> ignore
            true

    [<AllowNullLiteral>]
    type Thread(threadId : int) =
        static member CurrentThread = Thread(Environment.CurrentManagedThreadId)
        member this.ThreadId = threadId
        override this.GetHashCode() = threadId
        override this.Equals(other : obj) =
            match other with
            | :? Thread as other -> threadId = other.ThreadId
            | _ -> false

#endif

    type TrampolineHolder() as this =
        let mutable trampoline = null
        
        static let unfake FakeUnit = ()
        // preallocate context-switching callbacks
#if FX_NO_SYNC_CONTEXT
#else
        // Preallocate the delegate
        // This should be the only call to SynchronizationContext.Post in this library. We must always install a trampoline.
        let sendOrPostCallback =
                SendOrPostCallback(fun o ->
                    let f = unbox o : unit -> FakeUnitValue
                    this.Protect f |> unfake
                    )
#endif

        // Preallocate the delegate
        // This should be the only call to QueueUserWorkItem in this library. We must always install a trampoline.
        let waitCallbackForQueueWorkItemWithTrampoline =
                WaitCallback(fun o ->
                    let f = unbox o : unit -> FakeUnitValue
                    this.Protect f |> unfake
                    )

#if FX_NO_PARAMETERIZED_THREAD_START
#else
        // This should be the only call to Thread.Start in this library. We must always install a trampoline.
        let threadStartCallbackForStartThreadWithTrampoline =
                ParameterizedThreadStart(fun o ->
                    let f = unbox o : unit -> FakeUnitValue
                    this.Protect f |> unfake
                    )
#endif

#if FX_NO_SYNC_CONTEXT
#else
        member this.Post (ctxt: SynchronizationContext) (f : unit -> FakeUnitValue) =
            ctxt.Post (sendOrPostCallback, state=(f |> box))
            FakeUnit
#endif

        member this.QueueWorkItem (f: unit -> FakeUnitValue) =
                if not (ThreadPool.QueueUserWorkItem(waitCallbackForQueueWorkItemWithTrampoline, f |> box)) then
                    failwith "failed to queue user work item"
                FakeUnit
        
#if FX_NO_PARAMETERIZED_THREAD_START
        // This should be the only call to Thread.Start in this library. We must always install a trampoline.
        member this.StartThread (f : unit -> FakeUnitValue) =
#if FX_NO_THREAD
            this.QueueWorkItem(f)
#else
            (new Thread((fun _ -> this.Protect f |> unfake), IsBackground=true)).Start()
            FakeUnit
#endif

#else
        // This should be the only call to Thread.Start in this library. We must always install a trampoline.
        member this.StartThread (f : unit -> FakeUnitValue) =
            (new Thread(threadStartCallbackForStartThreadWithTrampoline,IsBackground=true)).Start(f|>box)
            FakeUnit
#endif
        
        member this.Protect firstAction =
            trampoline <- new Trampoline()
            trampoline.ExecuteAction(firstAction)
            
        member this.Trampoline = trampoline
        
    [<NoEquality; NoComparison>]
    [<AutoSerializable(false)>]
    type AsyncParamsAux =
        { token : CancellationToken;
          econt : econt;
          ccont : ccont;
          trampolineHolder : TrampolineHolder
        }
    
    [<NoEquality; NoComparison>]
    [<AutoSerializable(false)>]
    type AsyncParams<'T> =
        { cont : cont<'T>
          aux : AsyncParamsAux
        }
        
    [<NoEquality; NoComparison>]
    [<CompiledName("FSharpAsync`1")>]
    type Async<'T> =
        P of (AsyncParams<'T> -> FakeUnitValue)

    module AsyncBuilderImpl =
        // To consider: augment with more exception traceability information
        // To consider: add the ability to suspend running ps in debug mode
        // To consider: add the ability to trace running ps in debug mode
        open System
        open System.Threading
        open System.IO
        open Microsoft.FSharp.Core

        let fake () = FakeUnit
        let unfake FakeUnit = ()
        let ignoreFake _ = FakeUnit


        let defaultCancellationTokenSource = ref (new CancellationTokenSource())

        [<NoEquality; NoComparison>]
        type Result<'T> =
        | Ok of 'T
        | Error of exn
        | Canceled of OperationCanceledException

        let inline hijack (trampolineHolder:TrampolineHolder) res (cont : 'T -> FakeUnitValue) : FakeUnitValue =
            if trampolineHolder.Trampoline.IncrementBindCount() then
                trampolineHolder.Trampoline.Set(fun () -> cont res)
                FakeUnit
            else
                cont res

        // Apply f to x and call either the continuation or exception continuation depending what happens
        let inline protect (trampolineHolder:TrampolineHolder) econt f x (cont : 'T -> FakeUnitValue) : FakeUnitValue =
            // This is deliberately written in a allocation-free style, except when the trampoline is taken
            let mutable res = Unchecked.defaultof<_>
            let mutable exn = null
            try
                res <- f x
            with
                // Note: using a :? catch keeps FxCop happy
                | :? System.Exception as e ->
                    exn <- e
            match exn with
            | null ->
                // NOTE: this must be a tailcall
                hijack trampolineHolder res cont
            | exn ->
                // NOTE: this must be a tailcall
                hijack trampolineHolder exn econt

        // Apply f to x and call either the continuation or exception continuation depending what happens
        let inline protectNoHijack econt f x (cont : 'T -> FakeUnitValue) : FakeUnitValue =
            // This is deliberately written in a allocation-free style
            let mutable res = Unchecked.defaultof<_>
            let mutable exn = null
            try
                res <- f x
            with
                // Note: using a :? catch keeps FxCop happy
                | :? System.Exception as e ->
                    exn <- e
            match exn with
            | null ->
                // NOTE: this must be a tailcall
                cont res
            | exn ->
                // NOTE: this must be a tailcall
                econt exn



        // Reify exceptional results as exceptions
        let commit res =
            match res with
            | Ok res -> res
            | Error exn -> raise exn
            | Canceled exn -> raise exn

        // Reify exceptional results as exceptionsJIT 64 doesn't always take tailcalls correctly
        
        let commitWithPossibleTimeout res =
            match res with
            | None -> raise (System.TimeoutException())
            | Some res -> commit res


        //----------------------------------
        // PRIMITIVE ASYNC INVOCATION
        
        // Apply the underlying implementation of an async computation to its inputs
        let inline invokeA (P pf) args = pf args


        let startA cancellationToken trampolineHolder cont econt ccont p =
            let args =
                    { cont = cont
                        aux = { token = cancellationToken;
                                 econt = econt
                                 ccont = ccont
                                 trampolineHolder = trampolineHolder
                              }
                    }
            invokeA p args

                    
#if FX_NO_PARAMETERIZED_THREAD_START
        // Preallocate the delegate
        // This should be the only call to QueueUserWorkItem in this library. We must always install a trampoline.
        let waitCallbackForQueueWorkItemWithTrampoline(trampolineHolder : TrampolineHolder) =
                WaitCallback(fun o ->
                    let f = unbox o : unit -> FakeUnitValue
                    trampolineHolder.Protect f |> unfake
                    )
                    
        let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> FakeUnitValue) =
#if FX_NO_THREADPOOL
                if not (ThreadPool.QueueUserWorkItem((waitCallbackForQueueWorkItemWithTrampoline trampolineHolder), f |> box)) then
                    failwith "failed to queue user work item"
                FakeUnit
#else
            (new Thread((fun _ -> trampolineHolder.Protect f |> unfake), IsBackground=true)).Start()
            FakeUnit
#endif

#else

        // Statically preallocate the delegate
        let threadStartCallbackForStartThreadWithTrampoline =
                ParameterizedThreadStart(fun o ->
                    let (trampolineHolder,f) = unbox o : TrampolineHolder * (unit -> FakeUnitValue)
                    trampolineHolder.Protect f |> unfake
                    )

        // This should be the only call to Thread.Start in this library. We must always install a trampoline.
        let startThreadWithTrampoline (trampolineHolder:TrampolineHolder) (f : unit -> FakeUnitValue) =
            (new Thread(threadStartCallbackForStartThreadWithTrampoline,IsBackground=true)).Start((trampolineHolder,f)|>box)
            FakeUnit
#endif


        let startAsync cancellationToken cont econt ccont p =
            let trampolineHolder = new TrampolineHolder()
            trampolineHolder.Protect (fun () -> startA cancellationToken trampolineHolder cont econt ccont p)

        let queueAsync cancellationToken cont econt ccont p =
            let trampolineHolder = new TrampolineHolder()
            trampolineHolder.QueueWorkItem(fun () -> startA cancellationToken trampolineHolder cont econt ccont p)


        //----------------------------------
        // PRIMITIVE ASYNC CONSTRUCTORS
        
        // Call the exception continuation
        let errorT args exn =
            args.aux.econt exn

        // Call the cancellation continuation
        let cancelT (args:AsyncParams<_>) =
            args.aux.ccont (new OperationCanceledException())
                   
        // Build a primitive without any exception of resync protection
        //
        // Use carefully!!
        let unprotectedPrimitive f = P f

        let protectedPrimitiveCore args f =
            if args.aux.token.IsCancellationRequested then
                cancelT args
            else
                try f args
                with exn -> errorT args exn

        // When run, ensures that any exceptions raised by the immediate execution of "f" are
        // sent to the exception continuation.
        //
        let protectedPrimitive f =
            unprotectedPrimitive (fun args -> protectedPrimitiveCore args f)

        let reify res =
            unprotectedPrimitive (fun args ->
                match res with
                | Result.Ok r -> args.cont r
                | Result.Error e -> args.aux.econt e
                | Result.Canceled oce -> args.aux.ccont oce)

        //----------------------------------
        // BUILDER OPREATIONS

        // Generate async computation which calls its continuation with the given result
        let resultA x =
            unprotectedPrimitive (fun ({ aux = aux } as args) ->
                if aux.token.IsCancellationRequested then
                    cancelT args
                else
                    hijack aux.trampolineHolder x args.cont)
                    


        // The primitive bind operation. Generate a process that runs the first process, takes
        // its result, applies f and then runs the new process produced. Hijack if necessary and
        // run 'f' with exception protection
        let bindA p1 f =
            unprotectedPrimitive (fun args ->
                if args.aux.token.IsCancellationRequested then
                    cancelT args
                else

                    let args =
                        let cont a = protectNoHijack args.aux.econt f a (fun p2 -> invokeA p2 args)
                        { cont=cont;
                          aux = args.aux
                        }
                    // Trampoline the continuation onto a new work item every so often
                    let trampoline = args.aux.trampolineHolder.Trampoline
                    if trampoline.IncrementBindCount() then
                        trampoline.Set(fun () -> invokeA p1 args)
                        FakeUnit
                    else
                        // NOTE: this must be a tailcall
                        invokeA p1 args)


        // callA = "bindA (return x) f"
        let callA f x =
            unprotectedPrimitive (fun args ->
                if args.aux.token.IsCancellationRequested then
                    cancelT args
                else
                    protect args.aux.trampolineHolder args.aux.econt f x (fun p2 -> invokeA p2 args)
            )

        // delayPrim = "bindA (return ()) f"
        let delayA f = callA f ()

        // Call p but augment the normal, exception and cancel continuations with a call to finallyFunction.
        // If the finallyFunction raises an exception then call the original exception continuation
        // with the new exception. If exception is raised after a cancellation, exception is ignored
        // and cancel continuation is called.
        let tryFinallyA finallyFunction p =
            unprotectedPrimitive (fun args ->
                if args.aux.token.IsCancellationRequested then
                    cancelT args
                else
                    let trampolineHolder = args.aux.trampolineHolder
                    // The new continuation runs the finallyFunction and resumes the old continuation
                    // If an exception is thrown we continue with the previous exception continuation.
                    let cont b = protect trampolineHolder args.aux.econt finallyFunction () (fun () -> args.cont b)
                    // The new exception continuation runs the finallyFunction and then runs the previous exception continuation.
                    // If an exception is thrown we continue with the previous exception continuation.
                    let econt exn = protect trampolineHolder args.aux.econt finallyFunction () (fun () -> args.aux.econt exn)
                    // The cancellation continuation runs the finallyFunction and then runs the previous cancellation continuation.
                    // If an exception is thrown we continue with the previous cancellation continuation (the exception is lost)
                    let ccont cexn = protect trampolineHolder (fun _ -> args.aux.ccont cexn) finallyFunction () (fun () -> args.aux.ccont cexn)
                    invokeA p { args with cont = cont; aux = { args.aux with econt = econt; ccont = ccont } })

        // Re-route the exception continuation to call to catchFunction. If catchFunction or the new process fail
        // then call the original exception continuation with the failure.
        let tryWithA catchFunction p =
            unprotectedPrimitive (fun args ->
                if args.aux.token.IsCancellationRequested then
                    cancelT args
                else
                    let econt exn = invokeA (callA catchFunction exn) args
                    invokeA p { args with aux = { args.aux with econt = econt } })

        /// Send the given exception using the exception continuation
        let raiseA exn =
            unprotectedPrimitive (fun args ->
                errorT args (exn :> Exception))

        /// Call the finallyFunction if the computation results in a cancellation
        let whenCancelledA (finallyFunction : OperationCanceledException -> unit) p =
            unprotectedPrimitive (fun ({ aux = aux } as args)->
                let ccont exn = protect aux.trampolineHolder (fun _ -> aux.ccont exn) finallyFunction exn (fun _ -> aux.ccont exn)
                invokeA p { args with aux = { aux with ccont = ccont } })

        let getCancellationToken() =
            unprotectedPrimitive (fun ({ aux = aux } as args) -> args.cont aux.token)
        
        let gettrampolineHolder() =
            unprotectedPrimitive (fun ({ aux = aux } as args) -> args.cont aux.trampolineHolder)

        /// Return a unit result
        let doneA =
            resultA()

        /// Implement use/Dispose
        let usingA (r:'T :> IDisposable) f =
            tryFinallyA (fun () -> r.Dispose()) (callA f r)

        let ignoreA p =
            bindA p (fun _ -> doneA)

        /// Implement the while loop
        let rec whileA gd prog =
            if gd() then
                bindA prog (fun () -> whileA gd prog)
            else
                doneA

        /// Implement the for loop
        let rec forA (e: seq<_>) prog =
            usingA (e.GetEnumerator()) (fun ie ->
                whileA
                    (fun () -> ie.MoveNext())
                    (delayA(fun () -> prog ie.Current)))


        let sequentialA p1 p2 =
            bindA p1 (fun () -> p2)


    open AsyncBuilderImpl
    
    [<Sealed>]
    [<CompiledName("FSharpAsyncBuilder")>]
    type AsyncBuilder() =
        member b.Zero() = doneA
        member b.Delay(f) = delayA(f)
        member b.Return(x) = resultA(x)
        member b.ReturnFrom(x:Async<_>) = x
        member b.Bind(p1, p2) = bindA p1 p2
        member b.Using(g, p) = usingA g p
        member b.While(gd, prog) = whileA gd prog
        member b.For(e, prog) = forA e prog
        member b.Combine(p1, p2) = sequentialA p1 p2
        member b.TryFinally(p, cf) = tryFinallyA cf p
        member b.TryWith(p, cf) = tryWithA cf p

    module AsyncImpl =
        let async = AsyncBuilder()

        //----------------------------------
        // DERIVED SWITCH TO HELPERS

#if FX_NO_SYNC_CONTEXT
#else
        let switchTo (ctxt: SynchronizationContext) =
            protectedPrimitive(fun ({ aux = aux } as args) ->
                aux.trampolineHolder.Post ctxt (fun () -> args.cont () ))
#endif

        let switchToNewThread() =
            protectedPrimitive(fun ({ aux = aux } as args) ->
                aux.trampolineHolder.StartThread (fun () -> args.cont () ) )

        let switchToThreadPool() =
            protectedPrimitive(fun ({ aux = aux } as args) ->
                aux.trampolineHolder.QueueWorkItem (fun () -> args.cont ()) )

        //----------------------------------
        // DERIVED ASYNC RESYNC HELPERS

        let delimitContinuationsWith (delimiter : TrampolineHolder -> (unit -> FakeUnitValue) -> FakeUnitValue) ({ aux = aux } as args) =
            let trampolineHolder = aux.trampolineHolder
            { args with
                    cont = (fun x -> delimiter trampolineHolder (fun () -> args.cont x))
                    aux = { aux with
                                econt = (fun x -> delimiter trampolineHolder (fun () -> aux.econt x ));
                                ccont = (fun x -> delimiter trampolineHolder (fun () -> aux.ccont x))
                          }
            }

#if FX_NO_SYNC_CONTEXT
        let getSyncContext _ = null
        let delimitSyncContext args = args
        let postOrQueue _ (trampolineHolder:TrampolineHolder) f =
            trampolineHolder.QueueWorkItem f
#else
        let getSyncContext () = System.Threading.SynchronizationContext.Current
            
        let postOrQueue (ctxt : SynchronizationContext) (trampolineHolder:TrampolineHolder) f =
            match ctxt with
            | null -> trampolineHolder.QueueWorkItem f
            | _ -> trampolineHolder.Post ctxt f


        let delimitSyncContext args =
            match getSyncContext () with
            | null -> args
            | ctxt ->
                let aux = args.aux
                let trampolineHolder = aux.trampolineHolder
                { args with
                         cont = (fun x -> trampolineHolder.Post ctxt (fun () -> args.cont x))
                         aux = { aux with
                                     econt = (fun x -> trampolineHolder.Post ctxt (fun () -> aux.econt x ));
                                     ccont = (fun x -> trampolineHolder.Post ctxt (fun () -> aux.ccont x))
                               }
                }
                                    
#endif


        // When run, ensures that each of the continuations of the process are run in the same synchronization context.
        let protectedPrimitiveWithResync f =
            protectedPrimitive(fun args ->
                let args = delimitSyncContext args
                f args)

        let unprotectedPrimitiveWithResync f =
            unprotectedPrimitive(fun args ->
                let args = delimitSyncContext args
                f args)

        [<Sealed>]
        [<AutoSerializable(false)>]
        type Latch() =
            let mutable i = 0
            member this.Enter() = Interlocked.CompareExchange(&i, 1, 0) = 0

        [<Sealed>]
        [<AutoSerializable(false)>]
        type Once() =
            let latch = Latch()
            member this.Do f =
                if latch.Enter() then
                    f()

        [<Sealed>]
        [<AutoSerializable(false)>]
        type SuspendedAsync<'T>(args : AsyncParams<'T>) =
            let ctxt = getSyncContext ()
#if FX_NO_SYNC_CONTEXT
#else
            let thread =
                match ctxt with
                | null -> null // saving a thread-local access
                | _ -> Thread.CurrentThread
#endif
            let trampolineHolder = args.aux.trampolineHolder
            member this.ContinueImmediate res =
                let action () = args.cont res
                let inline executeImmediately () = trampolineHolder.Protect action
#if FX_NO_SYNC_CONTEXT
                executeImmediately ()
#else
                let currentCtxt = System.Threading.SynchronizationContext.Current
                match ctxt, currentCtxt with
                | null, null ->
                    executeImmediately ()
                // See bug 370350; this logic is incorrect from the perspective of how SynchronizationContext is meant to work,
                // but the logic works for mainline scenarios (WinForms/WPF/ASP.NET) and we won't change it again.
                | _ when Object.Equals(ctxt, currentCtxt) && thread.Equals(Thread.CurrentThread) ->
                        executeImmediately ()
                | _ ->
                    postOrQueue ctxt trampolineHolder action
#endif
                    
            member this.ContinueWithPostOrQueue res =
                postOrQueue ctxt trampolineHolder (fun () -> args.cont res)

            

        // A utility type to provide a synchronization point between an asynchronous computation
        // and callers waiting on the result of that computation.
        //
        // Use with care!
        [<Sealed>]
        [<AutoSerializable(false)>]
        type ResultCell<'T>() =
            let mutable result = None
            // The continuations for the result
            let mutable savedConts : list<SuspendedAsync<'T>> = []
            // The WaitHandle event for the result. Only created if needed, and set to null when disposed.
            let mutable resEvent = null
            let mutable disposed = false
            // All writers of result are protected by lock on syncRoot.
            let syncRoot = new Object()

            member x.GetWaitHandle() =
                lock syncRoot (fun () ->
                    if disposed then
                        raise (System.ObjectDisposedException("ResultCell"));
                    match resEvent with
                    | null ->
                        // Start in signalled state if a result is already present.
                        let ev = new ManualResetEvent(result.IsSome)
                        resEvent <- ev
                        (ev :> WaitHandle)
                    | ev ->
                        (ev :> WaitHandle))

            member x.Close() =
                lock syncRoot (fun () ->
                    if not disposed then
                        disposed <- true;
                        match resEvent with
                        | null -> ()
                        | ev ->
#if FX_EVENTWAITHANDLE_NO_IDISPOSABLE
                            ev.Dispose()
                            System.GC.SuppressFinalize(ev)
#else
                            ev.Close();
#endif
                            resEvent <- null)

            interface IDisposable with
                member x.Dispose() = x.Close() // ; System.GC.SuppressFinalize(x)


            member x.GrabResult() =
                match result with
                | Some res -> res
                | None -> failwith "Unexpected no result"


            /// Record the result in the ResultCell.
            member x.RegisterResult (res:'T, reuseThread) =
                let grabbedConts =
                    lock syncRoot (fun () ->
                        // Ignore multiple sets of the result. This can happen, e.g. for a race between a cancellation and a success
                        if x.ResultAvailable then
                            [] // invalidOp "multiple results registered for asynchronous operation"
                        else
                            // In this case the ResultCell has already been disposed, e.g. due to a timeout.
                            // The result is dropped on the floor.
                            if disposed then
                                []
                            else
                                result <- Some res;
                                // If the resEvent exists then set it. If not we can skip setting it altogether and it won't be
                                // created
                                match resEvent with
                                | null ->
                                    ()
                                | ev ->
                                    // Setting the event need to happen under lock so as not to race with Close()
                                    ev.Set () |> ignore
                                List.rev savedConts)
                // Run the action outside the lock
                match grabbedConts with
                | [] -> FakeUnit
                | [cont] ->
                        if reuseThread then
                            cont.ContinueImmediate(res)
                        else
                            cont.ContinueWithPostOrQueue(res)
                | otherwise ->
                        otherwise |> List.iter (fun cont -> cont.ContinueWithPostOrQueue(res) |> unfake) |> fake
            
            member x.ResultAvailable = result.IsSome

            member x.AwaitResult =
                unprotectedPrimitive(fun args ->
                    // Check if a result is available synchronously
                    let resOpt =
                        match result with
                        | Some _ -> result
                        | None ->
                                lock syncRoot (fun () ->
                                    match result with
                                    | Some _ ->
                                        result
                                    | None ->
                                        // Otherwise save the continuation and call it in RegisterResult
                                        savedConts <- (SuspendedAsync<_>(args))::savedConts
                                        None
                                )
                    match resOpt with
                    | Some res -> args.cont res
                    | None -> FakeUnit
                )

            member x.TryWaitForResultSynchronously (?timeout) : 'T option =
                // Check if a result is available.
                match result with
                | Some _ as r ->
                    r
                | None ->
                    // Force the creation of the WaitHandle
                    let resHandle = x.GetWaitHandle()
                    // Check again. While we were in GetWaitHandle, a call to RegisterResult may have set result then skipped the
                    // Set because the resHandle wasn't forced.
                    match result with
                    | Some _ as r ->
                        r
                    | None ->
                        // OK, let's really wait for the Set signal. This may block.
                        let timeout = defaultArg timeout Threading.Timeout.Infinite
#if FX_NO_EXIT_CONTEXT_FLAGS
#if FX_NO_WAITONE_MILLISECONDS
                        let ok = resHandle.WaitOne(TimeSpan(int64(timeout)*10000L))
#else
                        let ok = resHandle.WaitOne(millisecondsTimeout= timeout)
#endif
#else
                        let ok = resHandle.WaitOne(millisecondsTimeout= timeout,exitContext=true)
#endif
                        if ok then
                            // Now the result really must be available
                            result
                        else
                            // timed out
                            None

    open AsyncImpl
    
    type private Closure<'T>(f) =
        member x.Invoke(sender:obj, a:'T) : unit = ignore(sender); f(a)

    module CancellationTokenOps =
        /// Run the asynchronous workflow and wait for its result.
        let RunSynchronously (token:CancellationToken,computation,timeout) =
            let token,innerCTS =
                // If timeout is provided, we govern the async by our own CTS, to cancel
                // when execution times out. Otherwise, the user-supplied token governs the async.
                match timeout with
                | None -> token,None
                | Some _ ->
                        let subSource = new LinkedSubSource(token)
                        subSource.Token, Some subSource
                
            use resultCell = new ResultCell<Result<_>>()
            queueAsync
                    token
                    
                    (fun res -> resultCell.RegisterResult(Ok(res),reuseThread=true))
                    (fun exn -> resultCell.RegisterResult(Error(exn),reuseThread=true))
                    (fun exn -> resultCell.RegisterResult(Canceled(exn),reuseThread=true))
                    
                    computation
                |> unfake

            let res = resultCell.TryWaitForResultSynchronously(?timeout = timeout) in
            match res with
            | None -> // timed out
                // issue cancelaltion signal
                if innerCTS.IsSome then innerCTS.Value.Cancel()
                // wait for computation to quiesce; drop result on the floor
                resultCell.TryWaitForResultSynchronously() |> ignore
                // dispose the CancellationTokenSource
                if innerCTS.IsSome then innerCTS.Value.Dispose()
                raise (System.TimeoutException())
            | Some res ->
                match innerCTS with
                | Some subSource -> subSource.Dispose()
                | None -> ()
                commit res

        let Start (token:CancellationToken,computation) =
            queueAsync
                  token
                  (fun () -> FakeUnit) // nothing to do on success
                  (fun e -> raise e) // raise exception in child
                  (fun _ -> FakeUnit) // ignore cancellation in child
                  computation
               |> unfake

        let StartWithContinuations(token:CancellationToken, a:Async<'T>, cont, econt, ccont) : unit =
            startAsync token (cont >> fake) (econt >> fake) (ccont >> fake) a |> ignore
            
#if FX_NO_TASK
#else
        type VolatileBarrier() =
            [<VolatileField>]
            let mutable isStopped = false
            member __.Proceed = not isStopped
            member __.Stop() = isStopped <- true

        let StartAsTask (token:CancellationToken, computation : Async<_>,taskCreationOptions) : Task<_> =
            let taskCreationOptions = defaultArg taskCreationOptions TaskCreationOptions.None
            let tcs = new TaskCompletionSource<_>(taskCreationOptions)

            // The contract:
            // a) cancellation signal should always propagate to task
            // b) CancellationTokenSource that produced a token must not be disposed until the the task.IsComplete
            // We are:
            // 1) registering for cancellation signal here so that not to miss the signal
            // 2) disposing the registration just before setting result/exception on TaskCompletionSource -
            // otherwise we run a chance of disposing registration on already disposed CancellationTokenSource
            // (See (b) above)
            // 3) ensuring if reg is disposed, we do SetResult
            let barrier = VolatileBarrier()
            let reg = token.Register(fun _ -> if barrier.Proceed then tcs.SetCanceled())
            let task = tcs.Task
            let disposeReg() =
                barrier.Stop()
                if not (task.IsCanceled) then reg.Dispose()

            let a =
                async {
                    try
                        let! result = computation
                        do
                            disposeReg()
                            tcs.TrySetResult(result) |> ignore
                    with
                    | e ->
                            disposeReg()
                            tcs.TrySetException(e) |> ignore
                }
            Start(token, a)
            task
            
#endif
            

    [<Sealed>]
    [<CompiledName("FSharpAsync")>]
    type Async =
    
        static member CancellationToken = getCancellationToken()

        static member CancelCheck () = doneA

        static member FromContinuations (f : ('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) : Async<'T> =
            unprotectedPrimitive (fun ({ aux = aux } as args) ->
                if args.aux.token.IsCancellationRequested then
                    cancelT args
                else
                    let underCurrentThreadStack = ref true
                    let contToTailCall = ref None
                    let thread = Thread.CurrentThread
                    let latch = Latch()
                    let once cont x =
                        if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes))
                        if Thread.CurrentThread.Equals(thread) && !underCurrentThreadStack then
                            contToTailCall := Some(fun () -> cont x)
                        else if Trampoline.ThisThreadHasTrampoline then
                            let ctxt = getSyncContext()
                            postOrQueue ctxt aux.trampolineHolder (fun () -> cont x) |> unfake
                        else
                            aux.trampolineHolder.Protect (fun () -> cont x ) |> unfake
                    try
                        f (once args.cont, once aux.econt, once aux.ccont)
                    with exn ->
                        if not(latch.Enter()) then invalidOp(SR.GetString(SR.controlContinuationInvokedMultipleTimes))
                        aux.econt exn |> unfake
                    underCurrentThreadStack := false
                    match !contToTailCall with
                    | Some k -> k()
                    | _ -> FakeUnit
                    )
                
        static member DefaultCancellationToken = (!defaultCancellationTokenSource).Token

        static member CancelDefaultToken() =
            let cts = !defaultCancellationTokenSource
            // set new CancellationTokenSource before calling Cancel - otherwise if Cancel throws token will stay unchanged
            defaultCancellationTokenSource := new CancellationTokenSource()
            // we do not dispose the old default CTS - let GC collect it
            cts.Cancel()
            // we do not dispose the old default CTS - let GC collect it
            
        static member Catch (p: Async<'T>) =
            unprotectedPrimitive (fun ({ aux = aux } as args) ->
                startA aux.token aux.trampolineHolder (Choice1Of2 >> args.cont) (Choice2Of2 >> args.cont) aux.ccont p)

        static member RunSynchronously (p: Async<'T>,?timeout,?cancellationToken:CancellationToken) =
            let timeout,token =
                match cancellationToken with
                | None -> timeout,(!defaultCancellationTokenSource).Token
                | Some token when not token.CanBeCanceled -> timeout, token
                | Some token -> None, token
            CancellationTokenOps.RunSynchronously(token, p, timeout)

        static member Start (computation, ?cancellationToken) =
            let token = defaultArg cancellationToken (!defaultCancellationTokenSource).Token
            CancellationTokenOps.Start (token, computation)

#if FX_NO_TASK
#else
        static member StartAsTask (computation,?taskCreationOptions,?cancellationToken)=
            let token = defaultArg cancellationToken (!defaultCancellationTokenSource).Token
            CancellationTokenOps.StartAsTask(token,computation,taskCreationOptions)
        
        static member StartChildAsTask (computation,?taskCreationOptions) =
            async { let! token = getCancellationToken()
                    return CancellationTokenOps.StartAsTask(token,computation, taskCreationOptions) }
#endif

    type Async with
        static member Parallel (l: seq<Async<'T>>) =
            unprotectedPrimitive (fun args ->
                let tasks,result =
                    try Seq.toArray l, None // manually protect eval of seq
                    with exn -> null, Some(errorT args exn)
                match result with
                | Some r -> r
                | None ->
                if tasks.Length = 0 then args.cont [| |] else // must not be in a 'protect' if we call cont explicitly; if cont throws, it should unwind the stack, preserving Dev10 behavior
                protectedPrimitiveCore args (fun args ->
                    let ({ aux = aux } as args) = delimitSyncContext args // manually resync
                    let count = ref tasks.Length
                    let firstExn = ref None
                    let results = Array.zeroCreate tasks.Length
                    // Attept to cancel the individual operations if an exception happens on any the other threads
                    //let failureCTS = new CancellationTokenSource()
                    let innerCTS = new LinkedSubSource(aux.token)
                    let trampolineHolder = aux.trampolineHolder
                    
                    let finishTask(remaining) =
                        if (remaining = 0) then
                            innerCTS.Dispose()
                            match (!firstExn) with
                            | None -> trampolineHolder.Protect(fun () -> args.cont results)
                            | Some (Choice1Of2 exn) -> trampolineHolder.Protect(fun () -> aux.econt exn)
                            | Some (Choice2Of2 cexn) -> trampolineHolder.Protect(fun () -> aux.ccont cexn)
                        else
                            FakeUnit

                    // recordSuccess and recordFailure between them decrement count to 0 and
                    // as soon as 0 is reached dispose innerCancellationSource
                
                    let recordSuccess i res =
                        results.[i] <- res;
                        finishTask(Interlocked.Decrement count)

                    let recordFailure exn =
                        // capture first exception and then decrement the counter to avoid race when
                        // - thread 1 decremented counter and preempted by the scheduler
                        // - thread 2 decremented counter and called finishTask
                        // since exception is not yet captured - finishtask will fall into success branch
                        match Interlocked.CompareExchange(firstExn, Some exn, None) with
                        | None ->
                            // signal cancellation before decrementing the counter - this guarantees that no other thread can sneak to finishTask and dispose innerCTS
                            // NOTE: Cancel may introduce reentrancy - i.e. when handler registered for the cancellation token invokes cancel continuation that will call 'recordFailure'
                            // to correctly handle this we need to return decremented value, not the current value of 'count' otherwise we may invoke finishTask with value '0' several times
                            innerCTS.Cancel()
                        | _ -> ()
                        finishTask(Interlocked.Decrement count)
                
                    tasks |> Array.iteri (fun i p ->
                        queueAsync
                                innerCTS.Token
                                // on success, record the result
                                (fun res -> recordSuccess i res)
                                // on exception...
                                (fun exn -> recordFailure (Choice1Of2 exn))
                                // on cancellation...
                                (fun cexn -> recordFailure (Choice2Of2 cexn))
                                p
                            |> unfake);
                    FakeUnit))

#if FX_NO_TASK
#else
    // Contains helpers that will attach continuation to the given task.
    // Should be invoked as a part of protectedPrimitive(withResync) call
    module TaskHelpers =
        let continueWith (task : Task<'T>, ({ aux = aux } as args)) =
            let continuation (completedTask : Task<_>) : unit =
                aux.trampolineHolder.Protect((fun () ->
                    if completedTask.IsCanceled then
                        aux.ccont (new OperationCanceledException())
                    elif completedTask.IsFaulted then
                        aux.econt (upcast completedTask.Exception)
                    else
                        args.cont completedTask.Result)) |> unfake
            task.ContinueWith(Action<Task<'T>>(continuation), TaskContinuationOptions.None) |> ignore |> fake

        let continueWithUnit (task : Task, ({ aux = aux } as args)) =
            let continuation (completedTask : Task) : unit =
                aux.trampolineHolder.Protect((fun () ->
                    if completedTask.IsCanceled then
                        aux.ccont (new OperationCanceledException())
                    elif completedTask.IsFaulted then
                        aux.econt (upcast completedTask.Exception)
                    else
                        args.cont ())) |> unfake
            task.ContinueWith(Action<Task>(continuation), TaskContinuationOptions.None) |> ignore |> fake
#endif

#if FX_NO_REGISTERED_WAIT_HANDLES
    [<Sealed>]
    [<AutoSerializable(false)>]
    type internal WaitHandleIAsyncResult(wh : WaitHandle) =
        interface System.IAsyncResult with
            member this.AsyncState = null
            member this.AsyncWaitHandle = wh
            member this.IsCompleted =
#if FX_NO_WAITONE_MILLISECONDS
                wh.WaitOne(TimeSpan(0L))
#else
#if FX_NO_EXIT_CONTEXT_FLAGS
                wh.WaitOne(0)
#else
                wh.WaitOne(0,exitContext=false)
#endif
#endif
            member this.CompletedSynchronously = false // always reschedule
#endif

    type Async with

        static member StartWithContinuations(a:Async<'T>,cont,econt,ccont,?cancellationToken) : unit =
            let token = defaultArg cancellationToken (!defaultCancellationTokenSource).Token
            CancellationTokenOps.StartWithContinuations(token, a,cont,econt,ccont)

        static member StartImmediate(a:Async<unit>,?cancellationToken) : unit =
            Async.StartWithContinuations(a,id,raise,ignore,?cancellationToken=cancellationToken)

#if FSHARP_CORE_NETCORE_PORTABLE
        static member Sleep(dueTime : int) : Async<unit> =
            // use combo protectedPrimitiveWithResync + continueWith instead of AwaitTask so we can pass cancellation token to the Delay task
            unprotectedPrimitiveWithResync ( fun ({ aux = aux} as args) ->
                TaskHelpers.continueWithUnit(Task.Delay(dueTime, aux.token), args)
                )
#else
        static member Sleep(dueTime) : Async<unit> =
            unprotectedPrimitiveWithResync (fun ({ aux = aux } as args) ->
                let timer = ref (None : Timer option)
                let savedCont = args.cont
                let savedCCont = aux.ccont
                let latch = new Latch()
                let registration =
                    aux.token.Register(
                        (fun _ ->
                            if latch.Enter() then
                                match !timer with
                                | None -> ()
                                | Some t -> t.Dispose()
                                aux.trampolineHolder.Protect(fun () -> savedCCont(new OperationCanceledException())) |> unfake
                            ),
                        null)
                let mutable the_exn = null
                try
                    timer := new Timer((fun _ ->
                                        if latch.Enter() then
                                            // NOTE: If the CTS for the token would have been disposed, disposal of the registration would throw
                                            // However, our contract is that until async computation ceases execution (and invokes ccont)
                                            // the CTS will not be disposed. Execution of savedCCont is guarded by latch, so we are safe unless
                                            // user violates the contract.
                                            registration.Dispose()
                                            // Try to Dispose of the TImer.
                                            // Note: there is a race here: the System.Threading.Timer time very occasionally
                                            // calls the callback _before_ the timer object has been recorded anywhere. This makes it difficult to dispose the
                                            // timer in this situation. In this case we just let the timer be collected by finalization.
                                            match !timer with
                                            | None -> ()
                                            | Some t -> t.Dispose()
                                            // Now we're done, so call the continuation
                                            aux.trampolineHolder.Protect (fun () -> savedCont()) |> unfake),
                                     null, dueTime=dueTime, period = -1) |> Some
                with
                    exn -> if latch.Enter() then the_exn <- exn // post exception to econt only if we successfully enter the latch (no other continuations were called)
                match the_exn with
                | null ->
                    FakeUnit
                | exn ->
                    aux.econt exn
                )
#endif
        
        static member AwaitWaitHandle(waitHandle:WaitHandle,?millisecondsTimeout:int) =
            let millisecondsTimeout = defaultArg millisecondsTimeout Threading.Timeout.Infinite
            if millisecondsTimeout = 0 then
                async.Delay(fun () ->
#if FX_NO_EXIT_CONTEXT_FLAGS
#if FX_NO_WAITONE_MILLISECONDS
                    let ok = waitHandle.WaitOne(TimeSpan(0L))
#else
                    let ok = waitHandle.WaitOne(0)
#endif
#else
                    let ok = waitHandle.WaitOne(0,exitContext=false)
#endif
                    async.Return ok)
            else
#if FX_NO_REGISTERED_WAIT_HANDLES
                protectedPrimitiveWithResync(fun ({ aux = aux } as args) ->
                    // The .NET Compact Framework doesn't support RegisterWaitForSingleObject
                    
                    // Latch is used to protect entrance to the cancelHandler/actual continuation/error continuation
                    let latch = Latch()

                    let scont = args.cont
                    let ccont = aux.ccont

                    // cancel action
                    let cancel e =
                        if latch.Enter() then
                            Async.Start (async { do (ccont e |> unfake) })

                    // register cancellation handler
                    let registration = aux.token.Register((fun _ -> cancel (OperationCanceledException())), null)

                    // run actual await routine
                    // callback will be executed on the thread pool so we need to use TrampolineHolder.Protect to install trampoline
                    try
#if FX_NO_TASK
                        ThreadPool.QueueUserWorkItem((fun _ ->
                            let asyncResult = WaitHandleIAsyncResult(waitHandle) :> System.IAsyncResult
                            if asyncResult.IsCompleted then
                                if latch.Enter() then
                                    registration.Dispose()
                                    aux.trampolineHolder.Protect(fun () -> scont true)
                                    |> unfake
                        ), null) |> ignore
#else
                        Task.Factory.FromAsync
                            (
                                WaitHandleIAsyncResult(waitHandle),
                                fun _ ->
                                    if latch.Enter() then
                                        registration.Dispose()
                                        aux.trampolineHolder.Protect(fun () -> scont true)
                                        |> unfake
                            )
                            |> ignore
#endif
                        // if user has specified timeout different from Timeout.Infinite
                        // then start another async to track timeout expiration
                        if millisecondsTimeout <> Timeout.Infinite then
                            Async.StartWithContinuations
                                (
                                    a = (Async.Sleep millisecondsTimeout),
                                    cont = (fun () ->
                                        if latch.Enter() then
                                            registration.Dispose()
                                            aux.trampolineHolder.Protect(fun () -> scont false)
                                            |> unfake),
                                    econt = ignore, // we do not expect exceptions here
                                    ccont = cancel,
                                    cancellationToken = aux.token
                                )
                        FakeUnit
                    with e ->
                        if latch.Enter() then
                            registration.Dispose()
                            reraise() // exception will be intercepted by try..with in protectedPrimitiveWithResync
                        else FakeUnit
                    )

#else
                protectedPrimitiveWithResync(fun ({ aux = aux } as args) ->
                    let rwh = ref (None : RegisteredWaitHandle option)
                    let latch = Latch()
                    let rec cancelHandler =
                        Action<obj>(fun _ ->
                            if latch.Enter() then
                                // if we got here - then we need to unregister RegisteredWaitHandle + trigger cancellation
                                // entrance to TP callback is protected by latch - so savedCont will never be called
                                match !rwh with
                                | None -> ()
                                | Some rwh -> rwh.Unregister(null) |> ignore
                                Async.Start (async { do (aux.ccont (OperationCanceledException()) |> unfake) }))

                    and registration : CancellationTokenRegistration= aux.token.Register(cancelHandler, null)
                    
                    let savedCont = args.cont
                    try
                        rwh := Some(ThreadPool.RegisterWaitForSingleObject
                                      (waitObject=waitHandle,
                                       callBack=WaitOrTimerCallback(fun _ timeOut ->
                                                    if latch.Enter() then
                                                        rwh := None
                                                        registration.Dispose()
                                                        aux.trampolineHolder.Protect (fun () -> savedCont (not timeOut)) |> unfake),
                                       state=null,
                                       millisecondsTimeOutInterval=millisecondsTimeout,
                                       executeOnlyOnce=true));
                        FakeUnit
                    with _ ->
                        if latch.Enter() then reraise() // reraise exception only if we successfully enter the latch (no other continuations were called)
                        else FakeUnit
                    )
#endif

        static member AwaitIAsyncResult(iar: IAsyncResult, ?millisecondsTimeout): Async<bool> =
            async { if iar.CompletedSynchronously then
                        return true
                    else
                        return! Async.AwaitWaitHandle(iar.AsyncWaitHandle, ?millisecondsTimeout=millisecondsTimeout) }


        /// Await the result of a result cell without a timeout
        static member ReifyResult(result:Result<'T>) : Async<'T> =
            unprotectedPrimitive(fun ({ aux = aux } as args) ->
                   (match result with
                    | Ok v -> args.cont v
                    | Error exn -> aux.econt exn
                    | Canceled exn -> aux.ccont exn) )

        /// Await the result of a result cell without a timeout
        static member AwaitAndReifyResult(resultCell:ResultCell<Result<'T>>) : Async<'T> =
            async {
                let! result = resultCell.AwaitResult
                return! Async.ReifyResult(result)
            }
                    


        /// Await the result of a result cell without a timeout
        ///
        /// Always resyncs to the synchronization context if needed, by virtue of it being built
        /// from primitives which resync.
        static member AsyncWaitAsyncWithTimeout(innerCTS : CancellationTokenSource, resultCell:ResultCell<Result<'T>>,millisecondsTimeout) : Async<'T> =
            match millisecondsTimeout with
            | None | Some -1 ->
                resultCell |> Async.AwaitAndReifyResult

            | Some 0 ->
                async { if resultCell.ResultAvailable then
                            return commit (resultCell.GrabResult())
                        else
                            return commitWithPossibleTimeout None }
            | _ ->
                async { try
                           if resultCell.ResultAvailable then
                             return commit (resultCell.GrabResult())
                           else
                             let! ok = Async.AwaitWaitHandle (resultCell.GetWaitHandle(),?millisecondsTimeout=millisecondsTimeout)
                             if ok then
                                return commitWithPossibleTimeout (Some (resultCell.GrabResult()))
                             else // timed out
                                // issue cancellation signal
                                innerCTS.Cancel()
                                // wait for computation to queisce
                                let! _ = Async.AwaitWaitHandle (resultCell.GetWaitHandle())
                                return commitWithPossibleTimeout None
                         finally
                           resultCell.Close() }


        static member FromBeginEnd(beginAction,endAction,?cancelAction): Async<'T> =
            async { let! cancellationToken = getCancellationToken()
                    let resultCell = new ResultCell<_>()

                    let once = Once()
                    let registration : CancellationTokenRegistration =
                        let onCancel (_:obj) =
                            // Call the cancellation routine
                            match cancelAction with
                            | None ->
                                // Register the result. This may race with a sucessful result, but
                                // ResultCell allows a race and throws away whichever comes last.
                                once.Do(fun () ->
                                            let canceledResult = Canceled (OperationCanceledException())
                                            resultCell.RegisterResult(canceledResult,reuseThread=true) |> unfake
                                )
                            | Some cancel ->
                                // If we get an exception from a cooperative cancellation function
                                // we assume the operation has already completed.
                                try cancel() with _ -> ()
                        cancellationToken.Register(Action<obj>(onCancel), null)
                    let callback =
                        new System.AsyncCallback(fun iar ->
                                if not iar.CompletedSynchronously then
                                    // The callback has been activated, so ensure cancellation is not possible
                                    // beyond this point.
                                    match cancelAction with
                                    | Some _ ->
                                            registration.Dispose()
                                    | None ->
                                            once.Do(fun () -> registration.Dispose())
                                    // Run the endAction and collect its result.
                                    let res = try Ok(endAction iar) with e -> Error(e)
                                    // Register the result. This may race with a cancellation result, but
                                    // ResultCell allows a race and throws away whichever comes last.
                                    resultCell.RegisterResult(res,reuseThread=true) |> unfake
                                else ())
                                

                    
                    let (iar:IAsyncResult) = beginAction (callback,(null:obj))
                    if iar.CompletedSynchronously then
                        registration.Dispose()
                        return endAction iar
                    else
                        return! Async.AwaitAndReifyResult(resultCell) }


        static member FromBeginEnd(arg1,beginAction,endAction,?cancelAction): Async<'T> =
            Async.FromBeginEnd((fun (iar,state) -> beginAction(arg1,iar,state)), endAction, ?cancelAction=cancelAction)


        static member FromBeginEnd(arg1,arg2,beginAction,endAction,?cancelAction): Async<'T> =
            Async.FromBeginEnd((fun (iar,state) -> beginAction(arg1,arg2,iar,state)), endAction, ?cancelAction=cancelAction)

        static member FromBeginEnd(arg1,arg2,arg3,beginAction,endAction,?cancelAction): Async<'T> =
            Async.FromBeginEnd((fun (iar,state) -> beginAction(arg1,arg2,arg3,iar,state)), endAction, ?cancelAction=cancelAction)



    [<Sealed>]
    [<AutoSerializable(false)>]
    type AsyncIAsyncResult<'T>(callback: System.AsyncCallback,state:obj) =
         // This gets set to false if the result is not available by the
         // time the IAsyncResult is returned to the caller of Begin
         let mutable completedSynchronously = true

         let mutable disposed = false

         let cts = new CancellationTokenSource()

         let result = new ResultCell<Result<'T>>()

         member s.SetResult(v: Result<'T>) =
             result.RegisterResult(v,reuseThread=true) |> unfake
             match callback with
             | null -> ()
             | d ->
                 // The IASyncResult becomes observable here
                 d.Invoke (s :> System.IAsyncResult)

         member s.GetResult() =
             match result.TryWaitForResultSynchronously (-1) with
             | Some (Ok v) -> v
             | Some (Error err) -> raise err
             | Some (Canceled err) -> raise err
             | None -> failwith "unreachable"

         member x.IsClosed = disposed
         member x.Close() =
             if not disposed then
                 disposed <- true
                 cts.Dispose()
                 result.Close()
                 
         member x.Token = cts.Token

         member x.CancelAsync() = cts.Cancel()

         member x.CheckForNotSynchronous() =
             if not result.ResultAvailable then
                 completedSynchronously <- false

         interface System.IAsyncResult with
              member x.IsCompleted = result.ResultAvailable
              member x.CompletedSynchronously = completedSynchronously
              member x.AsyncWaitHandle = result.GetWaitHandle()
              member x.AsyncState = state

         interface System.IDisposable with
             member x.Dispose() = x.Close()
    
    module AsBeginEndHelpers =
        let beginAction(computation,callback,state) =
               let aiar = new AsyncIAsyncResult<'T>(callback,state)
               let cont v = aiar.SetResult (Ok v)
               let econt v = aiar.SetResult (Error v)
               let ccont v = aiar.SetResult (Canceled v)
               CancellationTokenOps.StartWithContinuations(aiar.Token,computation,cont,econt,ccont)
               aiar.CheckForNotSynchronous()
               (aiar :> IAsyncResult)
               
        let endAction<'T> (iar:IAsyncResult) =
               match iar with
               | :? AsyncIAsyncResult<'T> as aiar ->
                   if aiar.IsClosed then
                       raise (System.ObjectDisposedException("AsyncResult"))
                   else
                       let res = aiar.GetResult()
                       aiar.Close ()
                       res
               | _ ->
                   invalidArg "iar" (SR.GetString(SR.mismatchIAREnd))

        let cancelAction<'T>(iar:IAsyncResult) =
               match iar with
               | :? AsyncIAsyncResult<'T> as aiar ->
                   aiar.CancelAsync()
               | _ ->
                   invalidArg "iar" (SR.GetString(SR.mismatchIARCancel))


    type Async with

                   

        static member AsBeginEnd<'Arg,'T> (computation:('Arg -> Async<'T>)) :
                // The 'Begin' member
                ('Arg * System.AsyncCallback * obj -> System.IAsyncResult) *
                // The 'End' member
                (System.IAsyncResult -> 'T) *
                // The 'Cancel' member
                (System.IAsyncResult -> unit) =
                    let beginAction = fun (a1,callback,state) -> AsBeginEndHelpers.beginAction ((computation a1), callback, state)
                    beginAction, AsBeginEndHelpers.endAction<'T>, AsBeginEndHelpers.cancelAction<'T>

#if FX_NO_CREATE_DELEGATE
#else
        static member AwaitEvent(event:IEvent<'Delegate,'T>, ?cancelAction) : Async<'T> =
            async { let! token = getCancellationToken()
                    let resultCell = new ResultCell<_>()
                    // Set up the handlers to listen to events and cancellation
                    let once = new Once()
                    let rec registration : CancellationTokenRegistration=
                        let onCancel _ =
                            // We've been cancelled. Call the given cancellation routine
                            match cancelAction with
                            | None ->
                                // We've been cancelled without a cancel action. Stop listening to events
                                event.RemoveHandler(del)
                                // Register the result. This may race with a sucessful result, but
                                // ResultCell allows a race and throws away whichever comes last.
                                once.Do(fun () -> resultCell.RegisterResult(Canceled (OperationCanceledException()),reuseThread=true) |> unfake)
                            | Some cancel ->
                                // If we get an exception from a cooperative cancellation function
                                // we assume the operation has already completed.
                                try cancel() with _ -> ()
                        token.Register(Action<obj>(onCancel), null)
                    
                    and obj =
                        new Closure<'T>(fun eventArgs ->
                            // Stop listening to events
                            event.RemoveHandler(del)
                            // The callback has been activated, so ensure cancellation is not possible beyond this point
                            once.Do(fun () -> registration.Dispose())
                            let res = Ok(eventArgs)
                            // Register the result. This may race with a cancellation result, but
                            // ResultCell allows a race and throws away whichever comes last.
                            resultCell.RegisterResult(res,reuseThread=true) |> unfake)
                    and del =
#if FX_ATLEAST_PORTABLE
                        let invokeMeth = (typeof<Closure<'T>>).GetMethod("Invoke", BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance)
                        System.Delegate.CreateDelegate(typeof<'Delegate>, obj, invokeMeth) :?> 'Delegate
#else
                        System.Delegate.CreateDelegate(typeof<'Delegate>, obj, "Invoke") :?> 'Delegate
#endif
                    
                    // Start listening to events
                    event.AddHandler(del)

                    // Return the async computation that allows us to await the result
                    return! Async.AwaitAndReifyResult(resultCell) }
#endif

    type Async with
        static member Ignore (p: Async<'T>) = bindA p (fun _ -> doneA)
        static member SwitchToNewThread() = switchToNewThread()
        static member SwitchToThreadPool() = switchToThreadPool()

    type Async with

        static member StartChild (computation:Async<'T>,?millisecondsTimeout) =
            async {
                let resultCell = new ResultCell<_>()
                let! ct = getCancellationToken()
                let innerCTS = new CancellationTokenSource() // innerCTS does not require disposal
                let ctsRef = ref innerCTS
                let reg = ct.Register(
                                        (fun _ ->
                                            match !ctsRef with
                                            | null -> ()
                                            | otherwise -> otherwise.Cancel()),
                                        null)
                do queueAsync
                       innerCTS.Token
                       // since innerCTS is not ever Disposed, can call reg.Dispose() without a safety Latch
                       (fun res -> ctsRef := null; reg.Dispose(); resultCell.RegisterResult (Ok res, reuseThread=true))
                       (fun err -> ctsRef := null; reg.Dispose(); resultCell.RegisterResult (Error err,reuseThread=true))
                       (fun err -> ctsRef := null; reg.Dispose(); resultCell.RegisterResult (Canceled err,reuseThread=true))
                       
                       computation
                     |> unfake
                                               
                return Async.AsyncWaitAsyncWithTimeout(innerCTS, resultCell,millisecondsTimeout) }

#if FX_NO_SYNC_CONTEXT
#else

        static member SwitchToContext syncContext =
            async { match syncContext with
                    | null ->
                        // no synchronization context, just switch to the thread pool
                        do! Async.SwitchToThreadPool()
                    | ctxt ->
                        // post the continuation to the synchronization context
                        return! switchTo ctxt }
#endif

        static member OnCancel action =
            async { let! ct = getCancellationToken ()
                    // latch protects CancellationTokenRegistration.Dispose from being called twice
                    let latch = Latch()
                    let rec handler (_ : obj) =
                        try
                            if latch.Enter() then registration.Dispose()
                            action ()
                        with _ -> ()
                    and registration : CancellationTokenRegistration = ct.Register(Action<obj>(handler), null)
                    return { new System.IDisposable with
                                member this.Dispose() =
                                    // dispose CancellationTokenRegistration only if cancellation was not requested.
                                    // otherwise - do nothing, disposal will be performed by the handler itself
                                    if not ct.IsCancellationRequested then
                                        if latch.Enter() then registration.Dispose() } }

        static member TryCancelled (p: Async<'T>,f) =
            whenCancelledA f p

#if FX_NO_TASK
#else
        static member AwaitTask (task:Task<'T>) : Async<'T> =
            protectedPrimitiveWithResync (fun args ->
                TaskHelpers.continueWith(task, args)
                )
#endif

    module CommonExtensions =

        open AsyncBuilderImpl

        type System.IO.Stream with

            [<CompiledName("AsyncRead")>] // give the extension member a 'nice', unmangled compiled name, unique within this module
            member stream.AsyncRead(buffer: byte[],?offset,?count) =
                let offset = defaultArg offset 0
                let count = defaultArg count buffer.Length
#if FSHARP_CORE_NETCORE_PORTABLE
                // use combo protectedPrimitiveWithResync + continueWith instead of AwaitTask so we can pass cancellation token to the ReadAsync task
                protectedPrimitiveWithResync (fun ({ aux = aux } as args) ->
                    TaskHelpers.continueWith(stream.ReadAsync(buffer, offset, count, aux.token), args)
                    )
#else
                Async.FromBeginEnd (buffer,offset,count,stream.BeginRead,stream.EndRead)
#endif

            [<CompiledName("AsyncReadBytes")>] // give the extension member a 'nice', unmangled compiled name, unique within this module
            member stream.AsyncRead(count) =
                async { let buffer = Array.zeroCreate count
                        let i = ref 0
                        while !i < count do
                            let! n = stream.AsyncRead(buffer,!i,count - !i)
                            i := !i + n
                            if n = 0 then
                                raise(System.IO.EndOfStreamException(SR.GetString(SR.failedReadEnoughBytes)))
                        return buffer }
            
            [<CompiledName("AsyncWrite")>] // give the extension member a 'nice', unmangled compiled name, unique within this module
            member stream.AsyncWrite(buffer:byte[], ?offset:int, ?count:int) =
                let offset = defaultArg offset 0
                let count = defaultArg count buffer.Length
#if FSHARP_CORE_NETCORE_PORTABLE
                // use combo protectedPrimitiveWithResync + continueWith instead of AwaitTask so we can pass cancellation token to the WriteAsync task
                protectedPrimitiveWithResync ( fun ({ aux = aux} as args) ->
                    TaskHelpers.continueWithUnit(stream.WriteAsync(buffer, offset, count, aux.token), args)
                    )
#else
                Async.FromBeginEnd (buffer,offset,count,stream.BeginWrite,stream.EndWrite)
#endif
                
        type System.Threading.WaitHandle with
            member waitHandle.AsyncWaitOne(?millisecondsTimeout:int) = // only used internally, not a public API
                Async.AwaitWaitHandle(waitHandle,?millisecondsTimeout=millisecondsTimeout)

        type IObservable<'Args> with

            [<CompiledName("AddToObservable")>] // give the extension member a 'nice', unmangled compiled name, unique within this module
            member x.Add(f: 'Args -> unit) = x.Subscribe f |> ignore

            [<CompiledName("SubscribeToObservable")>] // give the extension member a 'nice', unmangled compiled name, unique within this module
            member x.Subscribe(f) =
                x.Subscribe { new IObserver<'Args> with
                                  member x.OnNext(args) = f args
                                  member x.OnError(e) = ()
                                  member x.OnCompleted() = () }

    module WebExtensions =
        open AsyncBuilderImpl

#if FX_NO_WEB_REQUESTS
#else
        
        type System.Net.WebRequest with
            [<CompiledName("AsyncGetResponse")>] // give the extension member a 'nice', unmangled compiled name, unique within this module
            member req.AsyncGetResponse() : Async<System.Net.WebResponse>=
                
                async { let canceled = ref false // WebException with Status = WebExceptionStatus.RequestCanceled can be raised in other situations except cancellation, use flag to filter out false positives
                        try
                            // Note that we specify req.Abort as the cancelAction. If successful, this will cause
                            // a WebExceptionStatus.RequestCanceled to be raised from the web request.
                           return! Async.FromBeginEnd(beginAction=req.BeginGetResponse,
                                                      endAction = req.EndGetResponse,
                                                      cancelAction = fun() -> canceled := true; req.Abort())
                        with
                           | :? System.Net.WebException as webExn
                                   when webExn.Status = System.Net.WebExceptionStatus.RequestCanceled && !canceled ->

                               return! Async.ReifyResult(Result.Canceled (OperationCanceledException webExn.Message)) }

#endif
     
#if FX_NO_WEB_CLIENT
#else
        
        type System.Net.WebClient with
            [<CompiledName("AsyncDownloadString")>] // give the extension member a 'nice', unmangled compiled name, unique within this module
            member this.AsyncDownloadString (address:Uri) : Async<string> =
                let downloadAsync =
                    Async.FromContinuations (fun (cont, econt, ccont) ->
                                let userToken = new obj()
                                let rec handler =
                                        System.Net.DownloadStringCompletedEventHandler (fun _ args ->
                                            if userToken = args.UserState then
                                                this.DownloadStringCompleted.RemoveHandler(handler)
                                                if args.Cancelled then
                                                    ccont (new OperationCanceledException())
                                                elif args.Error <> null then
                                                    econt args.Error
                                                else
                                                    cont args.Result)
                                this.DownloadStringCompleted.AddHandler(handler)
                                this.DownloadStringAsync(address, userToken)
                            )

                async {
                    use! _holder = Async.OnCancel(fun _ -> this.CancelAsync())
                    return! downloadAsync
                 }
#endif


    open CommonExtensions

    module AsyncHelpers =
        let awaitEither a1 a2 =
            async {
                let c = new ResultCell<_>()
                let! ct = Async.CancellationToken
                let start a f =
                    Async.StartWithContinuations(a,
                        (fun res -> c.RegisterResult(f res |> Result.Ok, reuseThread=false) |> unfake),
                        (fun e -> c.RegisterResult(e |> Result.Error, reuseThread=false) |> unfake),
                        (fun oce -> c.RegisterResult(oce |> Result.Canceled, reuseThread=false) |> unfake),
                        cancellationToken = ct
                        )
                start a1 Choice1Of2
                start a2 Choice2Of2
                let! result = c.AwaitResult
                return! reify result
            }
        let timeout msec cancellationToken =
            if msec < 0 then
                unprotectedPrimitive(fun _ -> FakeUnit) // "block" forever
            else
                let c = new ResultCell<_>()
                Async.StartWithContinuations(Async.Sleep(msec),
                    (fun () -> c.RegisterResult((), reuseThread = false) |> unfake),
                    (fun _ -> ()), (fun _ -> ()), cancellationToken = cancellationToken)
                c.AwaitResult

    [<Sealed>]
    [<AutoSerializable(false)>]
    type Mailbox<'Msg>() =
        let mutable inboxStore = null
        let mutable arrivals = new Queue<'Msg>()
        let syncRoot = arrivals

        // Control elements indicating the state of the reader. When the reader is "blocked" at an
        // asynchronous receive, either
        // -- "cont" is non-null and the reader is "activated" by re-scheduling cont in the thread pool; or
        // -- "pulse" is non-null and the reader is "activated" by setting this event
        let mutable savedCont : ((bool -> FakeUnitValue) * TrampolineHolder) option = None
        let mutable pulse : AutoResetEvent = null
        let ensurePulse() =
            match pulse with
            | null ->
                pulse <- new AutoResetEvent(false);
            | _ ->
                ()
            pulse
                
        let waitOneNoTimeout =
            unprotectedPrimitive (fun ({ aux = aux } as args) ->
                match savedCont with
                | None ->
                    let descheduled =
                        // An arrival may have happened while we're preparing to deschedule
                        lock syncRoot (fun () ->
                            if arrivals.Count = 0 then
                                // OK, no arrival so deschedule
                                savedCont <- Some(args.cont, aux.trampolineHolder);
                                true
                            else
                                false)
                    if descheduled then
                        FakeUnit
                    else
                        // If we didn't deschedule then run the continuation immediately
                        args.cont true
                | Some _ ->
                    failwith "multiple waiting reader continuations for mailbox")

        let waitOne(timeout) =
            if timeout < 0 then
                waitOneNoTimeout
            else
                ensurePulse().AsyncWaitOne(millisecondsTimeout=timeout)

        member x.inbox =
            match inboxStore with
            | null -> inboxStore <- new System.Collections.Generic.List<'Msg>(1) // ResizeArray
            | _ -> ()
            inboxStore

        member x.CurrentQueueLength =
            lock syncRoot (fun () -> x.inbox.Count + arrivals.Count)

        member x.scanArrivalsUnsafe(f) =
            if arrivals.Count = 0 then None
            else let msg = arrivals.Dequeue()
                 match f msg with
                 | None ->
                     x.inbox.Add(msg);
                     x.scanArrivalsUnsafe(f)
                 | res -> res
        // Lock the arrivals queue while we scan that
        member x.scanArrivals(f) = lock syncRoot (fun () -> x.scanArrivalsUnsafe(f))

        member x.scanInbox(f,n) =
            match inboxStore with
            | null -> None
            | inbox ->
                if n >= inbox.Count
                then None
                else
                    let msg = inbox.[n]
                    match f msg with
                    | None -> x.scanInbox (f,n+1)
                    | res -> inbox.RemoveAt(n); res

        member x.receiveFromArrivalsUnsafe() =
            if arrivals.Count = 0 then None
            else Some(arrivals.Dequeue())

        member x.receiveFromArrivals() =
            lock syncRoot (fun () -> x.receiveFromArrivalsUnsafe())

        member x.receiveFromInbox() =
            match inboxStore with
            | null -> None
            | inbox ->
                if inbox.Count = 0
                then None
                else
                    let x = inbox.[0]
                    inbox.RemoveAt(0);
                    Some(x)

        member x.Post(msg) =
            lock syncRoot (fun () ->
                arrivals.Enqueue(msg);
                // This is called when we enqueue a message, within a lock
                // We cooperatively unblock any waiting reader. If there is no waiting
                // reader we just leave the message in the incoming queue
                match savedCont with
                | None ->
                    match pulse with
                    | null ->
                        () // no one waiting, leaving the message in the queue is sufficient
                    | ev ->
                        // someone is waiting on the wait handle
                        ev.Set() |> ignore
                | Some(action,trampolineHolder) ->
                    savedCont <- None
                    trampolineHolder.QueueWorkItem(fun () -> action true) |> unfake)

        member x.TryScan ((f: 'Msg -> (Async<'T>) option), timeout) : Async<'T option> =
            let rec scan timeoutAsync (timeoutCts:CancellationTokenSource) =
                async { match x.scanArrivals(f) with
                        | None ->
                            // Deschedule and wait for a message. When it comes, rescan the arrivals
                            let! ok = AsyncHelpers.awaitEither waitOneNoTimeout timeoutAsync
                            match ok with
                            | Choice1Of2 true ->
                                return! scan timeoutAsync timeoutCts
                            | Choice1Of2 false ->
                                return failwith "should not happen - waitOneNoTimeout always returns true"
                            | Choice2Of2 () ->
                                lock syncRoot (fun () ->
                                    // Cancel the outstanding wait for messages installed by waitOneNoTimeout
                                    //
                                    // HERE BE DRAGONS. This is bestowed on us because we only support
                                    // a single mailbox reader at any one time.
                                    // If awaitEither returned control because timeoutAsync has terminated, waitOneNoTimeout
                                    // might still be in-flight. In practical terms, it means that the push-to-async-result-cell
                                    // continuation that awaitEither registered on it is still pending, i.e. it is still in savedCont.
                                    // That continuation is a no-op now, but it is still a registered reader for arriving messages.
                                    // Therefore we just abandon it - a brutal way of canceling.
                                    // This ugly non-compositionality is only needed because we only support a single mailbox reader
                                    // (i.e. the user is not allowed to run several Recieve/TryRecieve/Scan/TryScan in parallel) - otherwise
                                    // we would just have an extra no-op reader in the queue.
                                    savedCont <- None)

                                return None
                        | Some resP ->
                            timeoutCts.Cancel() // cancel the timeout watcher
                            let! res = resP
                            return Some res
                       }
            let rec scanNoTimeout () =
                async { match x.scanArrivals(f) with
                        | None -> let! ok = waitOneNoTimeout
                                    if ok then
                                        return! scanNoTimeout()
                                    else
                                        return (failwith "Timed out with infinite timeout??")
                        | Some resP ->
                            let! res = resP
                            return Some res
                }

            // Look in the inbox first
            async { match x.scanInbox(f,0) with
                    | None when timeout < 0 -> return! scanNoTimeout()
                    | None ->
                            let! ct = Async.CancellationToken
                            let timeoutCts = CancellationTokenSource.CreateLinkedTokenSource(ct, CancellationToken.None)
                            let timeoutAsync = AsyncHelpers.timeout timeout timeoutCts.Token
                            return! scan timeoutAsync timeoutCts
                    | Some resP ->
                            let! res = resP
                            return Some res

            }

        member x.Scan((f: 'Msg -> (Async<'T>) option), timeout) =
            async { let! resOpt = x.TryScan(f,timeout)
                    match resOpt with
                    | None -> return raise(TimeoutException(SR.GetString(SR.mailboxScanTimedOut)))
                    | Some res -> return res }


        member x.TryReceive(timeout) =
            let rec processFirstArrival() =
                async { match x.receiveFromArrivals() with
                        | None ->
                            // Wait until we have been notified about a message. When that happens, rescan the arrivals
                            let! ok = waitOne(timeout)
                            if ok then return! processFirstArrival()
                            else return None
                        | res -> return res }
            // look in the inbox first
            async { match x.receiveFromInbox() with
                    | None -> return! processFirstArrival()
                    | res -> return res }

        member x.Receive(timeout) =

            let rec processFirstArrival() =
                async { match x.receiveFromArrivals() with
                        | None ->
                            // Wait until we have been notified about a message. When that happens, rescan the arrivals
                            let! ok = waitOne(timeout)
                            if ok then return! processFirstArrival()
                            else return raise(TimeoutException(SR.GetString(SR.mailboxReceiveTimedOut)))
                        | Some res -> return res }
            // look in the inbox first
            async { match x.receiveFromInbox() with
                    | None -> return! processFirstArrival()
                    | Some res -> return res }

        interface System.IDisposable with
            member x.Dispose() =
                if pulse <> null then (pulse :> IDisposable).Dispose()

#if DEBUG
        member x.UnsafeContents =
            (x.inbox,arrivals,pulse,savedCont) |> box
#endif


    [<Sealed>]
    [<CompiledName("FSharpAsyncReplyChannel`1")>]
    type AsyncReplyChannel<'Reply>(replyf : 'Reply -> unit) =
        member x.Reply(reply) = replyf(reply)

    [<Sealed>]
    [<AutoSerializable(false)>]
    [<CompiledName("FSharpMailboxProcessor`1")>]
    type MailboxProcessor<'Msg>(initial, ?cancellationToken) =
        let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken
        let mailbox = new Mailbox<'Msg>()
        let mutable defaultTimeout = Threading.Timeout.Infinite
        let mutable started = false
        let errorEvent = new Event<System.Exception>()

        member x.CurrentQueueLength = mailbox.CurrentQueueLength // nb. unprotected access gives an approximation of the queue length

        member x.DefaultTimeout
            with get() = defaultTimeout
            and set(v) = defaultTimeout <- v

        [<CLIEvent>]
        member x.Error = errorEvent.Publish

#if DEBUG
        member x.UnsafeMessageQueueContents = mailbox.UnsafeContents
#endif
        member x.Start() =
            if started then
                raise (new InvalidOperationException(SR.GetString(SR.mailboxProcessorAlreadyStarted)))
            else
                started <- true

                // Protect the execution and send errors to the event
                let p = async { try
                                    do! initial x
                                with err ->
                                    errorEvent.Trigger err }

                Async.Start(computation=p, cancellationToken=cancellationToken)

        member x.Post(msg) = mailbox.Post(msg)

        member x.TryPostAndReply(msgf : (_ -> 'Msg), ?timeout) : 'Reply option =
            let timeout = defaultArg timeout defaultTimeout
            use resultCell = new ResultCell<_>()
            let msg = msgf (new AsyncReplyChannel<_>(fun reply ->
                                    // Note the ResultCell may have been disposed if the operation
                                    // timed out. In this case RegisterResult drops the result on the floor.
                                    resultCell.RegisterResult(reply,reuseThread=false) |> unfake))
            mailbox.Post(msg)
            resultCell.TryWaitForResultSynchronously(timeout=timeout)

        member x.PostAndReply(msgf, ?timeout) : 'Reply =
            match x.TryPostAndReply(msgf,?timeout=timeout) with
            | None -> raise (TimeoutException(SR.GetString(SR.mailboxProcessorPostAndReplyTimedOut)))
            | Some res -> res

        member x.PostAndTryAsyncReply(msgf, ?timeout) : Async<'Reply option> =
            let timeout = defaultArg timeout defaultTimeout
            let resultCell = new ResultCell<_>()
            let msg = msgf (new AsyncReplyChannel<_>(fun reply ->
                                    // Note the ResultCell may have been disposed if the operation
                                    // timed out. In this case RegisterResult drops the result on the floor.
                                    resultCell.RegisterResult(reply,reuseThread=false) |> unfake))
            mailbox.Post(msg)
            match timeout with
            | Threading.Timeout.Infinite ->
                    async { let! result = resultCell.AwaitResult
                            return Some(result)
                          }
                        
            | _ ->
                    async { use _disposeCell = resultCell
                            let! ok = resultCell.GetWaitHandle().AsyncWaitOne(millisecondsTimeout=timeout)
                            let res = (if ok then Some(resultCell.GrabResult()) else None)
                            return res }
                    
        member x.PostAndAsyncReply(msgf, ?timeout:int) =
            let timeout = defaultArg timeout defaultTimeout
            match timeout with
            | Threading.Timeout.Infinite ->
                    // Nothing to dispose, no wait handles used
                    let resultCell = new ResultCell<_>()
                    let msg = msgf (new AsyncReplyChannel<_>(fun reply -> resultCell.RegisterResult(reply,reuseThread=false) |> unfake))
                    mailbox.Post(msg)
                    resultCell.AwaitResult
            | _ ->
                    let asyncReply = x.PostAndTryAsyncReply(msgf,timeout=timeout)
                    async { let! res = asyncReply
                            match res with
                            | None -> return! raise (TimeoutException(SR.GetString(SR.mailboxProcessorPostAndAsyncReplyTimedOut)))
                            | Some res -> return res
                    }
                           
        member x.Receive(?timeout) = mailbox.Receive(timeout=defaultArg timeout defaultTimeout)
        member x.TryReceive(?timeout) = mailbox.TryReceive(timeout=defaultArg timeout defaultTimeout)
        member x.Scan(f: 'Msg -> (Async<'T>) option,?timeout) = mailbox.Scan(f,timeout=defaultArg timeout defaultTimeout)
        member x.TryScan(f: 'Msg -> (Async<'T>) option,?timeout) = mailbox.TryScan(f,timeout=defaultArg timeout defaultTimeout)

        interface System.IDisposable with
            member x.Dispose() = (mailbox :> IDisposable).Dispose()

        static member Start(initial,?cancellationToken) =
            let mb = new MailboxProcessor<'Msg>(initial,?cancellationToken=cancellationToken)
            mb.Start();
            mb

 
    [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
    [<RequireQualifiedAccess>]
    module Event =
        [<CompiledName("Create")>]
        let create<'T>() =
            let ev = new Event<'T>()
            ev.Trigger, ev.Publish

        [<CompiledName("Map")>]
        let map f (w: IEvent<'Delegate,'T>) =
            let ev = new Event<_>()
            w.Add(fun x -> ev.Trigger(f x));
            ev.Publish

        [<CompiledName("Filter")>]
        let filter f (w: IEvent<'Delegate,'T>) =
            let ev = new Event<_>()
            w.Add(fun x -> if f x then ev.Trigger x);
            ev.Publish

        [<CompiledName("Partition")>]
        let partition f (w: IEvent<'Delegate,'T>) =
            let ev1 = new Event<_>()
            let ev2 = new Event<_>()
            w.Add(fun x -> if f x then ev1.Trigger x else ev2.Trigger x);
            ev1.Publish,ev2.Publish

        [<CompiledName("Choose")>]
        let choose f (w: IEvent<'Delegate,'T>) =
            let ev = new Event<_>()
            w.Add(fun x -> match f x with None -> () | Some r -> ev.Trigger r);
            ev.Publish

        [<CompiledName("Scan")>]
        let scan f z (w: IEvent<'Delegate,'T>) =
            let state = ref z
            let ev = new Event<_>()
            w.Add(fun msg ->
                 let z = !state
                 let z = f z msg
                 state := z;
                 ev.Trigger(z));
            ev.Publish

        [<CompiledName("Add")>]
        let add f (w: IEvent<'Delegate,'T>) = w.Add(f)

        [<CompiledName("Pairwise")>]
        let pairwise (inp : IEvent<'Delegate,'T>) : IEvent<'T * 'T> =
            let ev = new Event<'T * 'T>()
            let lastArgs = ref None
            inp.Add(fun args2 ->
                (match !lastArgs with
                 | None -> ()
                 | Some args1 -> ev.Trigger(args1,args2));
                lastArgs := Some args2);

            ev.Publish

        [<CompiledName("Merge")>]
        let merge (w1: IEvent<'Del1,'T>) (w2: IEvent<'Del2,'T>) =
            let ev = new Event<_>()
            w1.Add(fun x -> ev.Trigger(x));
            w2.Add(fun x -> ev.Trigger(x));
            ev.Publish

        [<CompiledName("Split")>]
        let split (f : 'T -> Choice<'U1,'U2>) (w: IEvent<'Delegate,'T>) =
            let ev1 = new Event<_>()
            let ev2 = new Event<_>()
            w.Add(fun x -> match f x with Choice1Of2 y -> ev1.Trigger(y) | Choice2Of2 z -> ev2.Trigger(z));
            ev1.Publish,ev2.Publish


    [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
    [<RequireQualifiedAccess>]
    module Observable =
        let obs x = (x :> IObservable<_>)


        let inline protect f succeed fail =
          match (try Choice1Of2 (f ()) with e -> Choice2Of2 e) with
            | Choice1Of2 x -> (succeed x)
            | Choice2Of2 e -> (fail e)

        [<AbstractClass>]
        type BasicObserver<'T>() =
          let mutable stopped = false
          abstract Next : value : 'T -> unit
          abstract Error : error : exn -> unit
          abstract Completed : unit -> unit
          interface IObserver<'T> with
              member x.OnNext value = if not stopped then x.Next value
              member x.OnError e = if not stopped then stopped <- true
                                                       x.Error e
              member x.OnCompleted () = if not stopped then stopped <- true
                                                            x.Completed ()


(*
type AutoDetachObserver<'T>(o : IObserver<'T>, s : IObservable<System.IDisposable>) =
inherit BasicObserver<'T>()
override x.Next v = o.OnNext v
override x.Error e = o.OnError e
s.Add (fun d -> d.Dispose())
override x.Completed () = o.OnCompleted ()
s.Add (fun d -> d.Dispose())
type MyObservable<'T>() =
abstract MySubscribe : observer : IObserver<'T> -> System.IDisposable
interface IObservable<'T>
member x.Subscribe o = let (t, s) = create<System.IDisposable> ()
let ado = new AutoDetachObserver<'T>(o, s)
let d = x.MySubscribe ado
t d
d
*)

        [<CompiledName("Map")>]
        let map f (w: IObservable<'T>) =
            { new IObservable<'U> with
                 member x.Subscribe(observer) =
                     w.Subscribe { new BasicObserver<'T>() with
                                        member x.Next(v) =
                                            protect (fun () -> f v) observer.OnNext observer.OnError
                                        member x.Error(e) = observer.OnError(e)
                                        member x.Completed() = observer.OnCompleted() } }

        [<CompiledName("Choose")>]
        let choose f (w: IObservable<'T>) =
            { new IObservable<'U> with
                 member x.Subscribe(observer) =
                     w.Subscribe { new BasicObserver<'T>() with
                                        member x.Next(v) =
                                            protect (fun () -> f v) (function None -> () | Some v2 -> observer.OnNext v2) observer.OnError
                                        member x.Error(e) = observer.OnError(e)
                                        member x.Completed() = observer.OnCompleted() } }

        [<CompiledName("Filter")>]
        let filter f (w: IObservable<'T>) =
            choose (fun x -> if f x then Some x else None) w

        [<CompiledName("Partition")>]
        let partition f (w: IObservable<'T>) =
            filter f w, filter (f >> not) w


        [<CompiledName("Scan")>]
        let scan f z (w: IObservable<'T>) =
            { new IObservable<'U> with
                 member x.Subscribe(observer) =
                     let state = ref z
                     w.Subscribe { new BasicObserver<'T>() with
                                        member x.Next(v) =
                                            let z = !state
                                            protect (fun () -> f z v) (fun z ->
                                                state := z
                                                observer.OnNext z) observer.OnError
                                            
                                        member x.Error(e) = observer.OnError(e)
                                        member x.Completed() = observer.OnCompleted() } }

        [<CompiledName("Add")>]
        let add f (w: IObservable<'T>) = w.Add(f)

        [<CompiledName("Subscribe")>]
        let subscribe (f: 'T -> unit) (w: IObservable<'T>) = w.Subscribe(f)

        [<CompiledName("Pairwise")>]
        let pairwise (w : IObservable<'T>) : IObservable<'T * 'T> =
            { new IObservable<_> with
                 member x.Subscribe(observer) =
                     let lastArgs = ref None
                     w.Subscribe { new BasicObserver<'T>() with
                                        member x.Next(args2) =
                                            match !lastArgs with
                                            | None -> ()
                                            | Some args1 -> observer.OnNext (args1,args2)
                                            lastArgs := Some args2
                                        member x.Error(e) = observer.OnError(e)
                                        member x.Completed() = observer.OnCompleted() } }


        [<CompiledName("Merge")>]
        let merge (w1: IObservable<'T>) (w2: IObservable<'T>) =
            { new IObservable<_> with
                 member x.Subscribe(observer) =
                     let stopped = ref false
                     let completed1 = ref false
                     let completed2 = ref false
                     let h1 =
                         w1.Subscribe { new IObserver<'T> with
                                            member x.OnNext(v) =
                                                    if not !stopped then
                                                        observer.OnNext v
                                            member x.OnError(e) =
                                                    if not !stopped then
                                                        stopped := true;
                                                        observer.OnError(e)
                                            member x.OnCompleted() =
                                                    if not !stopped then
                                                        completed1 := true;
                                                        if !completed1 && !completed2 then
                                                            stopped := true
                                                            observer.OnCompleted() }
                     let h2 =
                         w2.Subscribe { new IObserver<'T> with
                                            member x.OnNext(v) =
                                                    if not !stopped then
                                                        observer.OnNext v
                                            member x.OnError(e) =
                                                    if not !stopped then
                                                        stopped := true;
                                                        observer.OnError(e)
                                            member x.OnCompleted() =
                                                    if not !stopped then
                                                        completed2 := true;
                                                        if !completed1 && !completed2 then
                                                            stopped := true
                                                            observer.OnCompleted() }

                     { new IDisposable with
                           member x.Dispose() =
                               h1.Dispose();
                               h2.Dispose() } }

        [<CompiledName("Split")>]
        let split (f : 'T -> Choice<'U1,'U2>) (w: IObservable<'T>) =
            choose (fun v -> match f v with Choice1Of2 x -> Some x | _ -> None) w,
            choose (fun v -> match f v with Choice2Of2 x -> Some x | _ -> None) w

Something went wrong with that request. Please try again.