summary refs log tree commit diff
path: root/pkgs/applications/science/logic/tamarin-prover/ghc-8.4-support-term.patch
diff options
context:
space:
mode:
Diffstat (limited to 'pkgs/applications/science/logic/tamarin-prover/ghc-8.4-support-term.patch')
-rw-r--r--pkgs/applications/science/logic/tamarin-prover/ghc-8.4-support-term.patch109
1 files changed, 109 insertions, 0 deletions
diff --git a/pkgs/applications/science/logic/tamarin-prover/ghc-8.4-support-term.patch b/pkgs/applications/science/logic/tamarin-prover/ghc-8.4-support-term.patch
new file mode 100644
index 00000000000..f93919faf54
--- /dev/null
+++ b/pkgs/applications/science/logic/tamarin-prover/ghc-8.4-support-term.patch
@@ -0,0 +1,109 @@
+From a08f6e400772899b9b0fc16befc50391cd70696b Mon Sep 17 00:00:00 2001
+From: Felix Yan <felixonmars@archlinux.org>
+Date: Fri, 18 May 2018 16:24:41 +0800
+Subject: [PATCH] GHC 8.4 support
+
+---
+ src/Term/Maude/Signature.hs          |  8 ++--
+ src/Term/Rewriting/Definitions.hs    | 23 ++++++----
+ src/Term/Unification.hs              |  4 +-
+ 11 files changed, 79 insertions(+), 48 deletions(-)
+
+diff --git a/src/Term/Maude/Signature.hs b/src/Term/Maude/Signature.hs
+index 98c25d9f..1a4ce82f 100644
+--- a/src/Term/Maude/Signature.hs
++++ b/src/Term/Maude/Signature.hs
+@@ -104,9 +104,9 @@ maudeSig msig@(MaudeSig {enableDH,enableBP,enableMSet,enableXor,enableDiff=_,stF
+           `S.union` dhReducibleFunSig `S.union` bpReducibleFunSig `S.union` xorReducibleFunSig
+ 
+ -- | A monoid instance to combine maude signatures.
+-instance Monoid MaudeSig where
+-    (MaudeSig dh1 bp1 mset1 xor1 diff1 stFunSyms1 stRules1 _ _) `mappend`
+-      (MaudeSig dh2 bp2 mset2 xor2 diff2 stFunSyms2 stRules2 _ _) =
++instance Semigroup MaudeSig where
++    MaudeSig dh1 bp1 mset1 xor1 diff1 stFunSyms1 stRules1 _ _ <>
++      MaudeSig dh2 bp2 mset2 xor2 diff2 stFunSyms2 stRules2 _ _ =
+           maudeSig (mempty {enableDH=dh1||dh2
+                            ,enableBP=bp1||bp2
+                            ,enableMSet=mset1||mset2
+@@ -114,6 +114,8 @@ instance Monoid MaudeSig where
+                            ,enableDiff=diff1||diff2
+                            ,stFunSyms=S.union stFunSyms1 stFunSyms2
+                            ,stRules=S.union stRules1 stRules2})
++
++instance Monoid MaudeSig where
+     mempty = MaudeSig False False False False False S.empty S.empty S.empty S.empty
+ 
+ -- | Non-AC function symbols.
+diff --git a/src/Term/Rewriting/Definitions.hs b/src/Term/Rewriting/Definitions.hs
+index bd942b6a..18562e4e 100644
+--- a/src/Term/Rewriting/Definitions.hs
++++ b/src/Term/Rewriting/Definitions.hs
+@@ -44,10 +44,12 @@ evalEqual (Equal l r) = l == r
+ instance Functor Equal where
+     fmap f (Equal lhs rhs) = Equal (f lhs) (f rhs)
+ 
++instance Semigroup a => Semigroup (Equal a) where
++    (Equal l1 r1) <> (Equal l2 r2) =
++        Equal (l1 <> l2) (r1 <> r2)
++
+ instance Monoid a => Monoid (Equal a) where
+     mempty                                = Equal mempty mempty
+-    (Equal l1 r1) `mappend` (Equal l2 r2) =
+-        Equal (l1 `mappend` l2) (r1 `mappend` r2)
+ 
+ instance Foldable Equal where
+     foldMap f (Equal l r) = f l `mappend` f r
+@@ -104,14 +106,15 @@ instance Functor Match where
+     fmap _ NoMatch             = NoMatch
+     fmap f (DelayedMatches ms) = DelayedMatches (fmap (f *** f) ms)
+ 
++instance Semigroup (Match a) where
++    NoMatch            <> _                  = NoMatch
++    _                  <> NoMatch            = NoMatch
++    DelayedMatches ms1 <> DelayedMatches ms2 =
++        DelayedMatches (ms1 <> ms2)
++
+ instance Monoid (Match a) where
+     mempty = DelayedMatches []
+ 
+-    NoMatch            `mappend` _                  = NoMatch
+-    _                  `mappend` NoMatch            = NoMatch
+-    DelayedMatches ms1 `mappend` DelayedMatches ms2 =
+-        DelayedMatches (ms1 `mappend` ms2)
+-
+ 
+ instance Foldable Match where
+     foldMap _ NoMatch             = mempty
+@@ -136,10 +139,12 @@ data RRule a = RRule a a
+ instance Functor RRule where
+     fmap f (RRule lhs rhs) = RRule (f lhs) (f rhs)
+ 
++instance Monoid a => Semigroup (RRule a) where
++    (RRule l1 r1) <> (RRule l2 r2) =
++        RRule (l1 <> l2) (r1 <> r2)
++
+ instance Monoid a => Monoid (RRule a) where
+     mempty                                = RRule mempty mempty
+-    (RRule l1 r1) `mappend` (RRule l2 r2) =
+-        RRule (l1 `mappend` l2) (r1 `mappend` r2)
+ 
+ instance Foldable RRule where
+     foldMap f (RRule l r) = f l `mappend` f r
+diff --git a/src/Term/Unification.hs b/src/Term/Unification.hs
+index e1de0163..7ce6bb41 100644
+--- a/src/Term/Unification.hs
++++ b/src/Term/Unification.hs
+@@ -265,9 +265,11 @@ unifyRaw l0 r0 = do
+ 
+ data MatchFailure = NoMatcher | ACProblem
+ 
++instance Semigroup MatchFailure where
++  _ <> _ = NoMatcher
++
+ instance Monoid MatchFailure where
+   mempty = NoMatcher
+-  mappend _ _ = NoMatcher
+ 
+ -- | Ensure that the computed substitution @sigma@ satisfies
+ -- @t ==_AC apply sigma p@ after the delayed equations are solved.