1 files changed, 42 insertions, 0 deletions
diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/HybCC.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/HybCC.hs
new file mode 100644
index 0000000000..876d08f75b
--- /dev/null
+++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/HybCC.hs
@@ -0,0 +1,42 @@
+module Algo.HybCC (hybcc) where
+
+import Data.Vector.Unboxed as V
+
+hybcc :: (Int, Vector Int, Vector Int) -> Vector Int
+{-# NOINLINE hybcc #-}
+hybcc (n, e1, e2) = concomp (V.zip e1 e2) n
+    where
+      concomp es n
+        | V.null es = V.enumFromTo 0 (n-1)
+        | otherwise = V.backpermute ins ins
+        where
+          p = shortcut_all
+            $ V.update (V.enumFromTo 0 (n-1)) es
+
+          (es',i) = compress p es
+          r = concomp es' (V.length i)
+          ins = V.update_ p i
+              $ V.backpermute i r
+
+      enumerate bs = V.prescanl' (+) 0 $ V.map (\b -> if b then 1 else 0) bs
+
+      pack_index bs = V.map fst
+                    . V.filter snd
+                    $ V.zip (V.enumFromTo 0 (V.length bs - 1)) bs
+
+      shortcut_all p | p == pp   = pp
+                     | otherwise = shortcut_all pp
+        where
+          pp = V.backpermute p p
+
+      compress p es = (new_es, pack_index roots)
+        where
+          (e1,e2) = V.unzip es
+          es' = V.map (\(x,y) -> if x > y then (y,x) else (x,y))
+              . V.filter (\(x,y) -> x /= y)
+              $ V.zip (V.backpermute p e1) (V.backpermute p e2)
+
+          roots = V.zipWith (==) p (V.enumFromTo 0 (V.length p - 1))
+          labels = enumerate roots
+          (e1',e2') = V.unzip es'
+          new_es = V.zip (V.backpermute labels e1') (V.backpermute labels e2')