From f723b8b878a3c4a4687b9e337a875500bebb39b1 Mon Sep 17 00:00:00 2001 From: Vincent Ambo Date: Thu, 4 Jul 2019 11:18:12 +0100 Subject: feat(third_party/bazel): Check in rules_haskell from Tweag --- .../examples/vector/benchmarks/Algo/HybCC.hs | 42 ++++++++++++++++++++++ 1 file changed, 42 insertions(+) create mode 100644 third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/HybCC.hs (limited to 'third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/HybCC.hs') 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 000000000000..876d08f75b62 --- /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') -- cgit 1.4.1