Merge remote-tracking branch 'origin/master' into boolean-arithmetic-evaluation

2025-01-04 13:34:31 +03:00 · 2018-03-13 11:19:14 -04:00 · 2018-03-13 11:19:14 -04:00 · 807be3af29
commit 807be3af29
parent 019940401c cdd7a3e6b3
42 changed files with 456 additions and 236 deletions
--- a/bench/Main.hs
+++ b/bench/Main.hs
@ -0,0 +1,29 @@
+module Main where
+
+import Criterion.Main
+import Semantic.Util
+import Data.Monoid
+import Control.Monad
+
+-- We use `fmap show` to ensure that all the parts of the result of evaluation are
+-- evaluated themselves. While an NFData instance is the most morally correct way
+-- to do this, I'm reluctant to add NFData instances to every single datatype in the
+-- project—coercing the result into a string will suffice, though it throws off the
+-- memory allocation results a bit.
+pyEval :: FilePath -> Benchmarkable
+pyEval = whnfIO . fmap show . evaluatePythonFile . ("bench/bench-fixtures/python/" <>)
+
+rbEval :: FilePath -> Benchmarkable
+rbEval = whnfIO . fmap show . evaluateRubyFile . ("bench/bench-fixtures/ruby/" <>)
+
+main :: IO ()
+main = defaultMain
+  [ bgroup "python" [ bench "assignment" $ pyEval "simple-assignment.py"
+                    , bench "function def" $ pyEval "function-definition.py"
+                    , bench "if + function calls" $ pyEval "if-statement-functions.py"
+                    ]
+  , bgroup "ruby" [ bench "assignment" $ rbEval "simple-assignment.rb"
+                  , bench "function def" $ rbEval "function-definition.rb"
+                  , bench "if + function calls" $ rbEval "if-statement-functions.rb"
+                  ]
+  ]
--- a/bench/bench-fixtures/python/function-definition.py
+++ b/bench/bench-fixtures/python/function-definition.py
@ -0,0 +1,14 @@
+def a():
+  b
+
+def c(d):
+  e
+
+def g(g, *h):
+  i
+
+def h(i=1):
+  i
+
+def i(j="default", **c):
+  j
--- a/bench/bench-fixtures/python/if-statement-functions.py
+++ b/bench/bench-fixtures/python/if-statement-functions.py
@ -0,0 +1,12 @@
+def foo(): return "bipp"
+
+def bar(): return foo()
+
+def baz(): return bar()
+
+def why(): return "elle"
+
+if True:
+    baz()
+else:
+    why()
--- a/bench/bench-fixtures/python/simple-assignment.py
+++ b/bench/bench-fixtures/python/simple-assignment.py
@ -0,0 +1,5 @@
+foo = 2
+bar = foo
+dang = 3
+song = dang
+song
--- a/bench/bench-fixtures/ruby/function-definition.rb
+++ b/bench/bench-fixtures/ruby/function-definition.rb
@ -0,0 +1,19 @@
+def a()
+  "b"
+end
+
+def c(d)
+  "e"
+end
+
+def g(g_)
+  "i"
+end
+
+def h(i=1)
+  i
+end
+
+def i()
+  "j"
+end
--- a/bench/bench-fixtures/ruby/if-statement-functions.rb
+++ b/bench/bench-fixtures/ruby/if-statement-functions.rb
@ -0,0 +1,21 @@
+def foo()
+  "bipp"
+end
+
+def bar()
+  foo()
+end
+
+def baz()
+  bar()
+end
+
+def why()
+  return "elle"
+end
+
+if true
+  baz()
+else
+  why()
+end
--- a/bench/bench-fixtures/ruby/simple-assignment.rb
+++ b/bench/bench-fixtures/ruby/simple-assignment.rb
@ -0,0 +1,5 @@
+foo = 2
+bar = foo
+dang = 3
+song = dang
+song
--- a/semantic.cabal
+++ b/semantic.cabal
@ -37,7 +37,6 @@ library
                     -- Control flow
                     , Control.Effect
                     -- Effects used for program analysis
-                     , Control.Monad.Effect.Cache
                     , Control.Monad.Effect.Fresh
                     -- , Control.Monad.Effect.GC
                     , Control.Monad.Effect.NonDet
@ -141,7 +140,6 @@ library
                     , bifunctors
                     , bytestring
                     , cmark-gfm
-                     , comonad
                     , containers
                     , directory
                     , effects
@ -162,7 +160,6 @@ library
                     , parsers
                     , recursion-schemes
                     , reducers
-                     , semigroups
                     , scientific
                     , split
                     , stm-chans
@ -252,6 +249,18 @@ test-suite test
  default-language:    Haskell2010
  default-extensions:  DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, OverloadedStrings, RecordWildCards

+benchmark evaluation
+  hs-source-dirs: bench
+  type:           exitcode-stdio-1.0
+  main-is:        Main.hs
+  ghc-options:    -threaded -rtsopts "-with-rtsopts=-N -A4m -n2m -T" -static -j -O
+  cc-options:     -DU_STATIC_IMPLEMENTATION=1
+  cpp-options:    -DU_STATIC_IMPLEMENTATION=1
+  build-depends:  base
+                , criterion
+                , semantic
+
+
 source-repository head
  type:     git
  location: https://github.com/github/semantic
--- a/src/Analysis/Abstract/Caching.hs
+++ b/src/Analysis/Abstract/Caching.hs
@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.Abstract.Caching
 ( type Caching
 ) where
@ -13,27 +13,37 @@ import Prologue

 -- | The effects necessary for caching analyses.
 type CachingEffects term value effects
-  = Fresh
- ': NonDetEff
- ': Reader (CacheFor term value)
- ': State  (CacheFor term value)
+  = Fresh                        -- For 'MonadFresh'.
+ ': NonDetEff                    -- For 'Alternative' and 'MonadNonDet'.
+ ': Reader (CacheFor term value) -- The in-cache used as an oracle while converging on a result.
+ ': State  (CacheFor term value) -- The out-cache used to record results in each iteration of convergence.
 ': effects

 -- | The cache for term and abstract value types.
 type CacheFor term value = Cache (LocationFor value) term value

+-- | A (coinductively-)cached analysis suitable for guaranteeing termination of (suitably finitized) analyses over recursive programs.
 newtype Caching m term value (effects :: [* -> *]) a = Caching (m term value effects a)
  deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh, MonadNonDet)

+deriving instance MonadEnvironment value (m term value effects) => MonadEnvironment value (Caching m term value effects)
+deriving instance MonadStore value (m term value effects) => MonadStore value (Caching m term value effects)
+deriving instance MonadModuleTable term value (m term value effects) => MonadModuleTable term value (Caching m term value effects)
 deriving instance MonadEvaluator term value (m term value effects) => MonadEvaluator term value (Caching m term value effects)

+-- | Functionality used to perform caching analysis. This is not exported, and exists primarily for organizational reasons.
 class MonadEvaluator term value m => MonadCaching term value m where
+  -- | Look up the set of values for a given configuration in the in-cache.
  consultOracle :: ConfigurationFor term value -> m (Set (value, StoreFor value))
+  -- | Run an action with the given in-cache.
  withOracle :: CacheFor term value -> m a -> m a

+  -- | Look up the set of values for a given configuration in the out-cache.
  lookupCache :: ConfigurationFor term value -> m (Maybe (Set (value, StoreFor value)))
+  -- | Run an action, caching its result and 'Store' under the given configuration.
  caching :: ConfigurationFor term value -> Set (value, StoreFor value) -> m value -> m value

+  -- | Run an action starting from an empty out-cache, and return the out-cache afterwards.
  isolateCache :: m a -> m (CacheFor term value)

 instance ( Effectful (m term value)
@ -70,7 +80,10 @@ instance ( Corecursive term
         , Ord value
         )
         => MonadAnalysis term value (Caching m term value effects) where
+  -- We require the 'CachingEffects' in addition to the underlying analysis’ 'RequiredEffects'.
  type RequiredEffects term value (Caching m term value effects) = CachingEffects term value (RequiredEffects term value (m term value effects))
+
+  -- Analyze a term using the in-cache as an oracle & storing the results of the analysis in the out-cache.
  analyzeTerm e = do
    c <- getConfiguration (embedSubterm e)
    cached <- lookupCache c
@ -92,7 +105,7 @@ instance ( Corecursive term
      -- that it doesn't "leak" to the calling context and diverge (otherwise this
      -- would never complete). We don’t need to use the values, so we 'gather' the
      -- nondeterministic values into @()@.
-      withOracle prevCache (gather (liftEvaluate evaluateModule e) :: Caching m term value effects ())) mempty
+      withOracle prevCache (gather (const ()) (Caching (evaluateModule e)))) mempty
    maybe empty scatter (cacheLookup c cache)

 -- | Iterate a monadic action starting from some initial seed until the results converge.
--- a/src/Analysis/Abstract/Dead.hs
+++ b/src/Analysis/Abstract/Dead.hs
@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, TypeOperators #-}
+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, TypeOperators #-}
 module Analysis.Abstract.Dead
 ( type DeadCode
 ) where
@ -12,6 +12,9 @@ import Prologue
 newtype DeadCode m term value (effects :: [* -> *]) a = DeadCode (m term value effects a)
  deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh, MonadNonDet)

+deriving instance MonadEnvironment value (m term value effects) => MonadEnvironment value (DeadCode m term value effects)
+deriving instance MonadStore value (m term value effects) => MonadStore value (DeadCode m term value effects)
+deriving instance MonadModuleTable term value (m term value effects) => MonadModuleTable term value (DeadCode m term value effects)
 deriving instance MonadEvaluator term value (m term value effects) => MonadEvaluator term value (DeadCode m term value effects)

 -- | A set of “dead” (unreachable) terms.
@ -42,10 +45,11 @@ instance ( Corecursive term
         )
         => MonadAnalysis term value (DeadCode m term value effects) where
  type RequiredEffects term value (DeadCode m term value effects) = State (Dead term) ': RequiredEffects term value (m term value effects)
+
  analyzeTerm term = do
    revive (embedSubterm term)
    liftAnalyze analyzeTerm term

  evaluateModule term = do
    killAll (subterms term)
-    liftEvaluate evaluateModule term
+    DeadCode (evaluateModule term)
--- a/src/Analysis/Abstract/Evaluating.hs
+++ b/src/Analysis/Abstract/Evaluating.hs
@ -12,6 +12,7 @@ import Control.Monad.Effect.Fresh
 import Control.Monad.Effect.NonDet
 import Control.Monad.Effect.Reader
 import Control.Monad.Effect.State
+import Data.Abstract.Configuration
 import Data.Abstract.Evaluatable
 import Data.Abstract.ModuleTable
 import Data.Abstract.Value
@ -62,12 +63,12 @@ newtype Evaluating term value effects a = Evaluating (Eff effects a)
  deriving (Applicative, Functor, Effectful, Monad)


-
 deriving instance Member Fail      effects => MonadFail   (Evaluating term value effects)
 deriving instance Member Fresh     effects => MonadFresh  (Evaluating term value effects)
 deriving instance Member NonDetEff effects => Alternative (Evaluating term value effects)
 deriving instance Member NonDetEff effects => MonadNonDet (Evaluating term value effects)

+-- | Effects necessary for evaluating (whether concrete or abstract).
 type EvaluatingEffects term value
  = '[ Fail                                        -- Failure with an error message
     , Reader (EnvironmentFor value)               -- Local environment (e.g. binding over a closure)
@ -77,22 +78,27 @@ type EvaluatingEffects term value
     , State  (ModuleTable (EnvironmentFor value)) -- Cache of evaluated modules
     ]

-instance Members (EvaluatingEffects term value) effects => MonadEvaluator term value (Evaluating term value effects) where
+instance Members '[Reader (EnvironmentFor value), State (EnvironmentFor value)] effects => MonadEnvironment value (Evaluating term value effects) where
  getGlobalEnv = raise get
  putGlobalEnv = raise . put

  askLocalEnv = raise ask
  localEnv f a = raise (local f (lower a))

+instance Member (State (StoreFor value)) effects => MonadStore value (Evaluating term value effects) where
  getStore = raise get
  putStore = raise . put

+instance Members '[Reader (ModuleTable term), State (ModuleTable (EnvironmentFor value))] effects => MonadModuleTable term value (Evaluating term value effects) where
  getModuleTable = raise get
-  modifyModuleTable f = raise (modify f)
+  putModuleTable = raise . put

  askModuleTable = raise ask
  localModuleTable f a = raise (local f (lower a))

+instance Members (EvaluatingEffects term value) effects => MonadEvaluator term value (Evaluating term value effects) where
+  getConfiguration term = Configuration term mempty <$> askLocalEnv <*> getStore
+
 instance ( Evaluatable (Base term)
         , FreeVariables term
         , Members (EvaluatingEffects term value) effects
@ -102,4 +108,5 @@ instance ( Evaluatable (Base term)
         )
         => MonadAnalysis term value (Evaluating term value effects) where
  type RequiredEffects term value (Evaluating term value effects) = EvaluatingEffects term value
+
  analyzeTerm = eval
--- a/src/Analysis/Abstract/Tracing.hs
+++ b/src/Analysis/Abstract/Tracing.hs
@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.Abstract.Tracing
 ( type Tracing
 ) where
@ -16,6 +16,9 @@ import Prologue
 newtype Tracing (trace :: * -> *) m term value (effects :: [* -> *]) a = Tracing (m term value effects a)
  deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh, MonadNonDet)

+deriving instance MonadEnvironment value (m term value effects) => MonadEnvironment value (Tracing trace m term value effects)
+deriving instance MonadStore value (m term value effects) => MonadStore value (Tracing trace m term value effects)
+deriving instance MonadModuleTable term value (m term value effects) => MonadModuleTable term value (Tracing trace m term value effects)
 deriving instance MonadEvaluator term value (m term value effects) => MonadEvaluator term value (Tracing trace m term value effects)

 instance ( Corecursive term
@ -27,11 +30,13 @@ instance ( Corecursive term
         )
         => MonadAnalysis term value (Tracing trace m term value effects) where
  type RequiredEffects term value (Tracing trace m term value effects) = Writer (trace (ConfigurationFor term value)) ': RequiredEffects term value (m term value effects)
+
  analyzeTerm term = do
    config <- getConfiguration (embedSubterm term)
    trace (Reducer.unit config)
    liftAnalyze analyzeTerm term

+-- | Log the given trace of configurations.
 trace :: ( Effectful (m term value)
         , Member (Writer (trace (ConfigurationFor term value))) effects
         )
--- a/src/Control/Abstract/Addressable.hs
+++ b/src/Control/Abstract/Addressable.hs
@ -25,7 +25,7 @@ class (Monad m, Ord l, l ~ LocationFor value, Reducer value (Cell l value)) => M
 --   The term is expected to contain one and only one free 'Name', meaning that care should be taken to apply this only to e.g. identifiers.
 lookupOrAlloc :: ( FreeVariables term
                 , MonadAddressable (LocationFor value) value m
-                 , MonadEvaluator term value m
+                 , MonadStore value m
                 , Semigroup (CellFor value)
                 )
                 => term
@ -38,7 +38,7 @@ lookupOrAlloc term = let [name] = toList (freeVariables term) in
 -- | Look up or allocate an address for a 'Name' & assign it a given value, returning the 'Name' paired with the address.
 lookupOrAlloc' :: ( Semigroup (CellFor value)
                  , MonadAddressable (LocationFor value) value m
-                  , MonadEvaluator term value m
+                  , MonadStore value m
                  )
                  => Name
                  -> value
@ -49,21 +49,11 @@ lookupOrAlloc' name v env = do
  assign a v
  pure (name, a)

-- | Write a value to the given 'Address' in the 'Store'.
-assign :: ( Ord (LocationFor value)
-          , MonadEvaluator term value m
-          , Reducer value (CellFor value)
-          )
-          => Address (LocationFor value) value
-          -> value
-          -> m ()
-assign address = modifyStore . storeInsert address
-

 -- Instances

 -- | 'Precise' locations are always 'alloc'ated a fresh 'Address', and 'deref'erence to the 'Latest' value written.
-instance (Monad m, LocationFor value ~ Precise, MonadEvaluator term value m) => MonadAddressable Precise value m where
+instance (MonadFail m, LocationFor value ~ Precise, MonadStore value m) => MonadAddressable Precise value m where
  deref = maybe uninitializedAddress (pure . unLatest) <=< flip fmap getStore . storeLookup
    where
      -- | Fail with a message denoting an uninitialized address (i.e. one which was 'alloc'ated, but never 'assign'ed a value before being 'deref'erenced).
@ -74,7 +64,7 @@ instance (Monad m, LocationFor value ~ Precise, MonadEvaluator term value m) =>


 -- | 'Monovariant' locations 'alloc'ate one 'Address' per unique variable name, and 'deref'erence once per stored value, nondeterministically.
-instance (Alternative m, Monad m, LocationFor value ~ Monovariant, MonadEvaluator term value m, Ord value) => MonadAddressable Monovariant value m where
+instance (Alternative m, LocationFor value ~ Monovariant, MonadStore value m, Ord value) => MonadAddressable Monovariant value m where
  deref = asum . maybe [] (map pure . toList) <=< flip fmap getStore . storeLookup

  alloc = pure . Address . Monovariant
--- a/src/Control/Abstract/Analysis.hs
+++ b/src/Control/Abstract/Analysis.hs
@ -1,9 +1,8 @@
-{-# LANGUAGE DataKinds, KindSignatures, MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE DataKinds, MultiParamTypeClasses, TypeFamilies #-}
 module Control.Abstract.Analysis
 ( MonadAnalysis(..)
 , evaluateTerm
 , liftAnalyze
-, liftEvaluate
 , runAnalysis
 , module X
 , Subterm(..)
@ -25,10 +24,13 @@ import Prologue
 --
 --   This typeclass is left intentionally unconstrained to avoid circular dependencies between it and other typeclasses.
 class (MonadEvaluator term value m, Recursive term) => MonadAnalysis term value m where
+  -- | The effects necessary to run the analysis. Analyses which are composed on top of (wrap) other analyses should include the inner analyses 'RequiredEffects' in their own list.
  type family RequiredEffects term value m :: [* -> *]
+
  -- | Analyze a term using the semantics of the current analysis. This should generally only be called by definitions of 'evaluateTerm' and 'analyzeTerm' in this or other instances.
  analyzeTerm :: SubtermAlgebra (Base term) term (m value)

+  -- | Evaluate a (root-level) term to a value using the semantics of the current analysis. This should be used to evaluate single-term programs as well as each module in multi-term programs.
  evaluateModule :: term -> m value
  evaluateModule = evaluateTerm

@ -38,6 +40,8 @@ class (MonadEvaluator term value m, Recursive term) => MonadAnalysis term value
 evaluateTerm :: MonadAnalysis term value m => term -> m value
 evaluateTerm = foldSubterms analyzeTerm

+
+-- | Lift a 'SubtermAlgebra' for an underlying analysis into a containing analysis. Use this when defining an analysis which can be composed onto other analyses to ensure that a call to 'analyzeTerm' occurs in the inner analysis and not the outer one.
 liftAnalyze :: ( Coercible (  m term value (effects :: [* -> *]) value) (t m term value effects value)
               , Coercible (t m term value effects value) (  m term value effects value)
               , Functor (Base term)
@ -46,12 +50,15 @@ liftAnalyze :: ( Coercible (  m term value (effects :: [* -> *]) value) (t m ter
            -> SubtermAlgebra (Base term) term (t m term value effects value)
 liftAnalyze analyze term = coerce (analyze (second coerce <$> term))

-liftEvaluate :: ( Coercible (m term value (effects :: [* -> *]) value) (t m term value effects value)
-                )
-             => (term ->   m term value effects value)
-             -> (term -> t m term value effects value)
-liftEvaluate evaluate = coerce . evaluate

-
-runAnalysis :: (Effectful m, RunEffects effects a, RequiredEffects term value (m effects) ~ effects, MonadAnalysis term value (m effects)) => m effects a -> Final effects a
+-- | Run an analysis, performing its effects and returning the result alongside any state.
+--
+--   This enables us to refer to the analysis type as e.g. @Analysis1 (Analysis2 Evaluating) Term Value@ without explicitly mentioning its effects (which are inferred to be simply its 'RequiredEffects').
+runAnalysis :: ( Effectful m
+               , RunEffects effects a
+               , RequiredEffects term value (m effects) ~ effects
+               , MonadAnalysis term value (m effects)
+               )
+            => m effects a
+            -> Final effects a
 runAnalysis = Effect.run . runEffects . lower
--- a/src/Control/Abstract/Evaluator.hs
+++ b/src/Control/Abstract/Evaluator.hs
@ -1,10 +1,21 @@
 {-# LANGUAGE ConstrainedClassMethods, FunctionalDependencies #-}
-module Control.Abstract.Evaluator where
+module Control.Abstract.Evaluator
+( MonadEvaluator(..)
+, MonadEnvironment(..)
+, modifyGlobalEnv
+, MonadStore(..)
+, modifyStore
+, assign
+, MonadModuleTable(..)
+, modifyModuleTable
+) where

+import Data.Abstract.Address
 import Data.Abstract.Configuration
-import Data.Abstract.Live
 import Data.Abstract.ModuleTable
+import Data.Abstract.Store
 import Data.Abstract.Value
+import Data.Semigroup.Reducer
 import Prelude hiding (fail)
 import Prologue

@ -14,7 +25,17 @@ import Prologue
 --   - environments binding names to addresses
 --   - a heap mapping addresses to (possibly sets of) values
 --   - tables of modules available for import
-class MonadFail m => MonadEvaluator term value m | m -> term, m -> value where
+class ( MonadEnvironment value m
+      , MonadFail m
+      , MonadModuleTable term value m
+      , MonadStore value m
+      )
+      => MonadEvaluator term value m | m -> term, m -> value where
+  -- | Get the current 'Configuration' with a passed-in term.
+  getConfiguration :: Ord (LocationFor value) => term -> m (ConfigurationFor term value)
+
+-- | A 'Monad' abstracting local and global environments.
+class Monad m => MonadEnvironment value m | m -> value where
  -- | Retrieve the global environment.
  getGlobalEnv :: m (EnvironmentFor value)
  -- | Set the global environment
@ -25,33 +46,51 @@ class MonadFail m => MonadEvaluator term value m | m -> term, m -> value where
  -- | Run an action with a locally-modified environment.
  localEnv :: (EnvironmentFor value -> EnvironmentFor value) -> m a -> m a

+-- | Update the global environment.
+modifyGlobalEnv :: MonadEvaluator term value m => (EnvironmentFor value -> EnvironmentFor value) -> m  ()
+modifyGlobalEnv f = do
+  env <- getGlobalEnv
+  putGlobalEnv $! f env
+
+
+-- | A 'Monad' abstracting a heap of values.
+class Monad m => MonadStore value m | m -> value where
  -- | Retrieve the heap.
  getStore :: m (StoreFor value)
  -- | Set the heap.
  putStore :: StoreFor value -> m ()

+-- | Update the heap.
+modifyStore :: MonadStore value m => (StoreFor value -> StoreFor value) -> m ()
+modifyStore f = do
+  s <- getStore
+  putStore $! f s
+
+-- | Write a value to the given 'Address' in the 'Store'.
+assign :: ( Ord (LocationFor value)
+          , MonadStore value m
+          , Reducer value (CellFor value)
+          )
+          => Address (LocationFor value) value
+          -> value
+          -> m ()
+assign address = modifyStore . storeInsert address
+
+
+-- | A 'Monad' abstracting tables of modules available for import.
+class Monad m => MonadModuleTable term value m | m -> term, m -> value where
  -- | Retrieve the table of evaluated modules.
  getModuleTable :: m (ModuleTable (EnvironmentFor value))
-  -- | Update the table of evaluated modules.
-  modifyModuleTable :: (ModuleTable (EnvironmentFor value) -> ModuleTable (EnvironmentFor value)) -> m ()
+  -- | Set the table of evaluated modules.
+  putModuleTable :: ModuleTable (EnvironmentFor value) -> m ()

  -- | Retrieve the table of unevaluated modules.
  askModuleTable :: m (ModuleTable term)
  -- | Run an action with a locally-modified table of unevaluated modules.
  localModuleTable :: (ModuleTable term -> ModuleTable term) -> m a -> m a

-  -- | Retrieve the current root set.
-  askRoots :: Ord (LocationFor value) => m (Live (LocationFor value) value)
-  askRoots = pure mempty
-
-  -- | Get the current 'Configuration' with a passed-in term.
-  getConfiguration :: Ord (LocationFor value) => term -> m (Configuration (LocationFor value) term value)
-  getConfiguration term = Configuration term <$> askRoots <*> askLocalEnv <*> getStore
-
-- | Update the global environment.
-modifyGlobalEnv :: MonadEvaluator term value m => (EnvironmentFor value -> EnvironmentFor value) -> m  ()
-modifyGlobalEnv f = getGlobalEnv >>= putGlobalEnv . f
-
-- | Update the heap.
-modifyStore :: MonadEvaluator term value m => (StoreFor value -> StoreFor value) -> m ()
-modifyStore f = getStore >>= putStore . f
+-- | Update the evaluated module table.
+modifyModuleTable :: MonadModuleTable term value m => (ModuleTable (EnvironmentFor value) -> ModuleTable (EnvironmentFor value)) -> m ()
+modifyModuleTable f = do
+  table <- getModuleTable
+  putModuleTable $! f table
--- a/src/Control/Abstract/Value.hs
+++ b/src/Control/Abstract/Value.hs
@ -15,8 +15,9 @@ import Prologue
 -- | A 'Monad' abstracting the evaluation of (and under) binding constructs (functions, methods, etc).
 --
 --   This allows us to abstract the choice of whether to evaluate under binders for different value types.
-class MonadAnalysis term value m => MonadValue term value m where
+class (MonadAnalysis term value m, Show value) => MonadValue term value m where
  -- | Construct an abstract unit value.
+  --   TODO: This might be the same as the empty tuple for some value types
  unit :: m value

  -- | Construct an abstract integral value.
@ -43,6 +44,9 @@ class MonadAnalysis term value m => MonadValue term value m where
  -- | Construct a floating-point value.
  float :: Scientific -> m value

+  -- | Construct an N-ary tuple of multiple (possibly-disjoint) values
+  multiple :: [value] -> m value
+
  -- | Construct an abstract interface value.
  interface :: value -> m value

@ -68,25 +72,30 @@ evalToBool = subtermValue >=> toBool
 -- | Construct a 'Value' wrapping the value arguments (if any).
 instance ( MonadAddressable location (Value location term) m
         , MonadAnalysis term (Value location term) m
+         , Show location
+         , Show term
         )
         => MonadValue term (Value location term) m where

-  unit    = pure $ inj Value.Unit
-  integer = pure . inj . Integer
-  boolean = pure . inj . Boolean
-  string  = pure . inj . Value.String
-  float   = pure . inj . Value.Float
-  interface v = inj . Value.Interface v <$> getGlobalEnv
+  unit    = pure . injValue $ Value.Unit
+  integer = pure . injValue . Integer
+  boolean = pure . injValue . Boolean
+  string  = pure . injValue . Value.String
+  float   = pure . injValue . Value.Float
+  multiple vals =
+    pure . injValue $ Value.Tuple vals
+
+  interface v = injValue . Value.Interface v <$> getGlobalEnv

  ifthenelse cond if' else'
-    | Just (Boolean b) <- prj cond = if b then if' else else'
-    | otherwise = fail "not defined for non-boolean conditions"
+    | Just (Boolean b) <- prjValue cond = if b then if' else else'
+    | otherwise = fail ("not defined for non-boolean conditions: " <> show cond)

  liftNumeric f arg
    | Just (Integer i)     <- prj arg = pure . inj . Integer     $ f i
    | Just (Value.Float i) <- prj arg = pure . inj . Value.Float $ f i
    | otherwise = fail "Invalid operand to liftNumeric"
-   
+
  liftNumeric2 f g left right
    | Just (Integer i, Integer j)         <- au pair = pure . inj . Integer $ g i j
    | Just (Integer i, Value.Float j)     <- au pair = pure . inj . float   $ f (fromIntegral i) (munge j)
@ -104,10 +113,10 @@ instance ( MonadAddressable location (Value location term) m
        au = bitraverse prj prj
        pair = (left, right)

-  abstract names (Subterm body _) = inj . Closure names body <$> askLocalEnv
+  abstract names (Subterm body _) = injValue . Closure names body <$> askLocalEnv

  apply op params = do
-    Closure names body env <- maybe (fail "expected a closure") pure (prj op)
+    Closure names body env <- maybe (fail ("expected a closure, got: " <> show op)) pure (prjValue op)
    bindings <- foldr (\ (name, param) rest -> do
      v <- subtermValue param
      a <- alloc name
@ -116,8 +125,8 @@ instance ( MonadAddressable location (Value location term) m
    localEnv (mappend bindings) (evaluateTerm body)

  environment v
-    | Just (Interface _ env) <- prj v = pure env
-    | otherwise                       = pure mempty
+    | Just (Interface _ env) <- prjValue v = pure env
+    | otherwise                            = pure mempty

 -- | Discard the value arguments (if any), constructing a 'Type.Type' instead.
 instance (Alternative m, MonadAnalysis term Type m, MonadFresh m) => MonadValue term Type m where
@ -136,7 +145,7 @@ instance (Alternative m, MonadAnalysis term Type m, MonadFresh m) => MonadValue
  boolean _ = pure Bool
  string _  = pure Type.String
  float _   = pure Type.Float
-
+  multiple  = pure . Type.Product
  -- TODO
  interface = undefined

--- a/src/Control/Effect.hs
+++ b/src/Control/Effect.hs
@ -66,8 +66,13 @@ instance Ord a => RunEffect NonDetEff a where
    MPlus -> mappend <$> k True <*> k False)


-class Effectful m where
+-- | Types wrapping 'Eff' actions.
+--
+--   Most instances of 'Effectful' will be derived using @-XGeneralizedNewtypeDeriving@, with these ultimately bottoming out on the instance for 'Eff' (for which 'raise' and 'lower' are simply the identity). Because of this, types can be nested arbitrarily deeply and still call 'raise'/'lower' just once to get at the (ultimately) underlying 'Eff'.
+class Effectful (m :: [* -> *] -> * -> *) where
+  -- | Raise an action in 'Eff' into an action in @m@.
  raise :: Eff effects a -> m effects a
+  -- | Lower an action in @m@ into an action in 'Eff'.
  lower :: m effects a -> Eff effects a

 instance Effectful Eff where
--- a/src/Control/Monad/Effect/Cache.hs
+++ b/src/Control/Monad/Effect/Cache.hs
@ -1,63 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
-module Control.Monad.Effect.Cache where
-
-import Control.Monad.Effect
-import Control.Monad.Effect.Reader
-import Control.Monad.Effect.State
-import Data.Abstract.Cache
-import Data.Abstract.Value
-
-- | 'Monad's offering a readable 'Cache' of values & stores for each configuration in a program.
--
--   This (in-)cache is used as an oracle for the results of recursive computations, allowing us to finitize potentially nonterminating control flow by repeatedly computing the results until analysis converges on a stable value. Each iteration of this process must consult this cache only _after_ evaluating the configuration itself in order to ensure soundness (since it could otherwise produce stale results for some configurations).
--
--   Since finitization crucially depends on convergence, this cache should only be used with value abstractions that will converge for multiple disjoint assignments of a given variable, e.g. its type, and not with precisely-modelled values. To illustrate why, consider a simple incrementing recursive function:
--
--   > inc :: Integer -> a
--   > inc n = inc (n + 1)
--
--   @n@ differs at every iteration, and thus a precise modelling of the integral value will not converge in the store: each iteration will allocate a new address & write a distinct value into it. Modelling values with their types _will_ converge, however, as the type at each iteration is the same.
-class Monad m => MonadCacheIn t v m where
-  -- | Retrieve the local in-cache.
-  askCache :: m (Cache (LocationFor v) t v)
-
-  -- | Run a computation with a locally-modified in-cache.
-  localCache :: (Cache (LocationFor v) t v -> Cache (LocationFor v) t v) -> m a -> m a
-
-instance (Reader (Cache (LocationFor v) t v) :< fs) => MonadCacheIn t v (Eff fs) where
-  askCache = ask
-  localCache = local
-
-- | Project a value out of the in-cache.
-asksCache :: MonadCacheIn t v m => (Cache (LocationFor v) t v -> a) -> m a
-asksCache f = f <$> askCache
-
-
-- | 'Monad's offering a readable & writable 'Cache' of values & stores for each configuration in a program.
--
--   This (out-)cache is used to store the results of recursive computations, allowing us to finitize each iteration of an analysis by first looking up the current configuration in the cache and only evaluating:
--
--   1. If the configuration has not been visited before, and
--   2. _after_ copying the previous iteration’s results (from the in-cache, and defaulting to a 'mempty' set of results) into the out-cache.
--
--   Thus, visiting the same configuration twice recursively will terminate, since we’ll have consulted the in-cache as an oracle before evaluating, and after evaluating, the resulting value and store should be appended into the out-cache. Then, once the current iteration of the analysis has completed, the updated out-cache will be used as the oracle for the next iteration, until such time as the cache converges.
--
--   See also 'MonadCacheIn' for discussion of the conditions of finitization.
-class Monad m => MonadCacheOut t v m where
-  -- | Retrieve the current out-cache.
-  getCache :: m (Cache (LocationFor v) t v)
-
-  -- | Update the current out-cache.
-  putCache :: Cache (LocationFor v) t v -> m ()
-
-instance (State (Cache (LocationFor v) t v) :< fs) => MonadCacheOut t v (Eff fs) where
-  getCache = get
-  putCache = put
-
-- | Project a value out of the out-cache.
-getsCache :: MonadCacheOut t v m => (Cache (LocationFor v) t v -> a) -> m a
-getsCache f = f <$> getCache
-
-- | Modify the current out-cache using a given function.
-modifyCache :: MonadCacheOut t v m => (Cache (LocationFor v) t v -> Cache (LocationFor v) t v) -> m ()
-modifyCache f = fmap f getCache >>= putCache
--- a/src/Control/Monad/Effect/NonDet.hs
+++ b/src/Control/Monad/Effect/NonDet.hs
@ -6,18 +6,18 @@ module Control.Monad.Effect.NonDet

 import Control.Monad.Effect.Internal
 import Control.Monad.Effect.NonDetEff
-import Data.Semigroup.Reducer
 import Prologue

 -- | 'Monad's offering local isolation of nondeterminism effects.
 class (Alternative m, Monad m) => MonadNonDet m where
  -- | Run a computation, gathering any nondeterministically produced results into a single 'Monoid'al value.
-  gather :: (Monoid b, Reducer a b)
-         => m a -- ^ The computation to run locally-nondeterministically.
-         -> m b -- ^ A _deterministic_ computation producing the 'Monoid'al accumulation of the _locally-nondeterministic_ result values.
+  gather :: Monoid b
+         => (a -> b) -- ^ A function constructing a 'Monoid'al value from a single computed result. This might typically be @unit@ (for @Reducer@s), 'pure' (for 'Applicative's), or some similar singleton constructor.
+         -> m a      -- ^ The computation to run locally-nondeterministically.
+         -> m b      -- ^ A _deterministic_ computation producing the 'Monoid'al accumulation of the _locally-nondeterministic_ result values.

 -- | Effect stacks containing 'NonDetEff' offer a 'MonadNonDet' instance which implements 'gather' by interpreting the requests for nondeterminism locally, without removing 'NonDetEff' from the stack—i.e. the _capacity_ for nondeterminism is still present in the effect stack, but any local nondeterminism has been applied.
 instance (NonDetEff :< fs) => MonadNonDet (Eff fs) where
-  gather = interpose (pure . unit) (\ m k -> case m of
+  gather f = interpose (pure . f) (\ m k -> case m of
    MZero -> pure mempty
    MPlus -> mappend <$> k True <*> k False)
--- a/src/Data/Abstract/Cache.hs
+++ b/src/Data/Abstract/Cache.hs
@ -4,11 +4,11 @@ module Data.Abstract.Cache where
 import Data.Abstract.Address
 import Data.Abstract.Configuration
 import Data.Abstract.Store
-import Data.Map.Monoidal as Map
+import Data.Map.Monoidal as Monoidal
 import Prologue

 -- | A map of 'Configuration's to 'Set's of resulting values & 'Store's.
-newtype Cache l t v = Cache { unCache :: Map.Map (Configuration l t v) (Set (v, Store l v)) }
+newtype Cache l t v = Cache { unCache :: Monoidal.Map (Configuration l t v) (Set (v, Store l v)) }

 deriving instance (Eq l, Eq t, Eq v, Eq (Cell l v)) => Eq (Cache l t v)
 deriving instance (Ord l, Ord t, Ord v, Ord (Cell l v)) => Ord (Cache l t v)
@ -19,11 +19,11 @@ deriving instance (Ord l, Ord t, Ord v, Ord (Cell l v)) => Reducer (Configuratio

 -- | Look up the resulting value & 'Store' for a given 'Configuration'.
 cacheLookup :: (Ord l, Ord t, Ord v, Ord (Cell l v)) => Configuration l t v -> Cache l t v -> Maybe (Set (v, Store l v))
-cacheLookup key = Map.lookup key . unCache
+cacheLookup key = Monoidal.lookup key . unCache

 -- | Set the resulting value & 'Store' for a given 'Configuration', overwriting any previous entry.
 cacheSet :: (Ord l, Ord t, Ord v, Ord (Cell l v)) => Configuration l t v -> Set (v, Store l v) -> Cache l t v -> Cache l t v
-cacheSet key value = Cache . Map.insert key value . unCache
+cacheSet key value = Cache . Monoidal.insert key value . unCache

 -- | Insert the resulting value & 'Store' for a given 'Configuration', appending onto any previous entry.
 cacheInsert :: (Ord l, Ord t, Ord v, Ord (Cell l v)) => Configuration l t v -> (v, Store l v) -> Cache l t v -> Cache l t v
--- a/src/Data/Abstract/Evaluatable.hs
+++ b/src/Data/Abstract/Evaluatable.hs
@ -88,7 +88,7 @@ load :: ( MonadAnalysis term value m
 load name = askModuleTable >>= maybe notFound evalAndCache . moduleTableLookup name
  where notFound = fail ("cannot load module: " <> show name)
        evalAndCache e = do
-          v <- evaluateTerm e
+          v <- evaluateModule e
          env <- environment v
          modifyModuleTable (moduleTableInsert name env)
          pure env
--- a/src/Data/Abstract/Store.hs
+++ b/src/Data/Abstract/Store.hs
@ -3,12 +3,12 @@ module Data.Abstract.Store where

 import Data.Abstract.Address
 import Data.Abstract.Live
-import qualified Data.Map.Monoidal as Map
+import qualified Data.Map.Monoidal as Monoidal
 import Data.Semigroup.Reducer
 import Prologue

 -- | A map of addresses onto cells holding their values.
-newtype Store l a = Store { unStore :: Map.Map l (Cell l a) }
+newtype Store l a = Store { unStore :: Monoidal.Map l (Cell l a) }
  deriving (Generic1)

 deriving instance (Eq l, Eq (Cell l a)) => Eq (Store l a)
@ -26,7 +26,7 @@ deriving instance (Ord l, Reducer a (Cell l a)) => Reducer (l, a) (Store l a)

 -- | Look up the cell of values for an 'Address' in a 'Store', if any.
 storeLookup :: Ord l => Address l a -> Store l a -> Maybe (Cell l a)
-storeLookup (Address address) = Map.lookup address . unStore
+storeLookup (Address address) = Monoidal.lookup address . unStore

 -- | Look up the list of values stored for a given address, if any.
 storeLookupAll :: (Ord l, Foldable (Cell l)) => Address l a -> Store l a -> Maybe [a]
@ -38,8 +38,8 @@ storeInsert (Address address) value = flip snoc (address, value)

 -- | The number of addresses extant in a 'Store'.
 storeSize :: Store l a -> Int
-storeSize = Map.size . unStore
+storeSize = Monoidal.size . unStore

 -- | Restrict a 'Store' to only those 'Address'es in the given 'Live' set (in essence garbage collecting the rest).
 storeRestrict :: Ord l => Store l a -> Live l a -> Store l a
-storeRestrict (Store m) roots = Store (Map.filterWithKey (\ address _ -> Address address `liveMember` roots) m)
+storeRestrict (Store m) roots = Store (Monoidal.filterWithKey (\ address _ -> Address address `liveMember` roots) m)
--- a/src/Data/Abstract/Value.hs
+++ b/src/Data/Abstract/Value.hs
@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, DataKinds, FunctionalDependencies, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
+{-# LANGUAGE ConstraintKinds, DataKinds, FunctionalDependencies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
 module Data.Abstract.Value where

 import Data.Abstract.Address
@ -13,32 +13,42 @@ import Prologue
 import Prelude hiding (Float, Integer, String, fail)
 import qualified Prelude

-type ValueConstructors location
-  = '[Closure location
+type ValueConstructors location term
+  = '[Closure location term
    , Interface location
    , Unit
    , Boolean
    , Float
    , Integer
    , String
+    , Tuple
    ]

 -- | Open union of primitive values that terms can be evaluated to.
-type Value location = Union (ValueConstructors location)
+--   Fix by another name.
+newtype Value location term = Value { deValue :: Union (ValueConstructors location term) (Value location term) }
+  deriving (Eq, Show, Ord)
+
+-- | Identical to 'inj', but wraps the resulting sub-entity in a 'Value'.
+injValue :: (f :< ValueConstructors location term) => f (Value location term) -> Value location term
+injValue = Value . inj
+
+-- | Identical to 'prj', but unwraps the argument out of its 'Value' wrapper.
+prjValue :: (f :< ValueConstructors location term) => Value location term -> Maybe (f (Value location term))
+prjValue = prj . deValue

 -- TODO: Parameterize Value by the set of constructors s.t. each language can have a distinct value union.
-- TODO: Wrap the Value union in a newtype to differentiate from (eventual) à la carte Types.

 -- | A function value consisting of a list of parameters, the body of the function, and an environment of bindings captured by the body.
-data Closure location term = Closure [Name] term (Environment location (Value location term))
+data Closure location term value = Closure [Name] term (Environment location value)
  deriving (Eq, Generic1, Ord, Show)

-instance (Eq location) => Eq1 (Closure location) where liftEq = genericLiftEq
-instance (Ord location) => Ord1 (Closure location) where liftCompare = genericLiftCompare
-instance (Show location) => Show1 (Closure location) where liftShowsPrec = genericLiftShowsPrec
+instance (Eq location, Eq term) => Eq1 (Closure location term) where liftEq = genericLiftEq
+instance (Ord location, Ord term) => Ord1 (Closure location term) where liftCompare = genericLiftCompare
+instance (Show location, Show term) => Show1 (Closure location term) where liftShowsPrec = genericLiftShowsPrec

 -- | A program value consisting of the value of the program and it's enviornment of bindings.
-data Interface location term = Interface (Value location term) (Environment location (Value location term))
+data Interface location value = Interface value (Environment location value)
  deriving (Eq, Generic1, Ord, Show)

 instance (Eq location) => Eq1 (Interface location) where liftEq = genericLiftEq
@ -46,7 +56,7 @@ instance (Ord location) => Ord1 (Interface location) where liftCompare = generic
 instance (Show location) => Show1 (Interface location) where liftShowsPrec = genericLiftShowsPrec

 -- | The unit value. Typically used to represent the result of imperative statements.
-data Unit term = Unit
+data Unit value = Unit
  deriving (Eq, Generic1, Ord, Show)

 instance Eq1 Unit where liftEq = genericLiftEq
@ -54,7 +64,7 @@ instance Ord1 Unit where liftCompare = genericLiftCompare
 instance Show1 Unit where liftShowsPrec = genericLiftShowsPrec

 -- | Boolean values.
-newtype Boolean term = Boolean Prelude.Bool
+newtype Boolean value = Boolean Prelude.Bool
  deriving (Eq, Generic1, Ord, Show)

 instance Eq1 Boolean where liftEq = genericLiftEq
@ -62,7 +72,7 @@ instance Ord1 Boolean where liftCompare = genericLiftCompare
 instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec

 -- | Arbitrary-width integral values.
-newtype Integer term = Integer Prelude.Integer
+newtype Integer value = Integer Prelude.Integer
  deriving (Eq, Generic1, Ord, Show)

 instance Eq1 Integer where liftEq = genericLiftEq
@ -70,7 +80,7 @@ instance Ord1 Integer where liftCompare = genericLiftCompare
 instance Show1 Integer where liftShowsPrec = genericLiftShowsPrec

 -- | String values.
-newtype String term = String ByteString
+newtype String value = String ByteString
  deriving (Eq, Generic1, Ord, Show)

 instance Eq1 String where liftEq = genericLiftEq
@ -78,13 +88,24 @@ instance Ord1 String where liftCompare = genericLiftCompare
 instance Show1 String where liftShowsPrec = genericLiftShowsPrec

 -- | Float values.
-newtype Float term = Float Scientific
+newtype Float value = Float Scientific
  deriving (Eq, Generic1, Ord, Show)

 instance Eq1 Float where liftEq = genericLiftEq
 instance Ord1 Float where liftCompare = genericLiftCompare
 instance Show1 Float where liftShowsPrec = genericLiftShowsPrec

+-- Zero or more values.
+-- TODO: Investigate whether we should use Vector for this.
+-- TODO: Should we have a Some type over a nonemmpty list? Or does this merit one?
+
+newtype Tuple value = Tuple [value]
+  deriving (Eq, Generic1, Ord, Show)
+
+instance Eq1 Tuple where liftEq = genericLiftEq
+instance Ord1 Tuple where liftCompare = genericLiftCompare
+instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec
+
 -- | The environment for an abstract value type.
 type EnvironmentFor v = Environment (LocationFor v) v

@ -106,8 +127,8 @@ class ValueRoots l v | v -> l where

 instance (FreeVariables term, Ord location) => ValueRoots location (Value location term) where
  valueRoots v
-    | Just (Closure names body env) <- prj v = envRoots env (foldr Set.delete (freeVariables body) names)
-    | otherwise                              = mempty
+    | Just (Closure names body env) <- prjValue v = envRoots env (foldr Set.delete (freeVariables (body :: term)) names)
+    | otherwise                                   = mempty

 instance ValueRoots Monovariant Type.Type where
  valueRoots _ = mempty
--- a/src/Data/Algebra.hs
+++ b/src/Data/Algebra.hs
@ -14,9 +14,7 @@ module Data.Algebra
 , openFToOpenR
 ) where

-import Data.Bifoldable
 import Data.Bifunctor
-import Data.Bitraversable
 import Data.Functor.Foldable ( Base
                             , Corecursive(embed)
                             , Recursive(project)
@ -50,15 +48,9 @@ type OpenRAlgebra f t a = forall b . (b -> (t, a)) -> f b -> a
 data Subterm t a = Subterm { subterm :: !t, subtermValue :: !a }
  deriving (Eq, Foldable, Functor, Ord, Show, Traversable)

-instance Bifoldable Subterm where
-  bifoldMap f g (Subterm a b) = f a `mappend` g b
-
 instance Bifunctor Subterm where
  bimap f g (Subterm a b) = Subterm (f a) (g b)

-instance Bitraversable Subterm where
-  bitraverse f g (Subterm a b) = Subterm <$> f a <*> g b
-
 -- | Like an R-algebra, but using 'Subterm' to label the fields instead of an anonymous pair.
 type SubtermAlgebra f t a = f (Subterm t a) -> a

--- a/src/Data/Diff.hs
+++ b/src/Data/Diff.hs
@ -82,11 +82,6 @@ merging :: Functor syntax => Term syntax ann -> Diff syntax ann ann
 merging = cata (\ (In ann syntax) -> mergeF (In (ann, ann) syntax))


-diffPatch :: Diff syntax ann1 ann2 -> Maybe (Patch (TermF syntax ann1 (Diff syntax ann1 ann2)) (TermF syntax ann2 (Diff syntax ann1 ann2)))
-diffPatch diff = case unDiff diff of
-  Patch patch -> Just patch
-  _ -> Nothing
-
 diffPatches :: (Foldable syntax, Functor syntax) => Diff syntax ann1 ann2 -> [Patch (TermF syntax ann1 (Diff syntax ann1 ann2)) (TermF syntax ann2 (Diff syntax ann1 ann2))]
 diffPatches = para $ \ diff -> case diff of
  Patch patch -> bimap (fmap fst) (fmap fst) patch : bifoldMap (foldMap snd) (foldMap snd) patch
--- a/src/Data/Syntax/Declaration.hs
+++ b/src/Data/Syntax/Declaration.hs
@ -1,11 +1,11 @@
 {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-}
 module Data.Syntax.Declaration where

-import Prologue
 import Data.Abstract.Environment
 import Data.Abstract.Evaluatable
 import Diffing.Algorithm
 import qualified Data.Map as Map
+import Prologue

 data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a }
  deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
@ -88,7 +88,7 @@ instance Evaluatable OptionalParameter

 -- TODO: Should we replace this with Function and differentiate by context?
 -- TODO: How should we distinguish class/instance methods?
-
+-- TODO: It would be really nice to have a more meaningful type contained in here than [a]
 -- | A declaration of possibly many variables such as var foo = 5, bar = 6 in JavaScript.
 newtype VariableDeclaration a = VariableDeclaration { variableDeclarations :: [a] }
  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
@ -97,9 +97,9 @@ instance Eq1 VariableDeclaration where liftEq = genericLiftEq
 instance Ord1 VariableDeclaration where liftCompare = genericLiftCompare
 instance Show1 VariableDeclaration where liftShowsPrec = genericLiftShowsPrec

-- TODO: Implement Eval instance for VariableDeclaration
-instance Evaluatable VariableDeclaration
-
+instance Evaluatable VariableDeclaration where
+  eval (VariableDeclaration [])   = unit
+  eval (VariableDeclaration decs) = multiple =<< traverse subtermValue decs

 -- | A TypeScript/Java style interface declaration to implement.
 data InterfaceDeclaration a = InterfaceDeclaration { interfaceDeclarationContext :: ![a], interfaceDeclarationIdentifier :: !a, interfaceDeclarationBody :: !a }
@ -156,8 +156,19 @@ instance Eq1 Module where liftEq = genericLiftEq
 instance Ord1 Module where liftCompare = genericLiftCompare
 instance Show1 Module where liftShowsPrec = genericLiftShowsPrec

-- TODO: Implement Eval instance for Module
-instance Evaluatable Module
+-- TODO: Fix this extremely bogus instance (copied from that of Program)
+-- In Go, functions in the same module can be spread across files.
+-- We need to ensure that all input files have aggregated their content into
+-- a coherent module before we begin evaluating a module.
+instance Evaluatable Module where
+  eval (Module _ xs) = eval' xs
+    where
+    eval' [] = unit >>= interface
+    eval' [x] = subtermValue x >>= interface
+    eval' (x:xs) = do
+      _ <- subtermValue x
+      env <- getGlobalEnv
+      localEnv (envUnion env) (eval' xs)

 -- | A decorator in Python
 data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a }
--- a/src/Data/Syntax/Literal.hs
+++ b/src/Data/Syntax/Literal.hs
@ -236,9 +236,8 @@ instance Eq1 Tuple where liftEq = genericLiftEq
 instance Ord1 Tuple where liftCompare = genericLiftCompare
 instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec

-- TODO: Implement Eval instance for Tuple
-instance Evaluatable Tuple
-
+instance Evaluatable Tuple where
+  eval (Tuple cs) = multiple =<< traverse subtermValue cs

 newtype Set a = Set { setElements :: [a] }
  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
--- a/src/Language/Go/Syntax.hs
+++ b/src/Language/Go/Syntax.hs
@ -2,51 +2,70 @@
 module Language.Go.Syntax where

 import Prologue
+import Data.Abstract.Evaluatable
 import Diffing.Algorithm

 -- A composite literal in Go
 data Composite a = Composite { compositeType :: !a, compositeElement :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 Composite where liftEq = genericLiftEq
 instance Ord1 Composite where liftCompare = genericLiftCompare
 instance Show1 Composite where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for Composite
+instance Evaluatable Composite
+
 -- | A default pattern in a Go select or switch statement (e.g. `switch { default: s() }`).
 newtype DefaultPattern a = DefaultPattern { defaultPatternBody :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 DefaultPattern where liftEq = genericLiftEq
 instance Ord1 DefaultPattern where liftCompare = genericLiftCompare
 instance Show1 DefaultPattern where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for DefaultPattern
+instance Evaluatable DefaultPattern
+
 -- | A defer statement in Go (e.g. `defer x()`).
 newtype Defer a = Defer { deferBody :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 Defer where liftEq = genericLiftEq
 instance Ord1 Defer where liftCompare = genericLiftCompare
 instance Show1 Defer where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for Defer
+instance Evaluatable Defer
+
 -- | A go statement (i.e. go routine) in Go (e.g. `go x()`).
 newtype Go a = Go { goBody :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 Go where liftEq = genericLiftEq
 instance Ord1 Go where liftCompare = genericLiftCompare
 instance Show1 Go where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for Go
+instance Evaluatable Go
+
 -- | A label statement in Go (e.g. `label:continue`).
 data Label a = Label { _labelName :: !a, labelStatement :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 Label where liftEq = genericLiftEq
 instance Ord1 Label where liftCompare = genericLiftCompare
 instance Show1 Label where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for Label
+instance Evaluatable Label
+
 -- | A rune literal in Go (e.g. `'⌘'`).
 newtype Rune a = Rune { _runeLiteral :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+
+-- TODO: Implement Eval instance for Rune
+instance Evaluatable Rune

 instance Eq1 Rune where liftEq = genericLiftEq
 instance Ord1 Rune where liftCompare = genericLiftCompare
@ -54,7 +73,10 @@ instance Show1 Rune where liftShowsPrec = genericLiftShowsPrec

 -- | A select statement in Go (e.g. `select { case x := <-c: x() }` where each case is a send or receive operation on channels).
 data Select a = Select { selectCases :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+
+-- TODO: Implement Eval instance for Select
+instance Evaluatable Select

 instance Eq1 Select where liftEq = genericLiftEq
 instance Ord1 Select where liftCompare = genericLiftCompare
@ -62,80 +84,110 @@ instance Show1 Select where liftShowsPrec = genericLiftShowsPrec

 -- | A send statement in Go (e.g. `channel <- value`).
 data Send a = Send { sendReceiver :: !a, sendValue :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 Send where liftEq = genericLiftEq
 instance Ord1 Send where liftCompare = genericLiftCompare
 instance Show1 Send where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for Send
+instance Evaluatable Send
+
 -- | A slice expression in Go (e.g. `a[1:4:3]` where a is a list, 1 is the low bound, 4 is the high bound, and 3 is the max capacity).
 data Slice a = Slice { sliceName :: !a, sliceLow :: !a, sliceHigh :: !a, sliceCapacity :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 Slice where liftEq = genericLiftEq
 instance Ord1 Slice where liftCompare = genericLiftCompare
 instance Show1 Slice where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for Slice
+instance Evaluatable Slice
+
 -- | A type switch statement in Go (e.g. `switch x.(type) { // cases }`).
 data TypeSwitch a = TypeSwitch { typeSwitchSubject :: !a, typeSwitchCases :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 TypeSwitch where liftEq = genericLiftEq
 instance Ord1 TypeSwitch where liftCompare = genericLiftCompare
 instance Show1 TypeSwitch where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for TypeSwitch
+instance Evaluatable TypeSwitch
+
 -- | A type switch guard statement in a Go type switch statement (e.g. `switch i := x.(type) { // cases}`).
 newtype TypeSwitchGuard a = TypeSwitchGuard { typeSwitchGuardSubject :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 TypeSwitchGuard where liftEq = genericLiftEq
 instance Ord1 TypeSwitchGuard where liftCompare = genericLiftCompare
 instance Show1 TypeSwitchGuard where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for TypeSwitchGuard
+instance Evaluatable TypeSwitchGuard
+
 -- | A receive statement in a Go select statement (e.g. `case value := <-channel` )
 data Receive a = Receive { receiveSubject :: !a, receiveExpression :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 Receive where liftEq = genericLiftEq
 instance Ord1 Receive where liftCompare = genericLiftCompare
 instance Show1 Receive where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for Receive
+instance Evaluatable Receive
+
 -- | A receive operator unary expression in Go (e.g. `<-channel` )
 data ReceiveOperator a = ReceiveOperator a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 ReceiveOperator where liftEq = genericLiftEq
 instance Ord1 ReceiveOperator where liftCompare = genericLiftCompare
 instance Show1 ReceiveOperator where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for ReceiveOperator
+instance Evaluatable ReceiveOperator
+
 -- | A field declaration in a Go struct type declaration.
 data Field a = Field { fieldContext :: ![a], fieldName :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 Field where liftEq = genericLiftEq
 instance Ord1 Field where liftCompare = genericLiftCompare
 instance Show1 Field where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for Field
+instance Evaluatable Field
+
 -- | A type assertion in Go (e.g. `x.(T)` where the value of `x` is not nil and is of type `T`).
 data TypeAssertion a = TypeAssertion { typeAssertionSubject :: !a, typeAssertionType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 TypeAssertion where liftEq = genericLiftEq
 instance Ord1 TypeAssertion where liftCompare = genericLiftCompare
 instance Show1 TypeAssertion where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for TypeAssertion
+instance Evaluatable TypeAssertion
+
 -- | A type conversion expression in Go (e.g. `T(x)` where `T` is a type and `x` is an expression that can be converted to type `T`).
 data TypeConversion a = TypeConversion { typeConversionType :: !a, typeConversionSubject :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 TypeConversion where liftEq = genericLiftEq
 instance Ord1 TypeConversion where liftCompare = genericLiftCompare
 instance Show1 TypeConversion where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for TypeConversion
+instance Evaluatable TypeConversion
+
 -- | Variadic arguments and parameters in Go (e.g. parameter: `param ...Type`, argument: `Type...`).
 data Variadic a = Variadic { variadicContext :: [a], variadicIdentifier :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 Variadic where liftEq = genericLiftEq
 instance Ord1 Variadic where liftCompare = genericLiftCompare
 instance Show1 Variadic where liftShowsPrec = genericLiftShowsPrec
+
+-- TODO: Implement Eval instance for Variadic
+instance Evaluatable Variadic
--- a/src/Language/Go/Type.hs
+++ b/src/Language/Go/Type.hs
@ -2,28 +2,38 @@
 module Language.Go.Type where

 import Prologue
+import Data.Abstract.Evaluatable
 import Diffing.Algorithm

 -- | A Bidirectional channel in Go (e.g. `chan`).
 newtype BidirectionalChannel a = BidirectionalChannel a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 BidirectionalChannel where liftEq = genericLiftEq
 instance Ord1 BidirectionalChannel where liftCompare = genericLiftCompare
 instance Show1 BidirectionalChannel where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for BidirectionalChannel
+instance Evaluatable BidirectionalChannel
+
 -- | A Receive channel in Go (e.g. `<-chan`).
 newtype ReceiveChannel a = ReceiveChannel a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 ReceiveChannel where liftEq = genericLiftEq
 instance Ord1 ReceiveChannel where liftCompare = genericLiftCompare
 instance Show1 ReceiveChannel where liftShowsPrec = genericLiftShowsPrec

+-- TODO: Implement Eval instance for ReceiveChannel
+instance Evaluatable ReceiveChannel
+
 -- | A Send channel in Go (e.g. `chan<-`).
 newtype SendChannel a = SendChannel a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

 instance Eq1 SendChannel where liftEq = genericLiftEq
 instance Ord1 SendChannel where liftCompare = genericLiftCompare
 instance Show1 SendChannel where liftShowsPrec = genericLiftShowsPrec
+
+-- TODO: Implement Eval instance for SendChannel
+instance Evaluatable SendChannel
--- a/src/Language/TypeScript/Syntax.hs
+++ b/src/Language/TypeScript/Syntax.hs
@ -85,6 +85,8 @@ newtype Tuple a = Tuple { _tupleElements :: [a] }
 instance Eq1 Tuple where liftEq = genericLiftEq
 instance Ord1 Tuple where liftCompare = genericLiftCompare
 instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec
+
+-- This is a tuple type, not a tuple value, so we can't lean on the shared Tuple value
 instance Evaluatable Tuple

 data Constructor a = Constructor { _constructorTypeParameters :: !a, _constructorFormalParameters :: ![a], _constructorType :: !a }
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@ -27,24 +27,35 @@ import Semantic
 import Semantic.IO as IO
 import Semantic.Task

+import qualified Language.Go.Assignment as Go
 import qualified Language.Python.Assignment as Python
 import qualified Language.Ruby.Assignment as Ruby
 import qualified Language.TypeScript.Assignment as TypeScript

-type RubyValue = Value Precise (Term (Union Ruby.Syntax) (Record Location))
-type PythonValue = Value Precise (Term (Union Python.Syntax) (Record Location))
-type TypeScriptValue = Value Precise (Term (Union TypeScript.Syntax) (Record Location))
+type Language a = Value Precise (Term (Union a) (Record Location))
+
+type GoValue         = Language Go.Syntax
+type RubyValue       = Language Ruby.Syntax
+type PythonValue     = Language Python.Syntax
+type TypeScriptValue = Language TypeScript.Syntax

 file :: MonadIO m => FilePath -> m Blob
 file path = fromJust <$> IO.readFile path (languageForFilePath path)

 -- Ruby
-evaluateRubyFile path = Prelude.fst . evaluate @RubyValue . snd <$> parseFile rubyParser path
+evaluateRubyFile path = fst . evaluate @RubyValue . snd <$> parseFile rubyParser path

 evaluateRubyFiles paths = do
  first:rest <- traverse (parseFile rubyParser) paths
  pure $ evaluates @RubyValue rest first

+-- Go
+typecheckGoFile path = runAnalysis @(Caching Evaluating Go.Term Type) . evaluateModule . snd <$>
+  parseFile goParser path
+
+evaluateGoFile path = runAnalysis @(Evaluating Go.Term GoValue) . evaluateModule . snd <$>
+  parseFile goParser path
+
 -- Python
 typecheckPythonFile path = runAnalysis @(Caching Evaluating Python.Term Type) . evaluateModule . snd <$> parseFile pythonParser path

@ -66,7 +77,10 @@ evaluateTypeScriptFiles paths = do
  pure $ evaluates @TypeScriptValue rest first


-parseFile parser path = runTask (file path >>= fmap . (,) <*> parse parser)
+parseFile :: Parser term -> FilePath -> IO (Blob, term)
+parseFile parser path = runTask $ do
+  blob <- file path
+  (,) blob <$> parse parser blob


 -- Diff helpers
--- a/test/Assigning/Assignment/Spec.hs
+++ b/test/Assigning/Assignment/Spec.hs
@ -1,5 +1,5 @@
 {-# LANGUAGE DataKinds #-}
-module Assigning.Assignment.Spec where
+module Assigning.Assignment.Spec (spec) where

 import Assigning.Assignment
 import Data.AST
--- a/test/Data/Functor/Classes/Generic/Spec.hs
+++ b/test/Data/Functor/Classes/Generic/Spec.hs
@ -1,4 +1,4 @@
-module Data.Functor.Classes.Generic.Spec where
+module Data.Functor.Classes.Generic.Spec (spec) where

 import Data.Functor.Classes.Generic
 import Data.Functor.Listable
--- a/test/Data/Mergeable/Spec.hs
+++ b/test/Data/Mergeable/Spec.hs
@ -1,5 +1,5 @@
 {-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
-module Data.Mergeable.Spec where
+module Data.Mergeable.Spec (spec) where

 import Control.Applicative (Alternative(..))
 import Data.Functor.Identity
--- a/test/Data/Source/Spec.hs
+++ b/test/Data/Source/Spec.hs
@ -1,4 +1,4 @@
-module Data.Source.Spec where
+module Data.Source.Spec (spec) where

 import Data.Char (chr)
 import Data.Functor.Listable
--- a/test/Integration/Spec.hs
+++ b/test/Integration/Spec.hs
@ -1,5 +1,5 @@
 {-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, OverloadedStrings #-}
-module Integration.Spec where
+module Integration.Spec (spec) where

 import qualified Data.ByteString as B
 import Data.Foldable (find, traverse_)
--- a/test/Rendering/Imports/Spec.hs
+++ b/test/Rendering/Imports/Spec.hs
@ -1,4 +1,4 @@
-module Rendering.Imports.Spec where
+module Rendering.Imports.Spec (spec) where

 import Analysis.Declaration (HasDeclaration, declarationAlgebra)
 import Analysis.ModuleDef (HasModuleDef, moduleDefAlgebra)
@ -10,7 +10,7 @@ import qualified Data.Map as Map
 import qualified Semantic.Util as Util
 import Rendering.Imports
 import Rendering.Renderer
-import Rendering.TOC.Spec
+import Rendering.TOC.Spec hiding (spec)
 import Semantic
 import Semantic.Task
 import SpecHelpers
--- a/test/Rendering/TOC/Spec.hs
+++ b/test/Rendering/TOC/Spec.hs
@ -1,5 +1,5 @@
 {-# LANGUAGE DataKinds, TypeOperators #-}
-module Rendering.TOC.Spec where
+module Rendering.TOC.Spec (spec) where

 import Analysis.Decorator (constructorNameAndConstantFields)
 import Analysis.Declaration
--- a/test/Semantic/CLI/Spec.hs
+++ b/test/Semantic/CLI/Spec.hs
@ -1,5 +1,5 @@
 {-# LANGUAGE DuplicateRecordFields #-}
-module Semantic.CLI.Spec where
+module Semantic.CLI.Spec (spec) where

 import Control.Monad (when)
 import Data.ByteString (ByteString)
--- a/test/Semantic/IO/Spec.hs
+++ b/test/Semantic/IO/Spec.hs
@ -1,4 +1,4 @@
-module Semantic.IO.Spec where
+module Semantic.IO.Spec (spec) where

 import Data.Blob
 import Data.Functor.Both as Both
--- a/test/Semantic/Stat/Spec.hs
+++ b/test/Semantic/Stat/Spec.hs
@ -1,4 +1,4 @@
-module Semantic.Stat.Spec where
+module Semantic.Stat.Spec (spec) where

 import Semantic.Stat
 import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall)
--- a/test/SpecHelpers.hs
+++ b/test/SpecHelpers.hs
@ -3,7 +3,6 @@ module SpecHelpers
 ( diffFilePaths
 , parseFilePath
 , readFilePair
-, languageForFilePath
 , Verbatim(..)
 , verbatim
 , readFileVerbatim
@ -31,18 +30,13 @@ diffFilePaths paths = readFilePair paths >>= runTask . diffBlobPair SExpressionD

 -- | Returns an s-expression parse tree for the specified FilePath.
 parseFilePath :: FilePath -> IO B.ByteString
-parseFilePath path = IO.readFile path (languageForFilePath path) >>= pure . fromJust >>= runTask . parseBlob SExpressionTermRenderer
+parseFilePath path = IO.readFile path (IO.languageForFilePath path) >>= pure . fromJust >>= runTask . parseBlob SExpressionTermRenderer

 -- | Read two files to a BlobPair.
 readFilePair :: Both FilePath -> IO BlobPair
-readFilePair paths = let paths' = fmap (\p -> (p, languageForFilePath p)) paths in
+readFilePair paths = let paths' = fmap (\p -> (p, IO.languageForFilePath p)) paths in
                     runBothWith IO.readFilePair paths'

-- | Returns a Maybe Language based on the FilePath's extension.
-languageForFilePath :: FilePath -> Maybe Language
-languageForFilePath = languageForType . takeExtension
-
-
 readFileVerbatim :: FilePath -> IO Verbatim
 readFileVerbatim = fmap verbatim . B.readFile