Merge branch 'develop' into queryt-optimization

Author: luigy

.travis.yml

@@ -98,6 +98,10 @@ Since MonadHold depends on MonadSample, any [S] function also runs in [H] contex
 [ ]   <>   :: Monoid a => Behavior a ->        Behavior a -> Behavior a
 -- ... plus many more due to typeclass membership
 
+-- Combine multiple behaviors via applicative instance
+[ ]   ffor2 :: Behavior a -> Behavior b ->               (a -> b -> c)      -> Behavior c
+[ ]   ffor3 :: Behavior a -> Behavior b -> Behavior c -> (a -> b -> c -> d) -> Behavior d
+
 -- Behavior to Behavior by sampling current values
 [S]   sample :: Behavior a -> m a
 [ ]   pull   ::               m a -> Behavior a
@@ -135,6 +139,10 @@ Since MonadHold depends on MonadSample, any [S] function also runs in [H] contex
 [ ]   >>=                       ::                  Dynamic a -> (a -> Dynamic b) -> Dynamic b
 [ ]   zipDynWith                :: (a -> b -> c) -> Dynamic a -> Dynamic b        -> Dynamic c
 
+-- Combine multiple dynamics via applicative instance
+[ ]   ffor2 :: Dynamic a -> Dynamic b ->              (a -> b -> c)      -> Dynamic c
+[ ]   ffor3 :: Dynamic a -> Dynamic b -> Dynamic c -> (a -> b -> c -> d) -> Dynamic d
+
 -- Efficient one-to-many fanout
 [ ]   demux   :: Ord k => Dynamic k -> Demux k
 [ ]   demuxed :: Eq k  =>              Demux k -> k -> Dynamic Bool
@@ -284,3 +292,20 @@ Th typeclasses and their associated annotations include:
 [P,T]   delay :: NominalDiffTime -> Event t a -> m (Event t a)
 ```
 
+## Networks
+
+```haskell
+-- Functions from Reflex.Network used to deal with Dynamics/Events carrying (m a)
+
+-- Given a Dynamic of network-creating actions, create a network that is recreated whenever the Dynamic updates. 
+-- The returned Event of network results occurs when the Dynamic does. Note: Often, the type a is an Event, 
+-- in which case the return value is an Event-of-Events that would typically be flattened (via switchHold).
+[P,A]   networkView :: Dynamic (m a) -> m (Event a) 
+
+-- Given an initial network and an Event of network-creating actions, create a network that is recreated whenever the 
+-- Event fires. The returned Dynamic of network results occurs when the Event does. Note: Often, the type a is an 
+-- Event, in which case the return value is a Dynamic-of-Events that would typically be flattened.
+[H,A]   networkHold :: m a -> Event (m a) -> m (Dynamic a) 
+
+-- Render a placeholder network to be shown while another network is not yet done building
+[P,A]   untilReady :: m a -> m b -> m (a, Event b) 

Quickref.md

@@ -42,7 +42,7 @@ typedef struct Task_ {
     // or just continue immediately.  It's a workaround for the fact
     // that signalling a condition variable doesn't do anything if the
     // thread is already running, but we want it to be sticky.
-    rtsBool wakeup;
+    HsBool wakeup;
 #endif
 
     // This points to the Capability that the Task "belongs" to.  If
@@ -62,14 +62,14 @@ typedef struct Task_ {
     // The current top-of-stack InCall
     struct InCall_ *incall;
 
-    nat n_spare_incalls;
+    uint32_t n_spare_incalls;
     struct InCall_ *spare_incalls;
 
-    rtsBool    worker;          // == rtsTrue if this is a worker Task
-    rtsBool    stopped;         // this task has stopped or exited Haskell
+    HsBool    worker;          // == rtsTrue if this is a worker Task
+    HsBool    stopped;         // this task has stopped or exited Haskell
 
     // So that we can detect when a finalizer illegally calls back into Haskell
-    rtsBool running_finalizers;
+    HsBool running_finalizers;
 
     // Links tasks on the returning_tasks queue of a Capability, and
     // on spare_workers.
@@ -88,7 +88,7 @@ struct Capability_ {
     StgFunTable f;
     StgRegTable r;
 
-    nat no;  // capability number.
+    uint32_t no;  // capability number.
 
     // The Task currently holding this Capability.  This task has
     // exclusive access to the contents of this Capability (apart from
@@ -98,12 +98,12 @@ struct Capability_ {
 
     // true if this Capability is running Haskell code, used for
     // catching unsafe call-ins.
-    rtsBool in_haskell;
+    HsBool in_haskell;
 
     // Has there been any activity on this Capability since the last GC?
-    nat idle;
+    uint32_t idle;
 
-    rtsBool disabled;
+    HsBool disabled;
 
     // The run queue.  The Task owning this Capability has exclusive
     // access to its run queue, so can wake up threads without
@@ -159,7 +159,7 @@ struct Capability_ {
 #if defined(THREADED_RTS)
     // Worker Tasks waiting in the wings.  Singly-linked.
     Task *spare_workers;
-    nat n_spare_workers; // count of above
+    uint32_t n_spare_workers; // count of above
 
     // This lock protects:
     //    running_task
@@ -192,10 +192,9 @@ struct Capability_ {
 
     // Per-capability STM-related data
     StgTVarWatchQueue *free_tvar_watch_queues;
-    StgInvariantCheckQueue *free_invariant_check_queues;
     StgTRecChunk *free_trec_chunks;
     StgTRecHeader *free_trec_headers;
-    nat transaction_tokens;
+    uint32_t transaction_tokens;
 } // typedef Capability is defined in RtsAPI.h
   // We never want a Capability to overlap a cache line with anything
   // else, so round it up to a cache line size:

bench-cbits/checkCapability.c

@@ -20,6 +20,7 @@ import qualified Data.Dependent.Map as DMap
 import Data.Dependent.Sum
 import Data.Functor.Misc
 import Data.IORef
+import Data.Maybe (fromJust)
 import Reflex
 import Reflex.Host.Class
 
@@ -70,7 +71,7 @@ micros =
   , withSetupWHNF "fireEventsOnly"
     (newEventWithTriggerRef >>= subscribePair)
     (\(_, trigger) -> do
-        Just key <- liftIO $ readIORef trigger
+        key <- fromJust <$> liftIO (readIORef trigger)
         fireEvents [key :=> Identity (42 :: Int)])
   , withSetupWHNF "fireEventsAndRead(head/merge1)"
     (setupMerge 1 >>= subscribePair)
@@ -84,26 +85,26 @@ micros =
   , withSetupWHNF "fireEventsOnly(head/merge100)"
     (setupMerge 100 >>= subscribePair)
     (\(_, t:_) -> do
-        Just key <- liftIO $ readIORef t
+        key <- fromJust <$> liftIO (readIORef t)
         fireEvents [key :=> Identity (42 :: Int)])
   , withSetupWHNF "hold" newEventWithTriggerRef $ \(ev, _) -> hold (42 :: Int) ev
   , withSetupWHNF "sample" (newEventWithTriggerRef >>= hold (42 :: Int) . fst) sample
   ]
 
 setupMerge :: Int
-           -> SpiderHost Global ( Event (SpiderEnv Global) (DMap (Const2 Int a) Identity)
+           -> SpiderHost Global ( Event (SpiderTimeline Global) (DMap (Const2 Int a) Identity)
                                 , [IORef (Maybe (EventTrigger Spider a))]
                                 )
 setupMerge num = do
   (evs, triggers) <- unzip <$> replicateM num newEventWithTriggerRef
   let !m = DMap.fromList [Const2 i :=> v | (i,v) <- zip [0..] evs]
   pure (merge m, triggers)
 
-subscribePair :: (Event (SpiderEnv Global) a, b) -> SpiderHost Global (EventHandle (SpiderEnv Global) a, b)
+subscribePair :: (Event (SpiderTimeline Global) a, b) -> SpiderHost Global (EventHandle (SpiderTimeline Global) a, b)
 subscribePair (ev, b) = (,b) <$> subscribeEvent ev
 
-fireAndRead :: IORef (Maybe (EventTrigger (SpiderEnv Global) a)) -> a -> EventHandle (SpiderEnv Global) b
+fireAndRead :: IORef (Maybe (EventTrigger (SpiderTimeline Global) a)) -> a -> EventHandle (SpiderTimeline Global) b
             -> SpiderHost Global (Maybe b)
 fireAndRead trigger val subd = do
-  Just key <- liftIO $ readIORef trigger
+  key <- fromJust <$> liftIO (readIORef trigger)
   fireEventsAndRead [key :=> Identity val] $ readEvent subd >>= sequence

bench/Main.hs

@@ -136,7 +136,7 @@ benchmarks = implGroup "spider" runSpiderHost cases
 pattern RunTestCaseFlag = "--run-test-case"
 
 spawnBenchmark :: String -> Benchmark
-spawnBenchmark name = Benchmark name $ Benchmarkable $ \n -> do
+spawnBenchmark name = bench name . toBenchmarkable $ \n -> do
   self <- getExecutablePath
   callProcess self [RunTestCaseFlag, name, show n, "+RTS", "-N1"]
 

bench/RunAll.hs

@@ -11,7 +11,7 @@
 }:
 mkDerivation {
   pname = "reflex";
-  version = "0.5.0";
+  version = "0.5";
   src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ ".git" "dist" ])) ./.;
   libraryHaskellDepends = [
     base bifunctors containers dependent-map dependent-sum

default.nix

@@ -0,0 +1,29 @@
+{
+  "enabled": 1,
+  "hidden": true,
+  "description": "Jobsets",
+  "nixexprinput": "src",
+  "nixexprpath": "jobsets.nix",
+  "checkinterval": 300,
+  "schedulingshares": 100,
+  "enableemail": false,
+  "emailoverride": "",
+  "keepnr": 10,
+  "inputs": {
+    "src": {
+      "type": "git",
+      "value": "https://github.com/reflex-frp/reflex.git develop",
+      "emailresponsible": false
+    },
+    "nixpkgs": {
+      "type": "git",
+      "value": "https://github.com/NixOS/nixpkgs-channels nixos-unstable",
+      "emailresponsible": false
+    },
+    "prs": {
+      "type": "githubpulls",
+      "value": "reflex-frp reflex",
+      "emailresponsible": false
+    }
+  }
+}

hydra.json

@@ -0,0 +1,70 @@
+{ prs }:
+
+let
+  pkgs = (import ./reflex-platform.nix {}).nixpkgs;
+  mkFetchGithub = value: {
+    inherit value;
+    type = "git";
+    emailresponsible = false;
+  };
+in
+with pkgs.lib;
+let
+  defaults = jobs: {
+    inherit (jobs) description;
+    enabled = 1;
+    hidden = false;
+    keepnr = 10;
+    schedulingshares = 100;
+    checkinterval = 120;
+    enableemail = false;
+    emailoverride = "";
+    nixexprinput = "reflex";
+    nixexprpath = "release.nix";
+    inputs = jobs.inputs // {
+      nixpkgs = {
+        type = "git";
+        value = "https://github.com/NixOS/nixpkgs-channels nixos-unstable";
+        emailresponsible = false;
+      };
+      config = {
+        type = "nix";
+        value = "{ android_sdk.accept_license = true; }";
+        emailresponsible = false;
+      };
+    };
+  };
+  branchJobset = branch: defaults {
+    description = "reflex-${branch}";
+    inputs = {
+      reflex = {
+        value = "https://github.com/reflex-frp/reflex ${branch}";
+        type = "git";
+        emailresponsible = false;
+      };
+    };
+  };
+  makePr = num: info: {
+    name = "reflex-pr-${num}";
+    value = defaults {
+      description = "#${num}: ${info.title}";
+      inputs = {
+        reflex = {
+          #NOTE: This should really use "pull/${num}/merge"; however, GitHub's
+          #status checks only operate on PR heads.  This creates a race
+          #condition, which can currently only be solved by requiring PRs to be
+          #up to date before they're merged.  See
+          #https://github.com/isaacs/github/issues/1002
+          value = "https://github.com/reflex-frp/reflex pull/${num}/head";
+          type = "git";
+          emailresponsible = false;
+        };
+      };
+    };
+  };
+  processedPrs = mapAttrs' makePr (builtins.fromJSON (builtins.readFile prs));
+  jobsetsAttrs = processedPrs //
+    genAttrs ["develop"] branchJobset;
+in {
+  jobsets = pkgs.writeText "spec.json" (builtins.toJSON jobsetsAttrs);
+}

jobsets.nix

@@ -0,0 +1,8 @@
+let
+  reflex-platform-src = (import <nixpkgs> {}).fetchFromGitHub {
+    owner = "reflex-frp";
+    repo = "reflex-platform";
+    rev = "384cd850f3adf1d404bced2424b5f6efb0f415f2";
+    sha256 = "1ws77prqx8khmp8j6br1ij4k2v4dlgv170r9fmg0p1jivfbn8y9d";
+  };
+in import reflex-platform-src