Formatting and linting

src/Analysis/Abstract/Caching.hs

@@ -30,18 +30,30 @@ import Data.Pointed
 import Data.Semigroup
 import qualified Data.Set as Set
 
-type CachingInterpreter t v = '[Fresh, Reader (Live (LocationFor v) v), Reader (Environment (LocationFor v) v), Fail, NonDetEff, State (Store (LocationFor v) v), Reader (Cache (LocationFor v) t v), State (Cache (LocationFor v) t v)]
+type CachingInterpreter t v
+  = '[ Fresh
+     , Reader (Live (LocationFor v) v)
+     , Reader (Environment (LocationFor v) v)
+     , Fail
+     , NonDetEff
+     , State (Store (LocationFor v) v)
+     , Reader (Cache (LocationFor v) t v)
+     , State (Cache (LocationFor v) t v)
+     ]
 
 type CachingResult t v = Final (CachingInterpreter t v) v
 
-type MonadCachingInterpreter t v m = (MonadEnv v m, MonadStore v m, MonadCacheIn t v m, MonadCacheOut t v m, MonadGC v m, Alternative m)
+type MonadCachingInterpreter t v m
+  = ( MonadEnv v m
+    , MonadStore v m
+    , MonadCacheIn t v m
+    , MonadCacheOut t v m
+    , MonadGC v m
+    , Alternative m
+    )
 
 
--- Coinductively-cached evaluation
---
--- Examples:
---    evalCache @Type <term>
---    evalCache @(Value (Data.Union.Union Language.Python.Assignment2.Syntax) (Record Location) Precise) <term>
+-- | Coinductively-cached evaluation.
 evalCache :: forall v term
           . ( Ord v
             , Ord term
@@ -79,7 +91,7 @@ evCache ev0 ev' yield e = do
   case cacheLookup c out of
     Just pairs -> asum . flip map (toList pairs) $ \ (value, store') -> do
       putStore store'
-      return value
+      pure value
     Nothing -> do
       in' <- askCache
       let pairs = fromMaybe mempty (cacheLookup c in')
@@ -87,7 +99,7 @@ evCache ev0 ev' yield e = do
       v <- ev0 ev' yield e
       store' <- getStore
       modifyCache (cacheInsert c (v, store'))
-      return v
+      pure v
 
 fixCache :: forall t v m
          . ( Ord (LocationFor v)
@@ -113,7 +125,7 @@ fixCache ev' yield e = do
     getCache)
   asum . flip map (maybe [] toList (cacheLookup c pairs)) $ \ (value, store') -> do
     putStore store'
-    return value
+    pure value
 
 
 mlfp :: (Eq a, Monad m) => a -> (a -> m a) -> m a
@@ -121,6 +133,6 @@ mlfp a f = loop a
   where loop x = do
           x' <- f x
           if x' == x then
-            return x
+            pure x
           else
             loop x'

src/Analysis/Abstract/Collecting.hs

@@ -23,7 +23,7 @@ evCollect ev0 ev' yield e = do
   roots <- askRoots :: m (Live (LocationFor v) v)
   v <- ev0 ev' yield e
   modifyStore (gc (roots <> valueRoots v))
-  return v
+  pure v
 
 gc :: (Ord (LocationFor a), Foldable (Cell (LocationFor a)), ValueRoots (LocationFor a) a) => Live (LocationFor a) a -> Store (LocationFor a) a -> Store (LocationFor a) a
 gc roots store = storeRestrict store (reachable roots store)

src/Analysis/Abstract/Dead.hs

@@ -20,20 +20,18 @@ import Data.Semigroup
 import Data.Set
 
 
-type DeadCodeInterpreter t v = '[State (Dead t), Fail, State (Store (LocationFor v) v), Reader (Set (Address (LocationFor v) v)), Reader (Environment (LocationFor v) v)]
+type DeadCodeInterpreter t v
+  = '[ State (Dead t)
+     , Fail
+     , State (Store (LocationFor v) v)
+     , Reader (Set (Address (LocationFor v) v))
+     , Reader (Environment (LocationFor v) v)
+     ]
 
 type DeadCodeResult t v = Final (DeadCodeInterpreter t v) v
 
 
-subterms :: (Ord a, Recursive a, Foldable (Base a)) => a -> Set a
-subterms term = para (foldMap (uncurry ((<>) . point))) term <> point term
-
-
--- Dead code analysis
---
--- Example:
---    evalDead @(Value Syntax Precise) <term>
-
+-- | Dead code analysis
 evalDead :: forall v term
          . ( Ord v
            , Ord term
@@ -48,6 +46,9 @@ evalDead :: forall v term
 evalDead e0 = run @(DeadCodeInterpreter term v) $ do
   killAll (Dead (subterms e0))
   fix (evDead (\ recur yield -> eval recur yield . project)) pure e0
+  where
+    subterms :: (Ord a, Recursive a, Foldable (Base a)) => a -> Set a
+    subterms term = para (foldMap (uncurry ((<>) . point))) term <> point term
 
 evDead :: (Ord t, MonadDead t m)
        => (((v -> m v) -> t -> m v) -> (v -> m v) -> t -> m v)

src/Analysis/Abstract/Evaluating.hs

@@ -20,7 +20,13 @@ import Data.Functor.Foldable (Base, Recursive(..))
 import Data.Semigroup
 import Data.Set
 
-type Interpreter v = '[Fail, Reader (Live (LocationFor v) v), State (Store (LocationFor v) v), Reader (Set (Address (LocationFor v) v)), Reader (Environment (LocationFor v) v)]
+type Interpreter v
+  = '[ Fail
+     , Reader (Live (LocationFor v) v)
+     , State (Store (LocationFor v) v)
+     , Reader (Set (Address (LocationFor v) v))
+     , Reader (Environment (LocationFor v) v)
+     ]
 
 type MonadInterpreter v m = (MonadEnv v m, MonadStore v m, MonadFail m)
 

src/Analysis/Abstract/Tracing.hs

@@ -23,18 +23,20 @@ import Data.Pointed
 import Data.Semigroup
 import Data.Set
 
-type TracingInterpreter t v g = '[Reader (Set (Address (LocationFor v) v)), Writer (g (Configuration (LocationFor v) t v)), Fail, State (Store (LocationFor v) v), Reader (Set (Address (LocationFor v) v)), Reader (Environment (LocationFor v) v)]
+type TracingInterpreter t v g
+  = '[ Reader (Set (Address (LocationFor v) v))
+     , Writer (g (Configuration (LocationFor v) t v))
+     , Fail
+     , State (Store (LocationFor v) v)
+     , Reader (Set (Address (LocationFor v) v))
+     , Reader (Environment (LocationFor v) v)
+     ]
 
 type TraceInterpreter t v = TracingInterpreter t v []
 type ReachableStateInterpreter t v = TracingInterpreter t v Set
 
 
--- Tracing and reachable state analyses
---
--- Examples
---    evalTrace @(Value Syntax Precise) <term>
---    evalReach @(Value Syntax Precise) <term>
-
+-- | Tracing state analyses
 evalTrace :: forall v term
           . ( Ord v, Ord term, Ord (Cell (LocationFor v) v)
             , Functor (Base term)
@@ -47,6 +49,7 @@ evalTrace :: forall v term
           => term -> Final (TracingInterpreter term v []) v
 evalTrace = run @(TraceInterpreter term v) . fix (evTell @[] (\ recur yield -> eval recur yield . project)) pure
 
+-- | Reach state analyses
 evalReach :: forall v term
           . ( Ord v, Ord term, Ord (LocationFor v), Ord (Cell (LocationFor v) v)
             , Functor (Base term)

src/Control/Monad/Effect/Address.hs

@@ -20,12 +20,12 @@ class (Ord l, Pointed (Cell l), Monad m) => MonadAddress l m where
   alloc :: (MonadStore a m, l ~ LocationFor a) => Name -> m (Address l a)
 
 envLookupOrAlloc' ::
-                 ( FreeVariables t
-                 , Semigroup (Cell (LocationFor a) a)
-                 , MonadStore a m
-                 , MonadAddress (LocationFor a) m
-                 )
-                 => t -> Environment (LocationFor a) a -> a -> m (Name, Address (LocationFor a) a)
+                  ( FreeVariables t
+                  , Semigroup (Cell (LocationFor a) a)
+                  , MonadStore a m
+                  , MonadAddress (LocationFor a) m
+                  )
+                  => t -> Environment (LocationFor a) a -> a -> m (Name, Address (LocationFor a) a)
 envLookupOrAlloc' term = let [name] = toList (freeVariables term) in
                          envLookupOrAlloc name
 
@@ -41,7 +41,6 @@ envLookupOrAlloc name env v = do
   pure (name, a)
 
 
-
 instance Monad m => MonadAddress Precise m where
   deref = maybe uninitializedAddress (pure . unLatest) <=< flip fmap getStore . storeLookup
 

src/Control/Monad/Effect/Store.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, StandaloneDeriving, TypeFamilyDependencies, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilyDependencies, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Control.Monad.Effect.Store
 ( assign
 , MonadStore(..)