summaryrefslogtreecommitdiff
path: root/src/full/Agda/Compiler/Treeless/Subst.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/full/Agda/Compiler/Treeless/Subst.hs')
-rw-r--r--src/full/Agda/Compiler/Treeless/Subst.hs19
1 files changed, 10 insertions, 9 deletions
diff --git a/src/full/Agda/Compiler/Treeless/Subst.hs b/src/full/Agda/Compiler/Treeless/Subst.hs
index 56068a4..8d823df 100644
--- a/src/full/Agda/Compiler/Treeless/Subst.hs
+++ b/src/full/Agda/Compiler/Treeless/Subst.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -7,7 +6,7 @@ module Agda.Compiler.Treeless.Subst where
import Control.Applicative
import qualified Data.Map as Map
import Data.Map (Map)
-import Data.Monoid
+import Data.Semigroup (Semigroup, Monoid, (<>), mempty, mappend, All(..), Any(..))
import Data.Maybe
import Agda.Syntax.Treeless
@@ -15,9 +14,9 @@ import Agda.Syntax.Internal (Substitution'(..))
import Agda.TypeChecking.Substitute
instance DeBruijn TTerm where
- debruijnVar = TVar
- debruijnView (TVar i) = Just i
- debruijnView _ = Nothing
+ deBruijnVar = TVar
+ deBruijnView (TVar i) = Just i
+ deBruijnView _ = Nothing
instance Subst TTerm TTerm where
applySubst IdS t = t
@@ -49,10 +48,10 @@ instance Subst TTerm TAlt where
applySubst rho (TAGuard g b) = TAGuard (applySubst rho g) (applySubst rho b)
newtype UnderLambda = UnderLambda Any
- deriving (Eq, Ord, Show, Monoid)
+ deriving (Eq, Ord, Show, Semigroup, Monoid)
newtype SeqArg = SeqArg All
- deriving (Eq, Ord, Show, Monoid)
+ deriving (Eq, Ord, Show, Semigroup, Monoid)
data Occurs = Occurs Int UnderLambda SeqArg
deriving (Eq, Ord, Show)
@@ -66,9 +65,12 @@ inSeq (Occurs n l _) = Occurs n l mempty
underLambda :: Occurs -> Occurs
underLambda o = o <> Occurs 0 (UnderLambda $ Any True) mempty
+instance Semigroup Occurs where
+ Occurs a k s <> Occurs b l t = Occurs (a + b) (k <> l) (s <> t)
+
instance Monoid Occurs where
mempty = Occurs 0 mempty mempty
- mappend (Occurs a k s) (Occurs b l t) = Occurs (a + b) (k <> l) (s <> t)
+ mappend = (<>)
class HasFree a where
freeVars :: a -> Map Int Occurs
@@ -121,4 +123,3 @@ instance HasFree TAlt where
TACon _ i b -> freeVars (Binder i b)
TALit _ b -> freeVars b
TAGuard g b -> freeVars (g, b)
-