Merge pull request #172 from conal/master

Add addHermitCoreRules method to the HasCoreRules class. Fix splitFunTyMaybe for GHC 8.0.

src/HERMIT/Context.hs

@@ -221,11 +221,14 @@ lookupHermitBindingSite v depth c = do HB d bnd _ <- lookupHermitBinding v c
 
 -- | A class of contexts that store GHC rewrite rules.
 class HasCoreRules c where
-    hermitCoreRules :: c -> [CoreRule]
+    hermitCoreRules    :: c -> [CoreRule]
+    addHermitCoreRules :: [CoreRule] -> c -> c
 
 instance HasCoreRules [CoreRule] where
     hermitCoreRules :: [CoreRule] -> [CoreRule]
     hermitCoreRules = id
+    addHermitCoreRules :: [CoreRule] -> [CoreRule] -> [CoreRule]
+    addHermitCoreRules = (++)
 
 ------------------------------------------------------------------------
 
@@ -338,6 +341,8 @@ instance ReadBindings HermitC where
 instance HasCoreRules HermitC where
   hermitCoreRules :: HermitC -> [CoreRule]
   hermitCoreRules = hermitC_specRules
+  addHermitCoreRules :: [CoreRule] -> HermitC -> HermitC
+  addHermitCoreRules rules c = c { hermitC_specRules = rules ++ hermitC_specRules c }
 
 ------------------------------------------------------------------------
 

src/HERMIT/Dictionary/Local/Case.hs

@@ -116,10 +116,10 @@ externals =
         , "e ==> case expr of C1 vs -> e; C2 vs -> e"] .+ Deep .+ Strictness
     , external "case-split-inline" ((\nm -> findVarT (unOccurrenceName nm) >>= promoteExprR . caseSplitInlineR . varToCoreExpr) :: OccurrenceName -> RewriteH LCore)
         [ "Like case-split, but additionally inlines the matched constructor "
-        , "applications for all occurances of the named variable." ] .+ Deep .+ Strictness
+        , "applications for all occurrences of the named variable." ] .+ Deep .+ Strictness
     , external "case-split-inline" (parseCoreExprT >=> promoteExprR . caseSplitInlineR :: CoreString -> RewriteH LCore)
         [ "Like case-split, but additionally inlines the matched constructor "
-        , "applications for all occurances of the case binder." ] .+ Deep .+ Strictness
+        , "applications for all occurrences of the case binder." ] .+ Deep .+ Strictness
     , external "case-intro-seq" (promoteExprR . caseIntroSeqR . cmpString2Var :: String -> RewriteH LCore)
         [ "Force evaluation of a variable by introducing a case."
         , "case-intro-seq 'v is is equivalent to adding @(seq v)@ in the source code." ] .+ Shallow .+ Introduce .+ Strictness
@@ -436,7 +436,7 @@ matchingFreeIdT idPred = do
     is    -> fail ("provided name matches " ++ show (length is) ++ " free identifiers.")
 
 -- | Like caseSplit, but additionally inlines the constructor applications
--- for each occurance of the named variable.
+-- for each occurrence of the named variable.
 --
 -- > caseSplitInline idPred = caseSplit idPred >>> caseInlineAlternativeR
 caseSplitInlineR :: ( ExtendPath c Crumb, ReadPath c Crumb, AddBindings c

src/HERMIT/External.hs

@@ -57,10 +57,11 @@ module HERMIT.External
 import Data.Map hiding (map)
 import Data.Dynamic
 import Data.List
-import Data.Typeable.Internal (TypeRep(..), funTc)
+import Data.Typeable.Internal (TypeRep(..))
 
 import HERMIT.Core
 import HERMIT.Context (LocalPathH)
+import HERMIT.GHC (tcFun)
 import HERMIT.Kure
 import HERMIT.Lemma
 
@@ -265,7 +266,7 @@ splitFunTyArgs tr = case splitFunTyMaybe tr of
                                          in (a:as, r')
 
 splitFunTyMaybe :: TypeRep -> Maybe (TypeRep, TypeRep)
-splitFunTyMaybe (TypeRep _ tc _krs [a,r]) | tc == funTc = Just (a,r)
+splitFunTyMaybe (TypeRep _ tc _krs [a,r]) | tc == tcFun = Just (a,r)
 splitFunTyMaybe _ = Nothing
 
 -----------------------------------------------------------------

src/HERMIT/GHC.hs

@@ -70,6 +70,7 @@ module HERMIT.GHC
 #endif
     , module Unify
     , getHscEnvCoreM
+    , tcFun
     ) where
 
 -- Imports from GHC.
@@ -127,6 +128,9 @@ import           TypeRep (Type(..), TyLit(..))
 import           TysPrim (alphaTyVars)
 import           Unify (tcUnifyTys, BindFlag(..))
 
+import Data.Typeable (typeRep,typeRepTyCon)
+import qualified Data.Typeable
+import Data.Proxy (Proxy(..))
 import Data.List (intercalate)
 
 import HERMIT.GHC.Typechecker
@@ -402,3 +406,6 @@ injectDependency hsc_env guts mod_name = do
   where
     dflags = hsc_dflags hsc_env
     doc = ptext (sLit "dependency injection requested by HERMIT")
+
+tcFun :: Data.Typeable.TyCon
+tcFun = typeRepTyCon (typeRep (Proxy :: Proxy (Int -> Int)))