Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Remove infinite loop in firstHole/lastHole and make LLVM opt-in

  • Loading branch information...
commit 9f36bcee14877b5514ed64dbb85cec2d7cd833f1 1 parent 85e973d
@lowasser authored
View
1  Data/TrieMap/ProdMap/Zippable.hs
@@ -10,6 +10,7 @@ instance (Zippable (TrieMap k1), TrieKey k2, Zippable (TrieMap k2)) => Zippable
assign a (PHole h1 h2) = PMap (assign (assign a h2) h1)
instance (Alternatable (TrieMap k1), Alternatable (TrieMap k2)) => Alternatable (TrieMap (k1, k2)) where
+ {-# INLINE alternate #-}
alternate (PMap m) = do
(m', h1) <- alternate m
(a, h2) <- alternate m'
View
8 Data/TrieMap/RadixTrie/Alternate.hs
@@ -1,8 +1,6 @@
{-# LANGUAGE CPP, BangPatterns, ViewPatterns, FlexibleInstances #-}
module Data.TrieMap.RadixTrie.Alternate () where
-import Control.Monad.Ends
-
import Data.TrieMap.RadixTrie.Base
#define V(f) f (VVector) (k)
@@ -21,11 +19,7 @@ instance Alternatable (TrieMap (PVector Word)) where
(a, loc) <- extractEdgeLoc m root
return (a, WHole loc)
-{-# SPECIALIZE extractEdgeLoc ::
- TrieKey k => V(Edge) a -> V(Path) a -> First (a, V(EdgeLoc) a),
- TrieKey k => V(Edge) a -> V(Path) a -> Last (a, V(EdgeLoc) a),
- U(Edge) a -> U(Path) a -> First (a, U(EdgeLoc) a),
- U(Edge) a -> U(Path) a -> Last (a, U(EdgeLoc) a) #-}
+{-# INLINE extractEdgeLoc #-}
extractEdgeLoc :: (Label v k, MonadPlus m) => Edge v k a -> Path v k a -> m (a, EdgeLoc v k a)
extractEdgeLoc EDGE(_ ks v ts) path = case v of
Nothing -> extractTS
View
3  Data/TrieMap/RadixTrie/Index.hs
@@ -1,4 +1,7 @@
{-# LANGUAGE CPP, MagicHash, UnboxedTuples, FlexibleInstances, BangPatterns #-}
+#if __GLASGOW_HASKELL__ >= 700
+{-# OPTIONS -fllvm #-}
+#endif
module Data.TrieMap.RadixTrie.Index () where
import Data.TrieMap.RadixTrie.Base
View
3  Data/TrieMap/RadixTrie/Project.hs
@@ -1,4 +1,7 @@
{-# LANGUAGE CPP, BangPatterns, ViewPatterns, UnboxedTuples, FlexibleInstances #-}
+#if __GLASGOW_HASKELL__ >= 700
+{-# OPTIONS -fllvm #-}
+#endif
module Data.TrieMap.RadixTrie.Project () where
import Data.TrieMap.RadixTrie.Base
View
3  Data/TrieMap/RadixTrie/Search.hs
@@ -1,5 +1,8 @@
{-# LANGUAGE CPP, BangPatterns, ViewPatterns, FlexibleInstances, TypeOperators, FlexibleContexts, TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
+#if __GLASGOW_HASKELL__ >= 700
+{-# OPTIONS -fllvm #-}
+#endif
module Data.TrieMap.RadixTrie.Search (insertEdge) where
import Control.Monad.Unpack
View
1  Data/TrieMap/RadixTrie/SetOp.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP, BangPatterns, ViewPatterns, FlexibleInstances #-}
+
module Data.TrieMap.RadixTrie.SetOp () where
import Control.Monad.Option
View
3  Data/TrieMap/RadixTrie/Split.hs
@@ -1,4 +1,7 @@
{-# LANGUAGE CPP, FlexibleInstances, BangPatterns, ViewPatterns #-}
+#if __GLASGOW_HASKELL__ >= 700
+{-# OPTIONS -fllvm #-}
+#endif
module Data.TrieMap.RadixTrie.Split () where
import Data.TrieMap.RadixTrie.Base
View
3  Data/TrieMap/RadixTrie/Subset.hs
@@ -1,4 +1,7 @@
{-# LANGUAGE CPP, BangPatterns, ViewPatterns, FlexibleInstances #-}
+#if __GLASGOW_HASKELL__ >= 700
+{-# OPTIONS -fllvm #-}
+#endif
module Data.TrieMap.RadixTrie.Subset () where
import Control.Monad
View
3  Data/TrieMap/RadixTrie/Zipper.hs
@@ -1,4 +1,7 @@
{-# LANGUAGE CPP, FlexibleInstances, BangPatterns, ViewPatterns #-}
+#if __GLASGOW_HASKELL__ >= 700
+{-# OPTIONS -fllvm #-}
+#endif
module Data.TrieMap.RadixTrie.Zipper () where
import Data.TrieMap.RadixTrie.Base
View
1  Data/TrieMap/Representation/Instances/ByteString.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE UndecidableInstances, TypeFamilies, BangPatterns #-}
+
module Data.TrieMap.Representation.Instances.ByteString () where
import Control.Monad.Primitive
View
1  Data/TrieMap/Representation/Instances/Foreign.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE TemplateHaskell, TypeFamilies, UndecidableInstances #-}
+
module Data.TrieMap.Representation.Instances.Foreign () where
import Foreign.C.Types
View
3  Data/TrieMap/Representation/Instances/Prim.hs
@@ -1,5 +1,8 @@
{-# LANGUAGE ScopedTypeVariables, BangPatterns, TypeFamilies, UndecidableInstances, CPP, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
+#if __GLASGOW_HASKELL__ >= 700
+{-# OPTIONS -fllvm #-}
+#endif
module Data.TrieMap.Representation.Instances.Prim () where
import Control.Monad.Primitive
View
4 Data/TrieMap/TrieKey/Alternatable.hs
@@ -19,6 +19,6 @@ class Alternatable f where
lastHole m = inline alternate m
{-# RULES
- "alternate/First" alternate = firstHole;
- "alternate/Last" alternate = lastHole;
+ "alternate/First" forall m . alternate m = firstHole m;
+ "alternate/Last" forall m . alternate m = lastHole m;
#-}
View
6 Data/TrieSet.hs
@@ -159,9 +159,9 @@ split a s = case splitMember a s of
-- | Performs a 'split' but also returns whether the pivot
-- element was found in the original set.
splitMember :: TKey a => a -> TSet a -> (TSet a, Bool, TSet a)
-splitMember a (TSet s) = search (toRep a) s nomatch match where
- nomatch hole = (TSet (before hole), False, TSet (after hole))
- match _ hole = (TSet (before hole), True, TSet (after hole))
+splitMember a (TSet s) = case splitLookup (toRep a) s of
+ (sL, Nothing, sR) -> (TSet sL, False, TSet sR)
+ (sL, Just{}, sR) -> (TSet sL, True, TSet sR)
-- |
-- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.
View
2  Makefile
@@ -11,7 +11,7 @@ FAST_GHC_OPTS := -O0 -ddump-minimal-imports -odir $(FAST_DIR) $(GHC_OPTS)
DEBUG_GHC_OPTS := -prof -hisuf p_hi -auto-all -rtsopts -osuf p_o $(FAST_GHC_OPTS) $(GHC_OPTS)
LLVM_OPTS := -O3 -std-compile-opts -partialspecialization -stats
OPTIMIZED_GHC_OPTS := -O2 -fno-spec-constr-count -fno-spec-constr-threshold \
- -fllvm $(addprefix -optlo, $(LLVM_OPTS)) \
+ $(addprefix -optlo, $(LLVM_OPTS)) \
-fmax-worker-args=100 -funfolding-keeness-factor=100 -odir $(OPTIMIZED_DIR) $(GHC_OPTS)
THREADSCOPE_OPTS := $(OPTIMIZED_GHC_OPTS) $(GHC_OPTS) -eventlog
PROFILING_OPTS := -prof -hisuf p_hi -auto-all -rtsopts -osuf p_o $(OPTIMIZED_GHC_OPTS) $(GHC_OPTS)
View
2  TrieBench.hs
@@ -61,13 +61,13 @@ nf' f a = f a `deepseq` nf f a
tBenches strings revs = bgroup ""
[bench "Lookup" (nf' tLookupBench (strSet, someStr1, someStr2)),
+ bench "Neighborhood" (nf' tNeighborhood (strSet, someStr2)),
revSet `seq` bench "Intersect" (nf' tIntersectBench (strSet, revSet)),
bench "Sort" (nf' tSortBench strings),
bench "Union" (nf' tUnionBench (strSet, revSet)),
bench "Difference" (nf' tDiffBench (strSet, revSet)),
bench "Filter" (nf' tFilterBench strSet),
bench "Split" (nf' tSplitBench strSet),
- bench "Neighborhood" (nf' tNeighborhood (strSet, someStr2)),
bench "Index" (nf' tIndex strSet),
bench "Min/Max" (nf' tEnds strSet),
bench "ToList" (nf' tToList strSet),
Please sign in to comment.
Something went wrong with that request. Please try again.