From f723b8b878a3c4a4687b9e337a875500bebb39b1 Mon Sep 17 00:00:00 2001
From: Vincent Ambo <tazjin@google.com>
Date: Thu, 4 Jul 2019 11:18:12 +0100
Subject: feat(third_party/bazel): Check in rules_haskell from Tweag

---
 .../examples/vector/benchmarks/TestData/Graph.hs   | 45 ++++++++++++++++++++++
 .../vector/benchmarks/TestData/ParenTree.hs        | 20 ++++++++++
 .../examples/vector/benchmarks/TestData/Random.hs  | 16 ++++++++
 3 files changed, 81 insertions(+)
 create mode 100644 third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Graph.hs
 create mode 100644 third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/ParenTree.hs
 create mode 100644 third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Random.hs

(limited to 'third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData')

diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Graph.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Graph.hs
new file mode 100644
index 000000000000..8b8ca837b890
--- /dev/null
+++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Graph.hs
@@ -0,0 +1,45 @@
+module TestData.Graph ( randomGraph )
+where
+
+import System.Random.MWC
+import qualified Data.Array.ST as STA
+import qualified Data.Vector.Unboxed as V
+
+import Control.Monad.ST ( ST, runST )
+
+randomGraph :: Int -> (Int, V.Vector Int, V.Vector Int)
+randomGraph e
+  = runST (
+    do
+      g <- create
+      arr <- STA.newArray (0,n-1) [] :: ST s (STA.STArray s Int [Int])
+      addRandomEdges n g arr e
+      xs <- STA.getAssocs arr
+      let (as,bs) = unzip [(i,j) | (i,js) <- xs, j <- js ]
+      return (n, V.fromListN (length as) as, V.fromListN (length bs) bs)
+    )
+  where
+    n = e `div` 10
+
+addRandomEdges :: Int -> Gen s -> STA.STArray s Int [Int] -> Int -> ST s ()
+addRandomEdges n g arr = fill
+  where
+    fill 0 = return ()
+    fill e
+      = do
+          m <- random_index
+          n <- random_index
+          let lo = min m n
+              hi = max m n
+          ns <- STA.readArray arr lo
+          if lo == hi || hi `elem` ns
+            then fill e
+            else do
+                   STA.writeArray arr lo (hi:ns)
+                   fill (e-1)
+
+    random_index = do
+                     x <- uniform g
+                     let i = floor ((x::Double) * toEnum n)
+                     if i == n then return 0 else return i
+
diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/ParenTree.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/ParenTree.hs
new file mode 100644
index 000000000000..4aeb750954a9
--- /dev/null
+++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/ParenTree.hs
@@ -0,0 +1,20 @@
+module TestData.ParenTree where
+
+import qualified Data.Vector.Unboxed as V
+
+parenTree :: Int -> (V.Vector Int, V.Vector Int)
+parenTree n = case go ([],[]) 0 (if even n then n else n+1) of
+               (ls,rs) -> (V.fromListN (length ls) (reverse ls),
+                           V.fromListN (length rs) (reverse rs))
+  where
+    go (ls,rs) i j = case j-i of
+                       0 -> (ls,rs)
+                       2 -> (ls',rs')
+                       d -> let k = ((d-2) `div` 4) * 2
+                            in
+                            go (go (ls',rs') (i+1) (i+1+k)) (i+1+k) (j-1)
+      where
+        ls' = i:ls
+        rs' = j-1:rs
+
+
diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Random.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Random.hs
new file mode 100644
index 000000000000..f9b741fb97ae
--- /dev/null
+++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/TestData/Random.hs
@@ -0,0 +1,16 @@
+module TestData.Random ( randomVector ) where
+
+import qualified Data.Vector.Unboxed as V
+
+import System.Random.MWC
+import Control.Monad.ST ( runST )
+
+randomVector :: (Variate a, V.Unbox a) => Int -> IO (V.Vector a)
+randomVector n = withSystemRandom $ \g ->
+  do
+    xs <- sequence $ replicate n $ uniform g
+    io (return $ V.fromListN n xs)
+  where
+    io :: IO a -> IO a
+    io = id
+
-- 
cgit 1.4.1