Merge remote-tracking branch 'origin/master' into protobuf-instances

.gitignore

@@ -24,3 +24,5 @@ bin/
 .bundle/
 .licenses/vendor/gems
 .licenses/log/
+
+codex.tags

semantic.cabal

@@ -42,10 +42,11 @@ library
                      , Control.Abstract.Environment
                      , Control.Abstract.Evaluator
                      , Control.Abstract.Exports
-                     , Control.Abstract.Goto
                      , Control.Abstract.Heap
+                     , Control.Abstract.Hole
                      , Control.Abstract.Matching
                      , Control.Abstract.Modules
+                     , Control.Abstract.Primitive
                      , Control.Abstract.Roots
                      , Control.Abstract.TermEvaluator
                      , Control.Abstract.Value
@@ -62,14 +63,15 @@ library
                      , Data.Abstract.Live
                      , Data.Abstract.Module
                      , Data.Abstract.ModuleTable
+                     , Data.Abstract.Name
                      , Data.Abstract.Number
                      , Data.Abstract.Package
                      , Data.Abstract.Path
+                     , Data.Abstract.Ref
                      , Data.Abstract.Type
                      , Data.Abstract.Value
                      -- General datatype definitions & generic algorithms
                      , Data.Algebra
-                     , Data.Align.Generic
                      , Data.AST
                      , Data.Blob
                      , Data.Diff
@@ -165,7 +167,7 @@ library
                      , Serializing.Format
                      , Serializing.SExpression
                      -- Custom Prelude
-  other-modules:       Prologue
+                     , Prologue
   build-depends:       base >= 4.8 && < 5
                      , aeson
                      , algebraic-graphs
@@ -269,7 +271,6 @@ test-suite test
                      , Data.Abstract.Path.Spec
                      , Data.Functor.Classes.Generic.Spec
                      , Data.Functor.Listable
-                     , Data.Mergeable.Spec
                      , Data.Scientific.Spec
                      , Data.Source.Spec
                      , Data.Term.Spec

src/Analysis/Abstract/Caching.hs

@@ -7,68 +7,66 @@ module Analysis.Abstract.Caching
 
 import Control.Abstract
 import Data.Abstract.Cache
-import Data.Abstract.Evaluatable
 import Data.Abstract.Module
+import Data.Abstract.Ref
 import Data.Semilattice.Lower
 import Prologue
 
 -- | Look up the set of values for a given configuration in the in-cache.
-consultOracle :: (Cacheable term location (Cell location) value, Member (Reader (Cache term location (Cell location) value)) effects)
-              => Configuration term location (Cell location) value
-              -> TermEvaluator term location value effects (Set (Cached location (Cell location) value))
+consultOracle :: (Cacheable term address (Cell address) value, Member (Reader (Cache term address (Cell address) value)) effects)
+              => Configuration term address (Cell address) value
+              -> TermEvaluator term address value effects (Set (Cached address (Cell address) value))
 consultOracle configuration = fromMaybe mempty . cacheLookup configuration <$> ask
 
 -- | Run an action with the given in-cache.
-withOracle :: Member (Reader (Cache term location (Cell location) value)) effects
-           => Cache term location (Cell location) value
-           -> TermEvaluator term location value effects a
-           -> TermEvaluator term location value effects a
+withOracle :: Member (Reader (Cache term address (Cell address) value)) effects
+           => Cache term address (Cell address) value
+           -> TermEvaluator term address value effects a
+           -> TermEvaluator term address value effects a
 withOracle cache = local (const cache)
 
 
 -- | Look up the set of values for a given configuration in the out-cache.
-lookupCache :: (Cacheable term location (Cell location) value, Member (State (Cache term location (Cell location) value)) effects)
-            => Configuration term location (Cell location) value
-            -> TermEvaluator term location value effects (Maybe (Set (Cached location (Cell location) value)))
+lookupCache :: (Cacheable term address (Cell address) value, Member (State (Cache term address (Cell address) value)) effects)
+            => Configuration term address (Cell address) value
+            -> TermEvaluator term address value effects (Maybe (Set (Cached address (Cell address) value)))
 lookupCache configuration = cacheLookup configuration <$> get
 
 -- | Run an action, caching its result and 'Heap' under the given configuration.
-cachingConfiguration :: (Cacheable term location (Cell location) value, Members '[State (Cache term location (Cell location) value), State (Heap location (Cell location) value)] effects)
-                     => Configuration term location (Cell location) value
-                     -> Set (Cached location (Cell location) value)
-                     -> TermEvaluator term location value effects (ValueRef value)
-                     -> TermEvaluator term location value effects (ValueRef value)
+cachingConfiguration :: (Cacheable term address (Cell address) value, Member (State (Cache term address (Cell address) value)) effects, Member (State (Heap address (Cell address) value)) effects)
+                     => Configuration term address (Cell address) value
+                     -> Set (Cached address (Cell address) value)
+                     -> TermEvaluator term address value effects (ValueRef value)
+                     -> TermEvaluator term address value effects (ValueRef value)
 cachingConfiguration configuration values action = do
   modify' (cacheSet configuration values)
   result <- Cached <$> action <*> TermEvaluator getHeap
   cachedValue result <$ modify' (cacheInsert configuration result)
 
-putCache :: Member (State (Cache term location (Cell location) value)) effects
-         => Cache term location (Cell location) value
-         -> TermEvaluator term location value effects ()
+putCache :: Member (State (Cache term address (Cell address) value)) effects
+         => Cache term address (Cell address) value
+         -> TermEvaluator term address value effects ()
 putCache = put
 
 -- | Run an action starting from an empty out-cache, and return the out-cache afterwards.
-isolateCache :: Member (State (Cache term location (Cell location) value)) effects
-             => TermEvaluator term location value effects a
-             -> TermEvaluator term location value effects (Cache term location (Cell location) value)
+isolateCache :: Member (State (Cache term address (Cell address) value)) effects
+             => TermEvaluator term address value effects a
+             -> TermEvaluator term address value effects (Cache term address (Cell address) value)
 isolateCache action = putCache lowerBound *> action *> get
 
 
 -- | Analyze a term using the in-cache as an oracle & storing the results of the analysis in the out-cache.
-cachingTerms :: ( Cacheable term location (Cell location) value
+cachingTerms :: ( Cacheable term address (Cell address) value
                 , Corecursive term
-                , Members '[ Fresh
-                           , NonDet
-                           , Reader (Cache term location (Cell location) value)
-                           , Reader (Live location value)
-                           , State (Cache term location (Cell location) value)
-                           , State (Environment location value)
-                           , State (Heap location (Cell location) value)
-                           ] effects
+                , Member NonDet effects
+                , Member (Reader (Cache term address (Cell address) value)) effects
+                , Member (Reader (Live address)) effects
+                , Member (State (Cache term address (Cell address) value)) effects
+                , Member (State (Environment address)) effects
+                , Member (State (Heap address (Cell address) value)) effects
                 )
-             => SubtermAlgebra (Base term) term (TermEvaluator term location value effects (ValueRef value))
-             -> SubtermAlgebra (Base term) term (TermEvaluator term location value effects (ValueRef value))
+             => SubtermAlgebra (Base term) term (TermEvaluator term address value effects (ValueRef value))
+             -> SubtermAlgebra (Base term) term (TermEvaluator term address value effects (ValueRef value))
 cachingTerms recur term = do
   c <- getConfiguration (embedSubterm term)
   cached <- lookupCache c
@@ -78,24 +76,21 @@ cachingTerms recur term = do
       pairs <- consultOracle c
       cachingConfiguration c pairs (recur term)
 
-convergingModules :: ( AbstractValue location value effects
-                     , Cacheable term location (Cell location) value
-                     , Members '[ Allocator location value
-                                , Fresh
-                                , NonDet
-                                , Reader (Cache term location (Cell location) value)
-                                , Reader (Environment location value)
-                                , Reader (Live location value)
-                                , Resumable (AddressError location value)
-                                , Resumable (EnvironmentError value)
-                                , Resumable (EvalError value)
-                                , State (Cache term location (Cell location) value)
-                                , State (Environment location value)
-                                , State (Heap location (Cell location) value)
-                                ] effects
+convergingModules :: ( AbstractValue address value effects
+                     , Cacheable term address (Cell address) value
+                     , Member (Allocator address value) effects
+                     , Member Fresh effects
+                     , Member NonDet effects
+                     , Member (Reader (Cache term address (Cell address) value)) effects
+                     , Member (Reader (Environment address)) effects
+                     , Member (Reader (Live address)) effects
+                     , Member (Resumable (EnvironmentError address)) effects
+                     , Member (State (Cache term address (Cell address) value)) effects
+                     , Member (State (Environment address)) effects
+                     , Member (State (Heap address (Cell address) value)) effects
                      )
-                  => SubtermAlgebra Module term (TermEvaluator term location value effects value)
-                  -> SubtermAlgebra Module term (TermEvaluator term location value effects value)
+                  => SubtermAlgebra Module term (TermEvaluator term address value effects value)
+                  -> SubtermAlgebra Module term (TermEvaluator term address value effects value)
 convergingModules recur m = do
   c <- getConfiguration (subterm (moduleBody m))
   -- Convergence here is predicated upon an Eq instance, not α-equivalence
@@ -129,11 +124,11 @@ converge seed f = loop seed
             loop x'
 
 -- | Nondeterministically write each of a collection of stores & return their associated results.
-scatter :: (Foldable t, Members '[NonDet, State (Heap location (Cell location) value)] effects) => t (Cached location (Cell location) value) -> TermEvaluator term location value effects (ValueRef value)
+scatter :: (Foldable t, Member NonDet effects, Member (State (Heap address (Cell address) value)) effects) => t (Cached address (Cell address) value) -> TermEvaluator term address value effects (ValueRef value)
 scatter = foldMapA (\ (Cached value heap') -> TermEvaluator (putHeap heap') $> value)
 
 
-caching :: Alternative f => TermEvaluator term location value (NonDet ': Reader (Cache term location (Cell location) value) ': State (Cache term location (Cell location) value) ': effects) a -> TermEvaluator term location value effects (f a, Cache term location (Cell location) value)
+caching :: Alternative f => TermEvaluator term address value (NonDet ': Reader (Cache term address (Cell address) value) ': State (Cache term address (Cell address) value) ': effects) a -> TermEvaluator term address value effects (f a, Cache term address (Cell address) value)
 caching
   = runState lowerBound
   . runReader lowerBound

src/Analysis/Abstract/Collecting.hs

@@ -11,38 +11,37 @@ import Data.Semilattice.Lower
 import Prologue
 
 -- | An analysis performing GC after every instruction.
-collectingTerms :: ( Foldable (Cell location)
-                   , Members '[ Reader (Live location value)
-                              , State (Heap location (Cell location) value)
-                              ] effects
-                   , Ord location
-                   , ValueRoots location value
+collectingTerms :: ( Foldable (Cell address)
+                   , Member (Reader (Live address)) effects
+                   , Member (State (Heap address (Cell address) value)) effects
+                   , Ord address
+                   , ValueRoots address value
                    )
-                => SubtermAlgebra (Base term) term (TermEvaluator term location value effects value)
-                -> SubtermAlgebra (Base term) term (TermEvaluator term location value effects value)
+                => SubtermAlgebra (Base term) term (TermEvaluator term address value effects value)
+                -> SubtermAlgebra (Base term) term (TermEvaluator term address value effects value)
 collectingTerms recur term = do
   roots <- TermEvaluator askRoots
   v <- recur term
   v <$ TermEvaluator (modifyHeap (gc (roots <> valueRoots v)))
 
 -- | Collect any addresses in the heap not rooted in or reachable from the given 'Live' set.
-gc :: ( Ord location
-      , Foldable (Cell location)
-      , ValueRoots location value
+gc :: ( Ord address
+      , Foldable (Cell address)
+      , ValueRoots address value
       )
-   => Live location value                 -- ^ The set of addresses to consider rooted.
-   -> Heap location (Cell location) value -- ^ A heap to collect unreachable addresses within.
-   -> Heap location (Cell location) value -- ^ A garbage-collected heap.
+   => Live address                      -- ^ The set of addresses to consider rooted.
+   -> Heap address (Cell address) value -- ^ A heap to collect unreachable addresses within.
+   -> Heap address (Cell address) value -- ^ A garbage-collected heap.
 gc roots heap = heapRestrict heap (reachable roots heap)
 
 -- | Compute the set of addresses reachable from a given root set in a given heap.
-reachable :: ( Ord location
-             , Foldable (Cell location)
-             , ValueRoots location value
+reachable :: ( Ord address
+             , Foldable (Cell address)
+             , ValueRoots address value
              )
-          => Live location value                 -- ^ The set of root addresses.
-          -> Heap location (Cell location) value -- ^ The heap to trace addresses through.
-          -> Live location value                 -- ^ The set of addresses reachable from the root set.
+          => Live address                      -- ^ The set of root addresses.
+          -> Heap address (Cell address) value -- ^ The heap to trace addresses through.
+          -> Live address                      -- ^ The set of addresses reachable from the root set.
 reachable roots heap = go mempty roots
   where go seen set = case liveSplit set of
           Nothing -> seen
@@ -51,5 +50,5 @@ reachable roots heap = go mempty roots
             _           -> seen)
 
 
-providingLiveSet :: Effectful (m location value) => m location value (Reader (Live location value) ': effects) a -> m location value effects a
+providingLiveSet :: Effectful (m address value) => m address value (Reader (Live address) ': effects) a -> m address value effects a
 providingLiveSet = runReader lowerBound

src/Analysis/Abstract/Dead.hs

@@ -20,11 +20,11 @@ newtype Dead term = Dead { unDead :: Set term }
 deriving instance Ord term => Reducer term (Dead term)
 
 -- | Update the current 'Dead' set.
-killAll :: Member (State (Dead term)) effects => Dead term -> TermEvaluator term location value effects ()
+killAll :: Member (State (Dead term)) effects => Dead term -> TermEvaluator term address value effects ()
 killAll = put
 
 -- | Revive a single term, removing it from the current 'Dead' set.
-revive :: (Member (State (Dead term)) effects, Ord term) => term -> TermEvaluator term location value effects ()
+revive :: (Member (State (Dead term)) effects, Ord term) => term -> TermEvaluator term address value effects ()
 revive t = modify' (Dead . delete t . unDead)
 
 -- | Compute the set of all subterms recursively.
@@ -36,8 +36,8 @@ revivingTerms :: ( Corecursive term
                  , Member (State (Dead term)) effects
                  , Ord term
                  )
-              => SubtermAlgebra (Base term) term (TermEvaluator term location value effects a)
-              -> SubtermAlgebra (Base term) term (TermEvaluator term location value effects a)
+              => SubtermAlgebra (Base term) term (TermEvaluator term address value effects a)
+              -> SubtermAlgebra (Base term) term (TermEvaluator term address value effects a)
 revivingTerms recur term = revive (embedSubterm term) *> recur term
 
 killingModules :: ( Foldable (Base term)
@@ -45,9 +45,9 @@ killingModules :: ( Foldable (Base term)
                   , Ord term
                   , Recursive term
                   )
-               => SubtermAlgebra Module term (TermEvaluator term location value effects a)
-               -> SubtermAlgebra Module term (TermEvaluator term location value effects a)
+               => SubtermAlgebra Module term (TermEvaluator term address value effects a)
+               -> SubtermAlgebra Module term (TermEvaluator term address value effects a)
 killingModules recur m = killAll (subterms (subterm (moduleBody m))) *> recur m
 
-providingDeadSet :: TermEvaluator term location value (State (Dead term) ': effects) a -> TermEvaluator term location value effects (a, Dead term)
+providingDeadSet :: TermEvaluator term address value (State (Dead term) ': effects) a -> TermEvaluator term address value effects (a, Dead term)
 providingDeadSet = runState lowerBound

src/Analysis/Abstract/Evaluating.hs

@@ -8,34 +8,34 @@ import Control.Abstract
 import Data.Semilattice.Lower
 
 -- | An analysis evaluating @term@s to @value@s with a list of @effects@ using 'Evaluatable', and producing incremental results of type @a@.
-data EvaluatingState location value = EvaluatingState
-  { environment :: Environment location value
-  , heap        :: Heap location (Cell location) value
-  , modules     :: ModuleTable (Maybe (Environment location value, value))
-  , exports     :: Exports location value
+data EvaluatingState address value = EvaluatingState
+  { environment :: Environment address
+  , heap        :: Heap address (Cell address) value
+  , modules     :: ModuleTable (Maybe (Environment address, value))
+  , exports     :: Exports address
   }
 
-deriving instance (Eq (Cell location value), Eq location, Eq value) => Eq (EvaluatingState location value)
-deriving instance (Ord (Cell location value), Ord location, Ord value) => Ord (EvaluatingState location value)
-deriving instance (Show (Cell location value), Show location, Show value) => Show (EvaluatingState location value)
+deriving instance (Eq (Cell address value), Eq address, Eq value) => Eq (EvaluatingState address value)
+deriving instance (Ord (Cell address value), Ord address, Ord value) => Ord (EvaluatingState address value)
+deriving instance (Show (Cell address value), Show address, Show value) => Show (EvaluatingState address value)
 
 
-evaluating :: Evaluator location value
+evaluating :: Evaluator address value
                 (  Fail
                 ': Fresh
-                ': Reader (Environment location value)
-                ': State (Environment location value)
-                ': State (Heap location (Cell location) value)
-                ': State (ModuleTable (Maybe (Environment location value, value)))
-                ': State (Exports location value)
+                ': Reader (Environment address)
+                ': State (Environment address)
+                ': State (Heap address (Cell address) value)
+                ': State (ModuleTable (Maybe (Environment address, value)))
+                ': State (Exports address)
                 ': effects) result
-           -> Evaluator location value effects (Either String result, EvaluatingState location value)
+           -> Evaluator address value effects (Either String result, EvaluatingState address value)
 evaluating
   = fmap (\ ((((result, env), heap), modules), exports) -> (result, EvaluatingState env heap modules exports))
-  . runState lowerBound -- State (Exports location value)
-  . runState lowerBound -- State (ModuleTable (Maybe (Environment location value, value)))
-  . runState lowerBound -- State (Heap location (Cell location) value)
-  . runState lowerBound -- State (Environment location value)
-  . runReader lowerBound -- Reader (Environment location value)
+  . runState lowerBound -- State (Exports address)
+  . runState lowerBound -- State (ModuleTable (Maybe (Environment address, value)))
+  . runState lowerBound -- State (Heap address (Cell address) value)
+  . runState lowerBound -- State (Environment address)
+  . runReader lowerBound -- Reader (Environment address)
   . runFresh 0
   . runFail

src/Analysis/Abstract/Graph.hs

@@ -16,8 +16,8 @@ module Analysis.Abstract.Graph
 import           Algebra.Graph.Export.Dot hiding (vertexName)
 import           Control.Abstract
 import           Data.Abstract.Address
-import           Data.Abstract.FreeVariables
 import           Data.Abstract.Module (Module(moduleInfo), ModuleInfo(..))
+import           Data.Abstract.Name
 import           Data.Abstract.Package (PackageInfo(..))
 import           Data.Aeson hiding (Result)
 import           Data.ByteString.Builder
@@ -52,15 +52,14 @@ style = (defaultStyle (byteString . vertexName))
 
 -- | Add vertices to the graph for evaluated identifiers.
 graphingTerms :: ( Element Syntax.Identifier syntax
-                 , Members '[ Reader (Environment (Located location) value)
-                            , Reader ModuleInfo
-                            , State (Environment (Located location) value)
-                            , State (Graph Vertex)
-                            ] effects
+                 , Member (Reader (Environment (Hole (Located address)))) effects
+                 , Member (Reader ModuleInfo) effects
+                 , Member (State (Environment (Hole (Located address)))) effects
+                 , Member (State (Graph Vertex)) effects
                  , term ~ Term (Sum syntax) ann
                  )
-              => SubtermAlgebra (Base term) term (TermEvaluator term (Located location) value effects a)
-              -> SubtermAlgebra (Base term) term (TermEvaluator term (Located location) value effects a)
+              => SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a)
+              -> SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a)
 graphingTerms recur term@(In _ syntax) = do
   case project syntax of
     Just (Syntax.Identifier name) -> do
@@ -69,23 +68,22 @@ graphingTerms recur term@(In _ syntax) = do
     _ -> pure ()
   recur term
 
-graphingPackages :: Members '[ Reader ModuleInfo
-                             , Reader PackageInfo
-                             , State (Graph Vertex)
-                             ] effects
-                 => SubtermAlgebra Module term (TermEvaluator term location value effects a)
-                 -> SubtermAlgebra Module term (TermEvaluator term location value effects a)
+graphingPackages :: ( Member (Reader PackageInfo) effects
+                    , Member (State (Graph Vertex)) effects
+                    )
+                 => SubtermAlgebra Module term (TermEvaluator term address value effects a)
+                 -> SubtermAlgebra Module term (TermEvaluator term address value effects a)
 graphingPackages recur m = packageInclusion (moduleVertex (moduleInfo m)) *> recur m
 
 -- | Add vertices to the graph for evaluated modules and the packages containing them.
-graphingModules :: forall term location value effects a
-                .  Members '[ Modules location value
-                            , Reader ModuleInfo
-                            , State (Graph Vertex)
-                            ] effects
-               => SubtermAlgebra Module term (TermEvaluator term location value effects a)
-               -> SubtermAlgebra Module term (TermEvaluator term location value effects a)
-graphingModules recur m = interpose @(Modules location value) pure (\ m yield -> case m of
+graphingModules :: forall term address value effects a
+                .  ( Member (Modules address value) effects
+                   , Member (Reader ModuleInfo) effects
+                   , Member (State (Graph Vertex)) effects
+                   )
+               => SubtermAlgebra Module term (TermEvaluator term address value effects a)
+               -> SubtermAlgebra Module term (TermEvaluator term address value effects a)
+graphingModules recur m = interpose @(Modules address value) pure (\ m yield -> case m of
   Load   path -> moduleInclusion (moduleVertex (ModuleInfo path)) >> send m >>= yield
   Lookup path -> moduleInclusion (moduleVertex (ModuleInfo path)) >> send m >>= yield
   _ -> send m >>= yield)
@@ -100,9 +98,8 @@ moduleVertex = Module . BC.pack . modulePath
 
 -- | Add an edge from the current package to the passed vertex.
 packageInclusion :: ( Effectful m
-                    , Members '[ Reader PackageInfo
-                               , State (Graph Vertex)
-                               ] effects
+                    , Member (Reader PackageInfo) effects
+                    , Member (State (Graph Vertex)) effects
                     , Monad (m effects)
                     )
                  => Vertex
@@ -113,9 +110,8 @@ packageInclusion v = do
 
 -- | Add an edge from the current module to the passed vertex.
 moduleInclusion :: ( Effectful m
-                   , Members '[ Reader ModuleInfo
-                              , State (Graph Vertex)
-                              ] effects
+                   , Member (Reader ModuleInfo) effects
+                   , Member (State (Graph Vertex)) effects
                    , Monad (m effects)
                    )
                 => Vertex
@@ -125,14 +121,14 @@ moduleInclusion v = do
   appendGraph (vertex (moduleVertex m) `connect` vertex v)
 
 -- | Add an edge from the passed variable name to the module it originated within.
-variableDefinition :: ( Member (Reader (Environment (Located location) value)) effects
-                      , Member (State (Environment (Located location) value)) effects
+variableDefinition :: ( Member (Reader (Environment (Hole (Located address)))) effects
+                      , Member (State (Environment (Hole (Located address)))) effects
                       , Member (State (Graph Vertex)) effects
                       )
                    => Name
-                   -> TermEvaluator term (Located location) value effects ()
+                   -> TermEvaluator term (Hole (Located address)) value effects ()
 variableDefinition name = do
-  graph <- maybe lowerBound (vertex . moduleVertex . locationModule . unAddress) <$> TermEvaluator (lookupEnv name)
+  graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . addressModule) . toMaybe) <$> TermEvaluator (lookupEnv name)
   appendGraph (vertex (Variable (unName name)) `connect` graph)
 
 appendGraph :: (Effectful m, Member (State (Graph Vertex)) effects) => Graph Vertex -> m effects ()

src/Analysis/Abstract/Tracing.hs

@@ -13,20 +13,19 @@ import Prologue
 --
 --   Instantiating @trace@ to @[]@ yields a linear trace analysis, while @Set@ yields a reachable state analysis.
 tracingTerms :: ( Corecursive term
-                , Members '[ Reader (Live location value)
-                           , State (Environment location value)
-                           , State (Heap location (Cell location) value)
-                           , Writer (trace (Configuration term location (Cell location) value))
-                           ] effects
-                , Reducer (Configuration term location (Cell location) value) (trace (Configuration term location (Cell location) value))
+                , Member (Reader (Live address)) effects
+                , Member (State (Environment address)) effects
+                , Member (State (Heap address (Cell address) value)) effects
+                , Member (Writer (trace (Configuration term address (Cell address) value))) effects
+                , Reducer (Configuration term address (Cell address) value) (trace (Configuration term address (Cell address) value))
                 )
-             => trace (Configuration term location (Cell location) value)
-             -> SubtermAlgebra (Base term) term (TermEvaluator term location value effects a)
-             -> SubtermAlgebra (Base term) term (TermEvaluator term location value effects a)
+             => trace (Configuration term address (Cell address) value)
+             -> SubtermAlgebra (Base term) term (TermEvaluator term address value effects a)
+             -> SubtermAlgebra (Base term) term (TermEvaluator term address value effects a)
 tracingTerms proxy recur term = getConfiguration (embedSubterm term) >>= trace . (`asTypeOf` proxy) . Reducer.unit >> recur term
 
-trace :: Member (Writer (trace (Configuration term location (Cell location) value))) effects => trace (Configuration term location (Cell location) value) -> TermEvaluator term location value effects ()
+trace :: Member (Writer (trace (Configuration term address (Cell address) value))) effects => trace (Configuration term address (Cell address) value) -> TermEvaluator term address value effects ()
 trace = tell
 
-tracing :: Monoid (trace (Configuration term location (Cell location) value)) => TermEvaluator term location value (Writer (trace (Configuration term location (Cell location) value)) ': effects) a -> TermEvaluator term location value effects (a, trace (Configuration term location (Cell location) value))
+tracing :: Monoid (trace (Configuration term address (Cell address) value)) => TermEvaluator term address value (Writer (trace (Configuration term address (Cell address) value)) ': effects) a -> TermEvaluator term address value effects (a, trace (Configuration term address (Cell address) value))
 tracing = runWriter

src/Analysis/Declaration.hs

@@ -5,7 +5,7 @@ module Analysis.Declaration
 , declarationAlgebra
 ) where
 
-import Data.Abstract.FreeVariables (Name(..))
+import Data.Abstract.Name (unName)
 import Data.Blob
 import Data.Error (Error(..), showExpectation)
 import Data.Language as Language
@@ -130,7 +130,7 @@ getSource blobSource = toText . flip Source.slice blobSource . getField
 instance (Syntax.Identifier :< fs, Expression.MemberAccess :< fs) => CustomHasDeclaration (Sum fs) Expression.Call where
   customToDeclaration Blob{..} _ (Expression.Call _ (Term (In fromAnn fromF), _) _ _)
     | Just (Expression.MemberAccess (Term (In leftAnn leftF)) (Term (In idenAnn _))) <- project fromF = Just $ CallReference (getSource idenAnn) mempty blobLanguage (memberAccess leftAnn leftF)
-    | Just (Syntax.Identifier (Name name)) <- project fromF = Just $ CallReference (T.decodeUtf8 name) mempty blobLanguage []
+    | Just (Syntax.Identifier name) <- project fromF = Just $ CallReference (T.decodeUtf8 (unName name)) mempty blobLanguage []
     | otherwise = Just $ CallReference (getSource fromAnn) mempty blobLanguage []
     where
       memberAccess modAnn termFOut

src/Analysis/IdentifierName.hs

@@ -5,7 +5,7 @@ module Analysis.IdentifierName
 , identifierLabel
 ) where
 
-import           Data.Abstract.FreeVariables (Name (..))
+import           Data.Abstract.Name (unName)
 import           Data.Aeson
 import           Data.JSON.Fields
 import           Data.Sum
@@ -41,7 +41,7 @@ instance Apply IdentifierName fs => CustomIdentifierName (Sum fs) where
   customIdentifierName = apply @IdentifierName identifierName
 
 instance CustomIdentifierName Data.Syntax.Identifier where
-  customIdentifierName (Data.Syntax.Identifier (Name name)) = Just name
+  customIdentifierName (Data.Syntax.Identifier name) = Just (unName name)
 
 data Strategy = Default | Custom
 

src/Control/Abstract.hs

@@ -9,8 +9,9 @@ import Control.Abstract.Environment as X
 import Control.Abstract.Evaluator as X
 import Control.Abstract.Exports as X
 import Control.Abstract.Heap as X
-import Control.Abstract.Goto as X
+import Control.Abstract.Hole as X
 import Control.Abstract.Modules as X
+import Control.Abstract.Primitive as X
 import Control.Abstract.Roots as X
 import Control.Abstract.TermEvaluator as X
 import Control.Abstract.Value as X

src/Control/Abstract/Addressable.hs

@@ -5,39 +5,47 @@ module Control.Abstract.Addressable
 
 import Control.Abstract.Context
 import Control.Abstract.Evaluator
+import Control.Abstract.Hole
 import Data.Abstract.Address
-import Data.Abstract.FreeVariables
+import Data.Abstract.Name
 import Prologue
 
--- | Defines allocation and dereferencing of 'Address'es in a 'Heap'.
-class (Ord location, Show location) => Addressable location effects where
-  -- | The type into which stored values will be written for a given location type.
-  type family Cell location :: * -> *
+-- | Defines allocation and dereferencing of addresses.
+class (Ord address, Show address) => Addressable address effects where
+  -- | The type into which stored values will be written for a given address type.
+  type family Cell address :: * -> *
 
-  allocCell :: Name -> Evaluator location value effects location
-  derefCell :: Address location value -> Cell location value -> Evaluator location value effects (Maybe value)
+  allocCell :: Name -> Evaluator address value effects address
+  derefCell :: address -> Cell address value -> Evaluator address value effects (Maybe value)
 
 
--- | 'Precise' locations are always allocated a fresh 'Address', and dereference to the 'Latest' value written.
+-- | 'Precise' addresses are always allocated a fresh address, and dereference to the 'Latest' value written.
 instance Member Fresh effects => Addressable Precise effects where
   type Cell Precise = Latest
 
   allocCell _ = Precise <$> fresh
   derefCell _ = pure . getLast . unLatest
 
--- | 'Monovariant' locations allocate one 'Address' per unique variable name, and dereference once per stored value, nondeterministically.
+-- | 'Monovariant' addresses allocate one address per unique variable name, and dereference once per stored value, nondeterministically.
 instance Member NonDet effects => Addressable Monovariant effects where
   type Cell Monovariant = All
 
   allocCell = pure . Monovariant
   derefCell _ = traverse (foldMapA pure) . nonEmpty . toList
 
--- | 'Located' locations allocate & dereference using the underlying location, contextualizing locations with the current 'PackageInfo' & 'ModuleInfo'.
-instance (Addressable location effects, Members '[Reader ModuleInfo, Reader PackageInfo] effects) => Addressable (Located location) effects where
-  type Cell (Located location) = Cell location
+-- | 'Located' addresses allocate & dereference using the underlying address, contextualizing addresses with the current 'PackageInfo' & 'ModuleInfo'.
+instance (Addressable address effects, Member (Reader ModuleInfo) effects, Member (Reader PackageInfo) effects) => Addressable (Located address) effects where
+  type Cell (Located address) = Cell address
 
   allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule)
-  derefCell (Address (Located loc _ _)) = relocate . derefCell (Address loc)
+  derefCell (Located loc _ _) = relocate . derefCell loc
 
-relocate :: Evaluator location value effects a -> Evaluator (Located location) value effects a
+instance Addressable address effects => Addressable (Hole address) effects where
+  type Cell (Hole address) = Cell address
+
+  allocCell name = relocate (Total <$> allocCell name)
+  derefCell (Total loc) = relocate . derefCell loc
+  derefCell Partial     = const (pure Nothing)
+
+relocate :: Evaluator address1 value effects a -> Evaluator address2 value effects a
 relocate = raiseEff . lowerEff

src/Control/Abstract/Configuration.hs

@@ -12,5 +12,5 @@ import Control.Abstract.TermEvaluator
 import Data.Abstract.Configuration
 
 -- | Get the current 'Configuration' with a passed-in term.
-getConfiguration :: Members '[Reader (Live location value), State (Environment location value), State (Heap location (Cell location) value)] effects => term -> TermEvaluator term location value effects (Configuration term location (Cell location) value)
+getConfiguration :: (Member (Reader (Live address)) effects, Member (State (Environment address)) effects, Member (State (Heap address (Cell address) value)) effects) => term -> TermEvaluator term address value effects (Configuration term address (Cell address) value)
 getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEnv <*> TermEvaluator getHeap

src/Control/Abstract/Context.hs

@@ -45,11 +45,11 @@ withCurrentSpan = local . const
 
 
 -- | Run an action with locally-replaced 'ModuleInfo' & 'Span' derived from the passed 'SrcLoc'.
-withCurrentSrcLoc :: (Effectful m, Members '[Reader ModuleInfo, Reader Span] effects) => SrcLoc -> m effects a -> m effects a
+withCurrentSrcLoc :: (Effectful m, Member (Reader ModuleInfo) effects, Member (Reader Span) effects) => SrcLoc -> m effects a -> m effects a
 withCurrentSrcLoc loc = withCurrentModule (moduleInfoFromSrcLoc loc) . withCurrentSpan (spanFromSrcLoc loc)
 
 -- | Run an action with locally replaced 'ModuleInfo' & 'Span' derived from the Haskell call stack.
 --
 --   This is suitable for contextualizing builtins & other functionality intended for use from client code but defined in Haskell source.
-withCurrentCallStack :: (Effectful m, Members '[Reader ModuleInfo, Reader Span] effects) => CallStack -> m effects a -> m effects a
+withCurrentCallStack :: (Effectful m, Member (Reader ModuleInfo) effects, Member (Reader Span) effects) => CallStack -> m effects a -> m effects a
 withCurrentCallStack = maybe id (withCurrentSrcLoc . snd) . listToMaybe . getCallStack

src/Control/Abstract/Environment.hs

@@ -3,14 +3,12 @@ module Control.Abstract.Environment
 ( Environment
 , getEnv
 , putEnv
-, modifyEnv
 , withEnv
-, defaultEnvironment
 , withDefaultEnvironment
-, fullEnvironment
-, localEnv
-, localize
 , lookupEnv
+, bind
+, bindAll
+, locally
 , EnvironmentError(..)
 , freeVariableError
 , runEnvironmentError
@@ -18,72 +16,70 @@ module Control.Abstract.Environment
 ) where
 
 import Control.Abstract.Evaluator
-import Data.Abstract.Address
 import Data.Abstract.Environment as Env
-import Data.Abstract.FreeVariables
+import Data.Abstract.Name
 import Prologue
 
 -- | Retrieve the environment.
-getEnv :: Member (State (Environment location value)) effects => Evaluator location value effects (Environment location value)
+getEnv :: Member (State (Environment address)) effects => Evaluator address value effects (Environment address)
 getEnv = get
 
 -- | Set the environment.
-putEnv :: Member (State (Environment location value)) effects => Environment location value -> Evaluator location value effects ()
+putEnv :: Member (State (Environment address)) effects => Environment address -> Evaluator address value effects ()
 putEnv = put
 
 -- | Update the global environment.
-modifyEnv :: Member (State (Environment location value)) effects => (Environment location value -> Environment location value) -> Evaluator location value effects ()
+modifyEnv :: Member (State (Environment address)) effects => (Environment address -> Environment address) -> Evaluator address value effects ()
 modifyEnv = modify'
 
 -- | Sets the environment for the lifetime of the given action.
-withEnv :: Member (State (Environment location value)) effects => Environment location value -> Evaluator location value effects a -> Evaluator location value effects a
+withEnv :: Member (State (Environment address)) effects => Environment address -> Evaluator address value effects a -> Evaluator address value effects a
 withEnv = localState . const
 
 
 -- | Retrieve the default environment.
-defaultEnvironment :: Member (Reader (Environment location value)) effects => Evaluator location value effects (Environment location value)
+defaultEnvironment :: Member (Reader (Environment address)) effects => Evaluator address value effects (Environment address)
 defaultEnvironment = ask
 
 -- | Set the default environment for the lifetime of an action.
 --   Usually only invoked in a top-level evaluation function.
-withDefaultEnvironment :: Member (Reader (Environment location value)) effects => Environment location value -> Evaluator location value effects a -> Evaluator location value effects a
+withDefaultEnvironment :: Member (Reader (Environment address)) effects => Environment address -> Evaluator address value effects a -> Evaluator address value effects a
 withDefaultEnvironment e = local (const e)
 
--- | Obtain an environment that is the composition of the current and default environments.
---   Useful for debugging.
-fullEnvironment :: Members '[Reader (Environment location value), State (Environment location value)] effects => Evaluator location value effects (Environment location value)
-fullEnvironment = mergeEnvs <$> getEnv <*> defaultEnvironment
-
--- | Run an action with a locally-modified environment.
-localEnv :: Member (State (Environment location value)) effects => (Environment location value -> Environment location value) -> Evaluator location value effects a -> Evaluator location value effects a
-localEnv f a = do
-  modifyEnv (f . Env.push)
-  result <- a
-  result <$ modifyEnv Env.pop
-
--- | Run a computation in a new local environment.
-localize :: Member (State (Environment location value)) effects => Evaluator location value effects a -> Evaluator location value effects a
-localize = localEnv id
-
 -- | Look a 'Name' up in the current environment, trying the default environment if no value is found.
-lookupEnv :: Members '[Reader (Environment location value), State (Environment location value)] effects => Name -> Evaluator location value effects (Maybe (Address location value))
+lookupEnv :: (Member (Reader (Environment address)) effects, Member (State (Environment address)) effects) => Name -> Evaluator address value effects (Maybe address)
 lookupEnv name = (<|>) <$> (Env.lookup name <$> getEnv) <*> (Env.lookup name <$> defaultEnvironment)
 
+-- | Bind a 'Name' to an 'Address' in the current scope.
+bind :: Member (State (Environment address)) effects => Name -> address -> Evaluator address value effects ()
+bind name = modifyEnv . Env.insert name
+
+-- | Bind all of the names from an 'Environment' in the current scope.
+bindAll :: Member (State (Environment address)) effects => Environment address -> Evaluator address value effects ()
+bindAll = foldr ((>>) . uncurry bind) (pure ()) . pairs
+
+-- | Run an action in a new local environment.
+locally :: Member (State (Environment address)) effects => Evaluator address value effects a -> Evaluator address value effects a
+locally a = do
+  modifyEnv Env.push
+  a' <- a
+  a' <$ modifyEnv Env.pop
+
 
 -- | Errors involving the environment.
-data EnvironmentError value return where
-  FreeVariable :: Name -> EnvironmentError value value
+data EnvironmentError address return where
+  FreeVariable :: Name -> EnvironmentError address address
 
-deriving instance Eq (EnvironmentError value return)
-deriving instance Show (EnvironmentError value return)
-instance Show1 (EnvironmentError value) where liftShowsPrec _ _ = showsPrec
-instance Eq1 (EnvironmentError value) where liftEq _ (FreeVariable n1) (FreeVariable n2) = n1 == n2
+deriving instance Eq (EnvironmentError address return)
+deriving instance Show (EnvironmentError address return)
+instance Show1 (EnvironmentError address) where liftShowsPrec _ _ = showsPrec
+instance Eq1 (EnvironmentError address) where liftEq _ (FreeVariable n1) (FreeVariable n2) = n1 == n2
 
-freeVariableError :: Member (Resumable (EnvironmentError value)) effects => Name -> Evaluator location value effects value
+freeVariableError :: Member (Resumable (EnvironmentError address)) effects => Name -> Evaluator address value effects address
 freeVariableError = throwResumable . FreeVariable
 
-runEnvironmentError :: Effectful (m location value) => m location value (Resumable (EnvironmentError value) ': effects) a -> m location value effects (Either (SomeExc (EnvironmentError value)) a)
+runEnvironmentError :: Effectful (m address value) => m address value (Resumable (EnvironmentError address) ': effects) a -> m address value effects (Either (SomeExc (EnvironmentError address)) a)
 runEnvironmentError = runResumable
 
-runEnvironmentErrorWith :: Effectful (m location value) => (forall resume . EnvironmentError value resume -> m location value effects resume) -> m location value (Resumable (EnvironmentError value) ': effects) a -> m location value effects a
+runEnvironmentErrorWith :: Effectful (m address value) => (forall resume . EnvironmentError address resume -> m address value effects resume) -> m address value (Resumable (EnvironmentError address) ': effects) a -> m address value effects a
 runEnvironmentErrorWith = runResumableWith

src/Control/Abstract/Evaluator.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
 module Control.Abstract.Evaluator
   ( Evaluator(..)
-  , ValueRef(..)
   -- * Effects
   , Return(..)
   , earlyReturn
@@ -12,47 +11,29 @@ module Control.Abstract.Evaluator
   , throwContinue
   , catchLoopControl
   , runLoopControl
-  , module Control.Monad.Effect
-  , module Control.Monad.Effect.Fail
-  , module Control.Monad.Effect.Fresh
-  , module Control.Monad.Effect.NonDet
-  , module Control.Monad.Effect.Reader
-  , module Control.Monad.Effect.Resumable
-  , module Control.Monad.Effect.State
-  , module Control.Monad.Effect.Trace
+  , module X
   ) where
 
-import Control.Monad.Effect
-import Control.Monad.Effect.Fail
-import Control.Monad.Effect.Fresh
-import Control.Monad.Effect.NonDet
-import Control.Monad.Effect.Reader
-import Control.Monad.Effect.Resumable
-import Control.Monad.Effect.State
-import Control.Monad.Effect.Trace
-import Data.Abstract.FreeVariables
+import Control.Monad.Effect           as X
+import Control.Monad.Effect.Fresh     as X
+import Control.Monad.Effect.Internal
+import Control.Monad.Effect.NonDet    as X
+import Control.Monad.Effect.Reader    as X
+import Control.Monad.Effect.Resumable as X
+import Control.Monad.Effect.State     as X
+import Control.Monad.Effect.Trace     as X
 import Prologue
 
--- | An 'Evaluator' is a thin wrapper around 'Eff' with (phantom) type parameters for the location, term, and value types.
+-- | An 'Evaluator' is a thin wrapper around 'Eff' with (phantom) type parameters for the address, term, and value types.
 --
 --   These parameters enable us to constrain the types of effects using them s.t. we can avoid both ambiguous types when they aren’t mentioned outside of the context, and lengthy, redundant annotations on the use sites of functions employing these effects.
 --
 --   These effects will typically include the environment, heap, module table, etc. effects necessary for evaluation of modules and terms, but may also include any other effects so long as they’re eventually handled.
-newtype Evaluator location value effects a = Evaluator { runEvaluator :: Eff effects a }
+newtype Evaluator address value effects a = Evaluator { runEvaluator :: Eff effects a }
   deriving (Applicative, Effectful, Functor, Monad)
 
-deriving instance Member NonDet effects => Alternative (Evaluator location value effects)
+deriving instance Member NonDet effects => Alternative (Evaluator address value effects)
 
--- | 'ValueRef' is the type subterms evaluate to and can represent either values directly ('Rval'), or references to values (lvals - such as local variables or object members)
-data ValueRef value where
-  -- Represents a value:
-  Rval :: value -> ValueRef value
-  -- Represents a local variable. No environment is attached - it's assumed that LvalLocal will be evaluated in the same scope it was constructed:
-  LvalLocal :: Name -> ValueRef value
-  -- Represents an object member:
-  LvalMember :: value -> Name -> ValueRef value
-
-  deriving (Eq, Ord, Show)
 
 -- Effects
 
@@ -63,14 +44,14 @@ data Return value resume where
 deriving instance Eq value => Eq (Return value a)
 deriving instance Show value => Show (Return value a)
 
-earlyReturn :: Member (Return value) effects => value -> Evaluator location value effects value
+earlyReturn :: Member (Return value) effects => value -> Evaluator address value effects value
 earlyReturn = send . Return
 
-catchReturn :: Member (Return value) effects => Evaluator location value effects a -> (forall x . Return value x -> Evaluator location value effects a) -> Evaluator location value effects a
+catchReturn :: Member (Return value) effects => Evaluator address value effects a -> (forall x . Return value x -> Evaluator address value effects a) -> Evaluator address value effects a
 catchReturn action handler = interpose pure (\ ret _ -> handler ret) action
 
-runReturn :: Evaluator location value (Return value ': effects) value -> Evaluator location value effects value
-runReturn = relay pure (\ (Return value) _ -> pure value)
+runReturn :: Effectful (m address value) => m address value (Return value ': effects) value -> m address value effects value
+runReturn = raiseHandler (relay pure (\ (Return value) _ -> pure value))
 
 
 -- | Effects for control flow around loops (breaking and continuing).
@@ -81,16 +62,16 @@ data LoopControl value resume where
 deriving instance Eq value => Eq (LoopControl value a)
 deriving instance Show value => Show (LoopControl value a)
 
-throwBreak :: Member (LoopControl value) effects => value -> Evaluator location value effects value
+throwBreak :: Member (LoopControl value) effects => value -> Evaluator address value effects value
 throwBreak = send . Break
 
-throwContinue :: Member (LoopControl value) effects => value -> Evaluator location value effects value
+throwContinue :: Member (LoopControl value) effects => value -> Evaluator address value effects value
 throwContinue = send . Continue
 
-catchLoopControl :: Member (LoopControl value) effects => Evaluator location value effects a -> (forall x . LoopControl value x -> Evaluator location value effects a) -> Evaluator location value effects a
+catchLoopControl :: Member (LoopControl value) effects => Evaluator address value effects a -> (forall x . LoopControl value x -> Evaluator address value effects a) -> Evaluator address value effects a
 catchLoopControl action handler = interpose pure (\ control _ -> handler control) action
 
-runLoopControl :: Evaluator location value (LoopControl value ': effects) value -> Evaluator location value effects value
-runLoopControl = relay pure (\ eff _ -> case eff of
+runLoopControl :: Effectful (m address value) => m address value (LoopControl value ': effects) value -> m address value effects value
+runLoopControl = raiseHandler (relay pure (\ eff _ -> case eff of
   Break    value -> pure value
-  Continue value -> pure value)
+  Continue value -> pure value))

src/Control/Abstract/Exports.hs

@@ -8,26 +8,25 @@ module Control.Abstract.Exports
 ) where
 
 import Control.Abstract.Evaluator
-import Data.Abstract.Address
 import Data.Abstract.Exports
-import Data.Abstract.FreeVariables
+import Data.Abstract.Name
 
 -- | Get the global export state.
-getExports :: Member (State (Exports location value)) effects => Evaluator location value effects (Exports location value)
+getExports :: Member (State (Exports address)) effects => Evaluator address value effects (Exports address)
 getExports = get
 
 -- | Set the global export state.
-putExports :: Member (State (Exports location value)) effects => Exports location value -> Evaluator location value effects ()
+putExports :: Member (State (Exports address)) effects => Exports address -> Evaluator address value effects ()
 putExports = put
 
 -- | Update the global export state.
-modifyExports :: Member (State (Exports location value)) effects => (Exports location value -> Exports location value) -> Evaluator location value effects ()
+modifyExports :: Member (State (Exports address)) effects => (Exports address -> Exports address) -> Evaluator address value effects ()
 modifyExports = modify'
 
 -- | Add an export to the global export state.
-addExport :: Member (State (Exports location value)) effects => Name -> Name -> Maybe (Address location value) -> Evaluator location value effects ()
+addExport :: Member (State (Exports address)) effects => Name -> Name -> Maybe address -> Evaluator address value effects ()
 addExport name alias = modifyExports . insert name alias
 
 -- | Sets the global export state for the lifetime of the given action.
-withExports :: Member (State (Exports location value)) effects => Exports location value -> Evaluator location value effects a -> Evaluator location value effects a
+withExports :: Member (State (Exports address)) effects => Exports address -> Evaluator address value effects a -> Evaluator address value effects a
 withExports = localState . const

src/Control/Abstract/Goto.hs

@@ -1,77 +0,0 @@
-{-# LANGUAGE GADTs, TypeOperators #-}
-module Control.Abstract.Goto
-( GotoTable
-, Label
-, label
-, goto
-, Goto(..)
-, runGoto
-) where
-
-import           Control.Abstract.Evaluator
-import           Control.Monad.Effect (Eff)
-import qualified Data.IntMap as IntMap
-import           Prelude hiding (fail)
-import           Prologue
-
-type GotoTable inner value = IntMap.IntMap (Eff (Goto inner value ': inner) value)
-
--- | The type of labels.
---   TODO: This should be rolled into 'Name' and tracked in the environment, both so that we can abstract over labels like any other location, and so that we can garbage collect unreachable labels.
-type Label = Int
-
-
--- | Allocate a 'Label' for the given @term@.
---
---   Labels must be allocated before being jumped to with 'goto', but are suitable for nonlocal jumps; thus, they can be used to implement coroutines, exception handling, call with current continuation, and other esoteric control mechanisms.
-label :: Evaluator location value (Goto effects value ': effects) value -> Evaluator location value (Goto effects value ': effects) Label
-label = send . Label . lowerEff
-
--- | “Jump” to a previously-allocated 'Label' (retrieving the @term@ at which it points, which can then be evaluated.
-goto :: Label -> Evaluator location value (Goto effects value ': effects) (Evaluator location value (Goto effects value ': effects) value)
-goto = fmap raiseEff . send . Goto
-
-
--- | 'Goto' effects embed an 'Eff' action which can be run in the environment under the 'Goto' itself.
---
---   It’s tempting to try to use a 'Member' constraint to require a 'Goto' effect:
---
---   @
---   foo :: Member (Goto effects a) effects => Eff effects a
---   @
---
---   However, using this type would require that the type of the effect list include a reference to itself, which is forbidden by the occurs check: we wouldn’t be able to write a handler for 'Goto' if it could be used at that type. Instead, one can either use a smaller, statically known effect list inside the 'Goto', e.g. @Member (Goto outer) inner@ where @outer@ is a suffix of @inner@ (and with some massaging to raise the @outer@ actions into the @inner@ context), or use 'Goto' when it’s statically known to be the head of the list: @Eff (Goto rest a ': rest) b@. In either case, the 'Eff' actions embedded in the effect are themselves able to contain further 'Goto' effects,
-data Goto effects value return where
-  Label :: Eff (Goto effects value ': effects) value -> Goto effects value Label
-  Goto  :: Label -> Goto effects value (Eff (Goto effects value ': effects) value)
-
--- | Run a 'Goto' effect in terms of a 'State' effect holding a 'GotoTable', accessed via wrap/unwrap functions.
---
---   The wrap/unwrap functions are necessary in order for ghc to be able to typecheck the table, since it necessarily contains references to its own effect list. Since @GotoTable (… ': State (GotoTable … value) ': …) value@ can’t be written, and a recursive type equality constraint won’t typecheck, callers will need to employ a @newtype@ to break the self-reference. The effect list of the table the @newtype@ contains will include all of the effects between the 'Goto' effect and the 'State' effect (including the 'State' but not the 'Goto'). E.g. if the 'State' is the next effect, a valid wrapper would be∷
---
---   @
---   newtype Gotos effects value = Gotos { getGotos :: GotoTable (State (Gotos effects value) ': effects) value }
---   @
---
---   Callers can then evaluate the high-level 'Goto' effect by passing @Gotos@ and @getGotos@ to 'runGoto'.
-runGoto :: Members '[ Fail
-                    , Fresh
-                    , State table
-                    ] effects
-        => (GotoTable effects value -> table)
-        -> (table -> GotoTable effects value)
-        -> Evaluator location value (Goto effects value ': effects) a
-        -> Evaluator location value effects a
-runGoto from to = interpret (\ goto -> do
-  table <- to <$> getTable
-  case goto of
-    Label action -> do
-      supremum <- fresh
-      supremum <$ putTable (from (IntMap.insert supremum action table))
-    Goto label   -> maybeM (raiseEff (fail ("unknown label: " <> show label))) (IntMap.lookup label table))
-
-getTable :: Member (State table) effects => Evaluator location value effects table
-getTable = get
-
-putTable :: Member (State table) effects => table -> Evaluator location value effects ()
-putTable = put

src/Control/Abstract/Heap.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, RankNTypes, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE GADTs, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Control.Abstract.Heap
 ( Heap
 , getHeap
@@ -22,126 +22,123 @@ module Control.Abstract.Heap
 import Control.Abstract.Addressable
 import Control.Abstract.Environment
 import Control.Abstract.Evaluator
-import Data.Abstract.Address
-import Data.Abstract.Environment
-import Data.Abstract.FreeVariables
+import Control.Monad.Effect.Internal
 import Data.Abstract.Heap
+import Data.Abstract.Name
 import Data.Semigroup.Reducer
 import Prologue
 
 -- | Retrieve the heap.
-getHeap :: Member (State (Heap location (Cell location) value)) effects => Evaluator location value effects (Heap location (Cell location) value)
+getHeap :: Member (State (Heap address (Cell address) value)) effects => Evaluator address value effects (Heap address (Cell address) value)
 getHeap = get
 
 -- | Set the heap.
-putHeap :: Member (State (Heap location (Cell location) value)) effects => Heap location (Cell location) value -> Evaluator location value effects ()
+putHeap :: Member (State (Heap address (Cell address) value)) effects => Heap address (Cell address) value -> Evaluator address value effects ()
 putHeap = put
 
 -- | Update the heap.
-modifyHeap :: Member (State (Heap location (Cell location) value)) effects => (Heap location (Cell location) value -> Heap location (Cell location) value) -> Evaluator location value effects ()
+modifyHeap :: Member (State (Heap address (Cell address) value)) effects => (Heap address (Cell address) value -> Heap address (Cell address) value) -> Evaluator address value effects ()
 modifyHeap = modify'
 
 
-alloc :: Member (Allocator location value) effects => Name -> Evaluator location value effects (Address location value)
-alloc = send . Alloc
+alloc :: forall address value effects . Member (Allocator address value) effects => Name -> Evaluator address value effects address
+alloc = send . Alloc @address @value
 
--- | Dereference the given 'Address'in the heap, or fail if the address is uninitialized.
-deref :: Member (Allocator location value) effects => Address location value -> Evaluator location value effects value
+-- | Dereference the given address in the heap, or fail if the address is uninitialized.
+deref :: Member (Allocator address value) effects => address -> Evaluator address value effects value
 deref = send . Deref
 
 
--- | Write a value to the given 'Address' in the 'Store'.
-assign :: ( Member (State (Heap location (Cell location) value)) effects
-          , Ord location
-          , Reducer value (Cell location value)
+-- | Write a value to the given address in the 'Store'.
+assign :: ( Member (State (Heap address (Cell address) value)) effects
+          , Ord address
+          , Reducer value (Cell address value)
           )
-       => Address location value
+       => address
        -> value
-       -> Evaluator location value effects ()
+       -> Evaluator address value effects ()
 assign address = modifyHeap . heapInsert address
 
 
 -- | Look up or allocate an address for a 'Name'.
-lookupOrAlloc :: Members '[ Allocator location value
-                          , Reader (Environment location value)
-                          , State (Environment location value)
-                          ] effects
+lookupOrAlloc :: ( Member (Allocator address value) effects
+                 , Member (Reader (Environment address)) effects
+                 , Member (State (Environment address)) effects
+                 )
               => Name
-              -> Evaluator location value effects (Address location value)
+              -> Evaluator address value effects address
 lookupOrAlloc name = lookupEnv name >>= maybe (alloc name) pure
 
 
-letrec :: ( Members '[ Allocator location value
-                     , Reader (Environment location value)
-                     , State (Environment location value)
-                     , State (Heap location (Cell location) value)
-                     ] effects
-          , Ord location
-          , Reducer value (Cell location value)
+letrec :: ( Member (Allocator address value) effects
+          , Member (Reader (Environment address)) effects
+          , Member (State (Environment address)) effects
+          , Member (State (Heap address (Cell address) value)) effects
+          , Ord address
+          , Reducer value (Cell address value)
           )
        => Name
-       -> Evaluator location value effects value
-       -> Evaluator location value effects (value, Address location value)
+       -> Evaluator address value effects value
+       -> Evaluator address value effects (value, address)
 letrec name body = do
   addr <- lookupOrAlloc name
-  v <- localEnv (insert name addr) body
+  v <- locally (bind name addr *> body)
   assign addr v
   pure (v, addr)
 
 -- Lookup/alloc a name passing the address to a body evaluated in a new local environment.
-letrec' :: Members '[ Allocator location value
-                    , Reader (Environment location value)
-                    , State (Environment location value)
-                    ] effects
+letrec' :: ( Member (Allocator address value) effects
+           , Member (Reader (Environment address)) effects
+           , Member (State (Environment address)) effects
+           )
         => Name
-        -> (Address location value -> Evaluator location value effects value)
-        -> Evaluator location value effects value
+        -> (address -> Evaluator address value effects value)
+        -> Evaluator address value effects value
 letrec' name body = do
   addr <- lookupOrAlloc name
-  v <- localEnv id (body addr)
-  v <$ modifyEnv (insert name addr)
+  v <- locally (body addr)
+  v <$ bind name addr
 
 
 -- | Look up and dereference the given 'Name', throwing an exception for free variables.
-variable :: Members '[ Allocator location value
-                     , Reader (Environment location value)
-                     , Resumable (EnvironmentError value)
-                     , State (Environment location value)
-                     , State (Heap location (Cell location) value)
-                     ] effects
+variable :: ( Member (Allocator address value) effects
+            , Member (Reader (Environment address)) effects
+            , Member (Resumable (EnvironmentError address)) effects
+            , Member (State (Environment address)) effects
+            )
          => Name
-         -> Evaluator location value effects value
-variable name = lookupEnv name >>= maybe (freeVariableError name) deref
+         -> Evaluator address value effects value
+variable name = lookupEnv name >>= maybeM (freeVariableError name) >>= deref
 
 
 -- Effects
 
-data Allocator location value return where
-  Alloc :: Name                   -> Allocator location value (Address location value)
-  Deref :: Address location value -> Allocator location value value
+data Allocator address value return where
+  Alloc :: Name     -> Allocator address value address
+  Deref :: address -> Allocator address value value
 
-runAllocator :: (Addressable location effects, Members '[Resumable (AddressError location value), State (Heap location (Cell location) value)] effects) => Evaluator location value (Allocator location value ': effects) a -> Evaluator location value effects a
-runAllocator = interpret (\ eff -> case eff of
-  Alloc name -> Address <$> allocCell name
-  Deref addr -> heapLookup addr <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr)))
+runAllocator :: (Addressable address effects, Effectful (m address value), Member (Resumable (AddressError address value)) effects, Member (State (Heap address (Cell address) value)) effects) => m address value (Allocator address value ': effects) a -> m address value effects a
+runAllocator = raiseHandler (interpret (\ eff -> case eff of
+  Alloc name -> lowerEff $ allocCell name
+  Deref addr -> lowerEff $ heapLookup addr <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr))))
 
 
-data AddressError location value resume where
-  UnallocatedAddress   :: Address location value -> AddressError location value (Cell location value)
-  UninitializedAddress :: Address location value -> AddressError location value value
+data AddressError address value resume where
+  UnallocatedAddress   :: address -> AddressError address value (Cell address value)
+  UninitializedAddress :: address -> AddressError address value value
 
-deriving instance Eq location => Eq (AddressError location value resume)
-deriving instance Show location => Show (AddressError location value resume)
-instance Show location => Show1 (AddressError location value) where
+deriving instance Eq address => Eq (AddressError address value resume)
+deriving instance Show address => Show (AddressError address value resume)
+instance Show address => Show1 (AddressError address value) where
   liftShowsPrec _ _ = showsPrec
-instance Eq location => Eq1 (AddressError location value) where
+instance Eq address => Eq1 (AddressError address value) where
   liftEq _ (UninitializedAddress a) (UninitializedAddress b) = a == b
   liftEq _ (UnallocatedAddress a)   (UnallocatedAddress b)   = a == b
   liftEq _ _                        _                        = False
 
 
-runAddressError :: Effectful (m location value) => m location value (Resumable (AddressError location value) ': effects) a -> m location value effects (Either (SomeExc (AddressError location value)) a)
+runAddressError :: Effectful (m address value) => m address value (Resumable (AddressError address value) ': effects) a -> m address value effects (Either (SomeExc (AddressError address value)) a)
 runAddressError = runResumable
 
-runAddressErrorWith :: Effectful (m location value) => (forall resume . AddressError location value resume -> m location value effects resume) -> m location value (Resumable (AddressError location value) ': effects) a -> m location value effects a
+runAddressErrorWith :: Effectful (m address value) => (forall resume . AddressError address value resume -> m address value effects resume) -> m address value (Resumable (AddressError address value) ': effects) a -> m address value effects a
 runAddressErrorWith = runResumableWith

src/Control/Abstract/Hole.hs

@@ -0,0 +1,15 @@
+module Control.Abstract.Hole where
+
+class AbstractHole a where
+  hole :: a
+
+
+data Hole a = Partial | Total a
+  deriving (Foldable, Functor, Eq, Ord, Show, Traversable)
+
+instance AbstractHole (Hole a) where
+  hole = Partial
+
+toMaybe :: Hole a -> Maybe a
+toMaybe Partial = Nothing
+toMaybe (Total a) = Just a

src/Control/Abstract/Modules.hs

@@ -26,49 +26,49 @@ import Data.Language
 import Prologue
 
 -- | Retrieve an evaluated module, if any. The outer 'Maybe' indicates whether we’ve begun loading the module or not, while the inner 'Maybe' indicates whether we’ve completed loading it or not. Thus, @Nothing@ means we’ve never tried to load it, @Just Nothing@ means we’ve started but haven’t yet finished loading it, and @Just (Just (env, value))@ indicates the result of a completed load.
-lookupModule :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Maybe (Environment location value, value)))
+lookupModule :: Member (Modules address value) effects => ModulePath -> Evaluator address value effects (Maybe (Maybe (Environment address, value)))
 lookupModule = send . Lookup
 
 -- | Resolve a list of module paths to a possible module table entry.
-resolve :: Member (Modules location value) effects => [FilePath] -> Evaluator location value effects (Maybe ModulePath)
+resolve :: Member (Modules address value) effects => [FilePath] -> Evaluator address value effects (Maybe ModulePath)
 resolve = sendModules . Resolve
 
-listModulesInDir :: Member (Modules location value) effects => FilePath -> Evaluator location value effects [ModulePath]
+listModulesInDir :: Member (Modules address value) effects => FilePath -> Evaluator address value effects [ModulePath]
 listModulesInDir = sendModules . List
 
 
 -- | Require/import another module by name and return its environment and value.
 --
 -- Looks up the module's name in the cache of evaluated modules first, returns if found, otherwise loads/evaluates the module.
-require :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Environment location value, value))
+require :: Member (Modules address value) effects => ModulePath -> Evaluator address value effects (Maybe (Environment address, value))
 require path = lookupModule path >>= maybeM (load path)
 
 -- | Load another module by name and return its environment and value.
 --
 -- Always loads/evaluates.
-load :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Environment location value, value))
+load :: Member (Modules address value) effects => ModulePath -> Evaluator address value effects (Maybe (Environment address, value))
 load = send . Load
 
 
-data Modules location value return where
-  Load    :: ModulePath -> Modules location value (Maybe (Environment location value, value))
-  Lookup  :: ModulePath -> Modules location value (Maybe (Maybe (Environment location value, value)))
-  Resolve :: [FilePath] -> Modules location value (Maybe ModulePath)
-  List    :: FilePath   -> Modules location value [ModulePath]
+data Modules address value return where
+  Load    :: ModulePath -> Modules address value (Maybe (Environment address, value))
+  Lookup  :: ModulePath -> Modules address value (Maybe (Maybe (Environment address, value)))
+  Resolve :: [FilePath] -> Modules address value (Maybe ModulePath)
+  List    :: FilePath   -> Modules address value [ModulePath]
 
-sendModules :: Member (Modules location value) effects => Modules location value return -> Evaluator location value effects return
+sendModules :: Member (Modules address value) effects => Modules address value return -> Evaluator address value effects return
 sendModules = send
 
-runModules :: forall term location value effects a
-           .  Members '[ Resumable (LoadError location value)
-                       , State (ModuleTable (Maybe (Environment location value, value)))
-                       , Trace
-                       ] effects
-           => (Module term -> Evaluator location value (Modules location value ': effects) (Environment location value, value))
-           -> Evaluator location value (Modules location value ': effects) a
-           -> Evaluator location value (Reader (ModuleTable [Module term]) ': effects) a
+runModules :: forall term address value effects a
+           .  ( Member (Resumable (LoadError address value)) effects
+              , Member (State (ModuleTable (Maybe (Environment address, value)))) effects
+              , Member Trace effects
+              )
+           => (Module term -> Evaluator address value (Modules address value ': effects) (Environment address, value))
+           -> Evaluator address value (Modules address value ': effects) a
+           -> Evaluator address value (Reader (ModuleTable [Module term]) ': effects) a
 runModules evaluateModule = go
-  where go :: forall a . Evaluator location value (Modules location value ': effects) a -> Evaluator location value (Reader (ModuleTable [Module term]) ': effects) a
+  where go :: forall a . Evaluator address value (Modules address value ': effects) a -> Evaluator address value (Reader (ModuleTable [Module term]) ': effects) a
         go = reinterpret (\ m -> case m of
           Load name -> askModuleTable @term >>= maybe (moduleNotFound name) (runMerging . foldMap (Merging . evalAndCache)) . ModuleTable.lookup name
             where
@@ -89,49 +89,49 @@ runModules evaluateModule = go
             pure (find isMember names)
           List dir -> modulePathsInDir dir <$> askModuleTable @term)
 
-getModuleTable :: Member (State (ModuleTable (Maybe (Environment location value, value)))) effects => Evaluator location value effects (ModuleTable (Maybe (Environment location value, value)))
+getModuleTable :: Member (State (ModuleTable (Maybe (Environment address, value)))) effects => Evaluator address value effects (ModuleTable (Maybe (Environment address, value)))
 getModuleTable = get
 
-cacheModule :: Member (State (ModuleTable (Maybe (Environment location value, value)))) effects => ModulePath -> Maybe (Environment location value, value) -> Evaluator location value effects (Maybe (Environment location value, value))
+cacheModule :: Member (State (ModuleTable (Maybe (Environment address, value)))) effects => ModulePath -> Maybe (Environment address, value) -> Evaluator address value effects (Maybe (Environment address, value))
 cacheModule path result = modify' (ModuleTable.insert path result) $> result
 
-askModuleTable :: Member (Reader (ModuleTable [Module term])) effects => Evaluator location value effects (ModuleTable [Module term])
+askModuleTable :: Member (Reader (ModuleTable [Module term])) effects => Evaluator address value effects (ModuleTable [Module term])
 askModuleTable = ask
 
 
-newtype Merging m location value = Merging { runMerging :: m (Maybe (Environment location value, value)) }
+newtype Merging m address value = Merging { runMerging :: m (Maybe (Environment address, value)) }
 
-instance Applicative m => Semigroup (Merging m location value) where
+instance Applicative m => Semigroup (Merging m address value) where
   Merging a <> Merging b = Merging (merge <$> a <*> b)
     where merge a b = mergeJusts <$> a <*> b <|> a <|> b
           mergeJusts (env1, _) (env2, v) = (mergeEnvs env1 env2, v)
 
-instance Applicative m => Monoid (Merging m location value) where
+instance Applicative m => Monoid (Merging m address value) where
   mappend = (<>)
   mempty = Merging (pure Nothing)
 
 
 -- | An error thrown when loading a module from the list of provided modules. Indicates we weren't able to find a module with the given name.
-data LoadError location value resume where
-  ModuleNotFound :: ModulePath -> LoadError location value (Maybe (Environment location value, value))
+data LoadError address value resume where
+  ModuleNotFound :: ModulePath -> LoadError address value (Maybe (Environment address, value))
 
-deriving instance Eq (LoadError location value resume)
-deriving instance Show (LoadError location value resume)
-instance Show1 (LoadError location value) where
+deriving instance Eq (LoadError address value resume)
+deriving instance Show (LoadError address value resume)
+instance Show1 (LoadError address value) where
   liftShowsPrec _ _ = showsPrec
-instance Eq1 (LoadError location value) where
+instance Eq1 (LoadError address value) where
   liftEq _ (ModuleNotFound a) (ModuleNotFound b) = a == b
 
-moduleNotFound :: Member (Resumable (LoadError location value)) effects => ModulePath -> Evaluator location value effects (Maybe (Environment location value, value))
+moduleNotFound :: Member (Resumable (LoadError address value)) effects => ModulePath -> Evaluator address value effects (Maybe (Environment address, value))
 moduleNotFound = throwResumable . ModuleNotFound
 
-resumeLoadError :: Member (Resumable (LoadError location value)) effects => Evaluator location value effects a -> (forall resume . LoadError location value resume -> Evaluator location value effects resume) -> Evaluator location value effects a
+resumeLoadError :: Member (Resumable (LoadError address value)) effects => Evaluator address value effects a -> (forall resume . LoadError address value resume -> Evaluator address value effects resume) -> Evaluator address value effects a
 resumeLoadError = catchResumable
 
-runLoadError :: Effectful (m location value) => m location value (Resumable (LoadError location value) ': effects) a -> m location value effects (Either (SomeExc (LoadError location value)) a)
+runLoadError :: Effectful (m address value) => m address value (Resumable (LoadError address value) ': effects) a -> m address value effects (Either (SomeExc (LoadError address value)) a)
 runLoadError = runResumable
 
-runLoadErrorWith :: Effectful (m location value) => (forall resume . LoadError location value resume -> m location value effects resume) -> m location value (Resumable (LoadError location value) ': effects) a -> m location value effects a
+runLoadErrorWith :: Effectful (m address value) => (forall resume . LoadError address value resume -> m address value effects resume) -> m address value (Resumable (LoadError address value) ': effects) a -> m address value effects a
 runLoadErrorWith = runResumableWith
 
 

src/Control/Abstract/Primitive.hs

@@ -0,0 +1,56 @@
+module Control.Abstract.Primitive where
+
+import Control.Abstract.Addressable
+import Control.Abstract.Context
+import Control.Abstract.Environment
+import Control.Abstract.Evaluator
+import Control.Abstract.Heap
+import Control.Abstract.Value
+import Data.Abstract.Name
+import Data.ByteString.Char8 (pack, unpack)
+import Data.Semigroup.Reducer hiding (unit)
+import Data.Semilattice.Lower
+import Prologue
+
+builtin :: ( HasCallStack
+           , Member (Allocator address value) effects
+           , Member (Reader ModuleInfo) effects
+           , Member (Reader Span) effects
+           , Member (State (Environment address)) effects
+           , Member (State (Heap address (Cell address) value)) effects
+           , Ord address
+           , Reducer value (Cell address value)
+           )
+        => String
+        -> Evaluator address value effects value
+        -> Evaluator address value effects ()
+builtin s def = withCurrentCallStack callStack $ do
+  let name' = name (pack ("__semantic_" <> s))
+  addr <- alloc name'
+  bind name' addr
+  def >>= assign addr
+
+lambda :: (AbstractFunction address value effects, Member Fresh effects)
+       => (Name -> Evaluator address value effects value)
+       -> Evaluator address value effects value
+lambda body = do
+  var <- nameI <$> fresh
+  closure [var] lowerBound (body var)
+
+defineBuiltins :: ( AbstractValue address value effects
+                  , HasCallStack
+                  , Member (Allocator address value) effects
+                  , Member Fresh effects
+                  , Member (Reader (Environment address)) effects
+                  , Member (Reader ModuleInfo) effects
+                  , Member (Reader Span) effects
+                  , Member (Resumable (EnvironmentError address)) effects
+                  , Member (State (Environment address)) effects
+                  , Member (State (Heap address (Cell address) value)) effects
+                  , Member Trace effects
+                  , Ord address
+                  , Reducer value (Cell address value)
+                  )
+               => Evaluator address value effects ()
+defineBuiltins =
+  builtin "print" (lambda (\ v -> variable v >>= asString >>= trace . unpack >> pure unit))

src/Control/Abstract/Roots.hs

@@ -9,9 +9,9 @@ import Data.Abstract.Live
 import Prologue
 
 -- | Retrieve the local 'Live' set.
-askRoots :: Member (Reader (Live location value)) effects => Evaluator location value effects (Live location value)
+askRoots :: Member (Reader (Live address)) effects => Evaluator address value effects (Live address)
 askRoots = ask
 
 -- | Run a computation with the given 'Live' set added to the local root set.
-extraRoots :: (Member (Reader (Live location value)) effects, Ord location) => Live location value -> Evaluator location value effects a -> Evaluator location value effects a
+extraRoots :: (Member (Reader (Live address)) effects, Ord address) => Live address -> Evaluator address value effects a -> Evaluator address value effects a
 extraRoots roots = local (<> roots)

src/Control/Abstract/TermEvaluator.hs

@@ -19,11 +19,11 @@ import Prologue
 -- | Evaluators specialized to some specific term type.
 --
 --   This is used to constrain the term type so that inference for analyses can resolve it correctly, but should not be used for any of the term-agonstic machinery like builtins, Evaluatable instances, the mechanics of the heap & environment, etc.
-newtype TermEvaluator term location value effects a = TermEvaluator { runTermEvaluator :: Evaluator location value effects a }
+newtype TermEvaluator term address value effects a = TermEvaluator { runTermEvaluator :: Evaluator address value effects a }
   deriving (Applicative, Effectful, Functor, Monad)
 
-deriving instance Member NonDet effects => Alternative (TermEvaluator term location value effects)
+deriving instance Member NonDet effects => Alternative (TermEvaluator term address value effects)
 
 
-raiseHandler :: (Evaluator location value effects a -> Evaluator location value effects' a') -> (TermEvaluator term location value effects a -> TermEvaluator term location value effects' a')
+raiseHandler :: (Evaluator address value effects a -> Evaluator address value effects' a') -> (TermEvaluator term address value effects a -> TermEvaluator term address value effects' a')
 raiseHandler f = TermEvaluator . f . runTermEvaluator

src/Control/Abstract/Value.hs

@@ -1,12 +1,17 @@
-{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE GADTs, Rank2Types #-}
 module Control.Abstract.Value
 ( AbstractValue(..)
-, AbstractHole(..)
+, AbstractIntro(..)
+, AbstractFunction(..)
 , Comparator(..)
+, asBool
 , while
 , doWhile
 , forLoop
 , makeNamespace
+, evaluateInScopedEnv
+, value
+, subtermValue
 , ValueRoots(..)
 ) where
 
@@ -14,11 +19,11 @@ import Control.Abstract.Addressable
 import Control.Abstract.Environment
 import Control.Abstract.Evaluator
 import Control.Abstract.Heap
-import Data.Abstract.Address (Address)
 import Data.Abstract.Environment as Env
-import Data.Abstract.FreeVariables
 import Data.Abstract.Live (Live)
+import Data.Abstract.Name
 import Data.Abstract.Number as Number
+import Data.Abstract.Ref
 import Data.Scientific (Scientific)
 import Data.Semigroup.Reducer hiding (unit)
 import Data.Semilattice.Lower
@@ -35,163 +40,162 @@ data Comparator
   = Concrete (forall a . Ord a => a -> a -> Bool)
   | Generalized
 
-class AbstractHole value where
-  hole :: value
+class Show value => AbstractFunction address value effects where
+  -- | Build a closure (a binder like a lambda or method definition).
+  closure :: [Name]                                 -- ^ The parameter names.
+          -> Set Name                               -- ^ The set of free variables to close over.
+          -> Evaluator address value effects value -- ^ The evaluator for the body of the closure.
+          -> Evaluator address value effects value
+  -- | Evaluate an application (like a function call).
+  call :: value -> [Evaluator address value effects value] -> Evaluator address value effects value
+
+
+class Show value => AbstractIntro value where
+  -- | Construct an abstract unit value.
+  --   TODO: This might be the same as the empty tuple for some value types
+  unit :: value
+
+  -- | Construct an abstract boolean value.
+  boolean :: Bool -> value
+
+  -- | Construct an abstract string value.
+  string :: ByteString -> value
+
+  -- | Construct a self-evaluating symbol value.
+  --   TODO: Should these be interned in some table to provide stronger uniqueness guarantees?
+  symbol :: ByteString -> value
+
+  -- | Construct an abstract integral value.
+  integer :: Integer -> value
+
+  -- | Construct a floating-point value.
+  float :: Scientific -> value
+
+  -- | Construct a rational value.
+  rational :: Rational -> value
+
+  -- | Construct an N-ary tuple of multiple (possibly-disjoint) values
+  multiple :: [value] -> value
+
+  -- | Construct a key-value pair for use in a hash.
+  kvPair :: value -> value -> value
+
+  -- | Construct a hash out of pairs.
+  hash :: [(value, value)] -> value
+
+  -- | Construct the nil/null datatype.
+  null :: value
+
 
 -- | 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 Show value => AbstractValue location value effects where
-  -- | Construct an abstract unit value.
-  --   TODO: This might be the same as the empty tuple for some value types
-  unit :: Evaluator location value effects value
-
-  -- | Construct an abstract integral value.
-  integer :: Prelude.Integer -> Evaluator location value effects value
-
+class (AbstractFunction address value effects, AbstractIntro value) => AbstractValue address value effects where
   -- | Lift a unary operator over a 'Num' to a function on 'value's.
   liftNumeric  :: (forall a . Num a => a -> a)
-               -> (value -> Evaluator location value effects value)
+               -> (value -> Evaluator address value effects value)
 
   -- | Lift a pair of binary operators to a function on 'value's.
   --   You usually pass the same operator as both arguments, except in the cases where
   --   Haskell provides different functions for integral and fractional operations, such
   --   as division, exponentiation, and modulus.
   liftNumeric2 :: (forall a b. Number a -> Number b -> SomeNumber)
-               -> (value -> value -> Evaluator location value effects value)
+               -> (value -> value -> Evaluator address value effects value)
 
   -- | Lift a Comparator (usually wrapping a function like == or <=) to a function on values.
-  liftComparison :: Comparator -> (value -> value -> Evaluator location value effects value)
+  liftComparison :: Comparator -> (value -> value -> Evaluator address value effects value)
 
   -- | Lift a unary bitwise operator to values. This is usually 'complement'.
   liftBitwise :: (forall a . Bits a => a -> a)
-              -> (value -> Evaluator location value effects value)
+              -> (value -> Evaluator address value effects value)
 
   -- | Lift a binary bitwise operator to values. The Integral constraint is
   --   necessary to satisfy implementation details of Haskell left/right shift,
   --   but it's fine, since these are only ever operating on integral values.
   liftBitwise2 :: (forall a . (Integral a, Bits a) => a -> a -> a)
-               -> (value -> value -> Evaluator location value effects value)
-
-  -- | Construct an abstract boolean value.
-  boolean :: Bool -> Evaluator location value effects value
-
-  -- | Construct an abstract string value.
-  string :: ByteString -> Evaluator location value effects value
-
-  -- | Construct a self-evaluating symbol value.
-  --   TODO: Should these be interned in some table to provide stronger uniqueness guarantees?
-  symbol :: ByteString -> Evaluator location value effects value
-
-  -- | Construct a floating-point value.
-  float :: Scientific -> Evaluator location value effects value
-
-  -- | Construct a rational value.
-  rational :: Prelude.Rational -> Evaluator location value effects value
-
-  -- | Construct an N-ary tuple of multiple (possibly-disjoint) values
-  multiple :: [value] -> Evaluator location value effects value
+               -> (value -> value -> Evaluator address value effects value)
 
   -- | Construct an array of zero or more values.
-  array :: [value] -> Evaluator location value effects value
-
-  -- | Construct a key-value pair for use in a hash.
-  kvPair :: value -> value -> Evaluator location value effects value
+  array :: [value] -> Evaluator address value effects value
 
   -- | Extract the contents of a key-value pair as a tuple.
-  asPair :: value -> Evaluator location value effects (value, value)
-
-  -- | Construct a hash out of pairs.
-  hash :: [(value, value)] -> Evaluator location value effects value
+  asPair :: value -> Evaluator address value effects (value, value)
 
   -- | Extract a 'ByteString' from a given value.
-  asString :: value -> Evaluator location value effects ByteString
+  asString :: value -> Evaluator address value effects ByteString
 
   -- | Eliminate boolean values. TODO: s/boolean/truthy
-  ifthenelse :: value -> Evaluator location value effects value -> Evaluator location value effects value -> Evaluator location value effects value
-
-  -- | Extract a 'Bool' from a given value.
-  asBool :: value -> Evaluator location value effects Bool
-
-  -- | Construct the nil/null datatype.
-  null :: Evaluator location value effects value
+  ifthenelse :: value -> Evaluator address value effects a -> Evaluator address value effects a -> Evaluator address value effects a
 
   -- | @index x i@ computes @x[i]@, with zero-indexing.
-  index :: value -> value -> Evaluator location value effects value
-
-  -- | Determine whether the given datum is a 'Hole'.
-  isHole :: value -> Evaluator location value effects Bool
+  index :: value -> value -> Evaluator address value effects value
 
   -- | Build a class value from a name and environment.
   klass :: Name                 -- ^ The new class's identifier
         -> [value]              -- ^ A list of superclasses
-        -> Environment location value -- ^ The environment to capture
-        -> Evaluator location value effects value
+        -> Environment address -- ^ The environment to capture
+        -> Evaluator address value effects value
 
   -- | Build a namespace value from a name and environment stack
   --
   -- Namespaces model closures with monoidal environments.
   namespace :: Name                 -- ^ The namespace's identifier
-            -> Environment location value -- ^ The environment to mappend
-            -> Evaluator location value effects value
+            -> Environment address -- ^ The environment to mappend
+            -> Evaluator address value effects value
 
   -- | Extract the environment from any scoped object (e.g. classes, namespaces, etc).
-  scopedEnvironment :: value -> Evaluator location value effects (Maybe (Environment location value))
-
-  -- | Build a closure (a binder like a lambda or method definition).
-  closure :: [Name]                                 -- ^ The parameter names.
-          -> Set Name                               -- ^ The set of free variables to close over.
-          -> Evaluator location value effects value -- ^ The evaluator for the body of the closure.
-          -> Evaluator location value effects value
-  -- | Evaluate an application (like a function call).
-  call :: value -> [Evaluator location value effects value] -> Evaluator location value effects value
+  scopedEnvironment :: value -> Evaluator address value effects (Maybe (Environment address))
 
   -- | Primitive looping combinator, approximately equivalent to 'fix'. This should be used in place of direct recursion, as it allows abstraction over recursion.
   --
   --   The function argument takes an action which recurs through the loop.
-  loop :: (Evaluator location value effects value -> Evaluator location value effects value) -> Evaluator location value effects value
+  loop :: (Evaluator address value effects value -> Evaluator address value effects value) -> Evaluator address value effects value
 
 
--- | Attempt to extract a 'Prelude.Bool' from a given value.
-forLoop :: ( AbstractValue location value effects
-           , Member (State (Environment location value)) effects
+-- | Extract a 'Bool' from a given value.
+asBool :: AbstractValue address value effects => value -> Evaluator address value effects Bool
+asBool value = ifthenelse value (pure True) (pure False)
+
+-- | C-style for loops.
+forLoop :: ( AbstractValue address value effects
+           , Member (State (Environment address)) effects
            )
-        => Evaluator location value effects value -- ^ Initial statement
-        -> Evaluator location value effects value -- ^ Condition
-        -> Evaluator location value effects value -- ^ Increment/stepper
-        -> Evaluator location value effects value -- ^ Body
-        -> Evaluator location value effects value
+        => Evaluator address value effects value -- ^ Initial statement
+        -> Evaluator address value effects value -- ^ Condition
+        -> Evaluator address value effects value -- ^ Increment/stepper
+        -> Evaluator address value effects value -- ^ Body
+        -> Evaluator address value effects value
 forLoop initial cond step body =
-  localize (initial *> while cond (body *> step))
+  locally (initial *> while cond (body *> step))
 
--- | The fundamental looping primitive, built on top of ifthenelse.
-while :: AbstractValue location value effects
-      => Evaluator location value effects value
-      -> Evaluator location value effects value
-      -> Evaluator location value effects value
+-- | The fundamental looping primitive, built on top of 'ifthenelse'.
+while :: AbstractValue address value effects
+      => Evaluator address value effects value
+      -> Evaluator address value effects value
+      -> Evaluator address value effects value
 while cond body = loop $ \ continue -> do
   this <- cond
-  ifthenelse this (body *> continue) unit
+  ifthenelse this (body *> continue) (pure unit)
 
 -- | Do-while loop, built on top of while.
-doWhile :: AbstractValue location value effects
-        => Evaluator location value effects value
-        -> Evaluator location value effects value
-        -> Evaluator location value effects value
+doWhile :: AbstractValue address value effects
+        => Evaluator address value effects value
+        -> Evaluator address value effects value
+        -> Evaluator address value effects value
 doWhile body cond = loop $ \ continue -> body *> do
   this <- cond
-  ifthenelse this continue unit
+  ifthenelse this continue (pure unit)
 
-makeNamespace :: ( AbstractValue location value effects
-                 , Member (State (Environment location value)) effects
-                 , Member (State (Heap location (Cell location) value)) effects
-                 , Ord location
-                 , Reducer value (Cell location value)
+makeNamespace :: ( AbstractValue address value effects
+                 , Member (State (Environment address)) effects
+                 , Member (State (Heap address (Cell address) value)) effects
+                 , Ord address
+                 , Reducer value (Cell address value)
                  )
               => Name
-              -> Address location value
+              -> address
               -> Maybe value
-              -> Evaluator location value effects value
+              -> Evaluator address value effects value
 makeNamespace name addr super = do
   superEnv <- maybe (pure (Just lowerBound)) scopedEnvironment super
   let env' = fromMaybe lowerBound superEnv
@@ -200,7 +204,44 @@ makeNamespace name addr super = do
   v <$ assign addr v
 
 
+-- | Evaluate a term within the context of the scoped environment of 'scopedEnvTerm'.
+evaluateInScopedEnv :: ( AbstractValue address value effects
+                       , Member (State (Environment address)) effects
+                       )
+                    => Evaluator address value effects value
+                    -> Evaluator address value effects value
+                    -> Evaluator address value effects value
+evaluateInScopedEnv scopedEnvTerm term = do
+  scopedEnv <- scopedEnvTerm >>= scopedEnvironment
+  maybe term (\ env -> locally (bindAll env *> term)) scopedEnv
+
+
+-- | Evaluates a 'Value' returning the referenced value
+value :: ( AbstractValue address value effects
+         , Member (Allocator address value) effects
+         , Member (Reader (Environment address)) effects
+         , Member (Resumable (EnvironmentError address)) effects
+         , Member (State (Environment address)) effects
+         )
+      => ValueRef value
+      -> Evaluator address value effects value
+value (LvalLocal var) = variable var
+value (LvalMember obj prop) = evaluateInScopedEnv (pure obj) (variable prop)
+value (Rval val) = pure val
+
+-- | Evaluates a 'Subterm' to its rval
+subtermValue :: ( AbstractValue address value effects
+                , Member (Allocator address value) effects
+                , Member (Reader (Environment address)) effects
+                , Member (Resumable (EnvironmentError address)) effects
+                , Member (State (Environment address)) effects
+                )
+             => Subterm term (Evaluator address value effects (ValueRef value))
+             -> Evaluator address value effects value
+subtermValue = value <=< subtermRef
+
+
 -- | Value types, e.g. closures, which can root a set of addresses.
-class ValueRoots location value where
+class ValueRoots address value where
   -- | Compute the set of addresses rooted by a given value.
-  valueRoots :: value -> Live location value
+  valueRoots :: value -> Live address

src/Data/Abstract/Address.hs

@@ -1,8 +1,8 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
 module Data.Abstract.Address where
 
-import Data.Abstract.FreeVariables
 import Data.Abstract.Module (ModuleInfo)
+import Data.Abstract.Name
 import Data.Abstract.Package (PackageInfo)
 import Data.Monoid (Last(..))
 import Data.Semigroup.Reducer
@@ -10,18 +10,6 @@ import Data.Semilattice.Lower
 import Data.Set as Set
 import Prologue
 
--- | An abstract address with a @location@ pointing to a variable of type @value@.
-newtype Address location value = Address { unAddress :: location }
-  deriving (Eq, Ord)
-
-instance Eq   location => Eq1   (Address location) where liftEq          _ a b = unAddress a    ==     unAddress b
-instance Ord  location => Ord1  (Address location) where liftCompare     _ a b = unAddress a `compare` unAddress b
-instance Show location => Show1 (Address location) where liftShowsPrec _ _     = showsPrec
-
-instance Show location => Show (Address location value) where
-  showsPrec d = showsPrec d . unAddress
-
-
 -- | 'Precise' models precise store semantics where only the 'Latest' value is taken. Everything gets it's own address (always makes a new allocation) which makes for a larger store.
 newtype Precise = Precise { unPrecise :: Int }
   deriving (Eq, Ord)
@@ -35,13 +23,13 @@ newtype Monovariant = Monovariant { unMonovariant :: Name }
   deriving (Eq, Ord)
 
 instance Show Monovariant where
-  showsPrec d = showsUnaryWith showsPrec "Monovariant" d . unName . unMonovariant
+  showsPrec d = showsUnaryWith showsPrec "Monovariant" d . unMonovariant
 
 
-data Located location = Located
-  { location        :: location
-  , locationPackage :: {-# UNPACK #-} !PackageInfo
-  , locationModule  :: !ModuleInfo
+data Located address = Located
+  { address        :: address
+  , addressPackage :: {-# UNPACK #-} !PackageInfo
+  , addressModule  :: !ModuleInfo
   }
   deriving (Eq, Ord, Show)
 

src/Data/Abstract/Cache.hs

@@ -1,38 +1,38 @@
 {-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, TypeFamilies #-}
 module Data.Abstract.Cache where
 
-import Control.Abstract.Evaluator
 import Data.Abstract.Configuration
 import Data.Abstract.Heap
+import Data.Abstract.Ref
 import Data.Map.Monoidal as Monoidal
 import Data.Semilattice.Lower
 import Prologue
 
 -- | A map of 'Configuration's to 'Set's of resulting values & 'Heap's.
-newtype Cache term location cell value = Cache { unCache :: Monoidal.Map (Configuration term location cell value) (Set (Cached location cell value)) }
-  deriving (Eq, Lower, Monoid, Ord, Reducer (Configuration term location cell value, Cached location cell value), Semigroup)
+newtype Cache term address cell value = Cache { unCache :: Monoidal.Map (Configuration term address cell value) (Set (Cached address cell value)) }
+  deriving (Eq, Lower, Monoid, Ord, Reducer (Configuration term address cell value, Cached address cell value), Semigroup)
 
-data Cached location cell value = Cached
+data Cached address cell value = Cached
   { cachedValue :: ValueRef value
-  , cachedHeap  :: Heap location cell value
+  , cachedHeap  :: Heap address cell value
   }
   deriving (Eq, Ord, Show)
 
 
-type Cacheable term location cell value = (Ord (cell value), Ord location, Ord term, Ord value)
+type Cacheable term address cell value = (Ord (cell value), Ord address, Ord term, Ord value)
 
 -- | Look up the resulting value & 'Heap' for a given 'Configuration'.
-cacheLookup :: Cacheable term location cell value => Configuration term location cell value -> Cache term location cell value -> Maybe (Set (Cached location cell value))
+cacheLookup :: Cacheable term address cell value => Configuration term address cell value -> Cache term address cell value -> Maybe (Set (Cached address cell value))
 cacheLookup key = Monoidal.lookup key . unCache
 
 -- | Set the resulting value & 'Heap' for a given 'Configuration', overwriting any previous entry.
-cacheSet :: Cacheable term location cell value => Configuration term location cell value -> Set (Cached location cell value) -> Cache term location cell value -> Cache term location cell value
+cacheSet :: Cacheable term address cell value => Configuration term address cell value -> Set (Cached address cell value) -> Cache term address cell value -> Cache term address cell value
 cacheSet key value = Cache . Monoidal.insert key value . unCache
 
 -- | Insert the resulting value & 'Heap' for a given 'Configuration', appending onto any previous entry.
-cacheInsert :: Cacheable term location cell value => Configuration term location cell value -> Cached location cell value -> Cache term location cell value -> Cache term location cell value
+cacheInsert :: Cacheable term address cell value => Configuration term address cell value -> Cached address cell value -> Cache term address cell value -> Cache term address cell value
 cacheInsert = curry cons
 
 
-instance (Show term, Show location, Show (cell value), Show value) => Show (Cache term location cell value) where
+instance (Show term, Show address, Show (cell value), Show value) => Show (Cache term address cell value) where
   showsPrec d = showsUnaryWith showsPrec "Cache" d . map (second toList) . Monoidal.pairs . unCache

src/Data/Abstract/Configuration.hs

@@ -5,10 +5,10 @@ import Data.Abstract.Heap
 import Data.Abstract.Live
 
 -- | A single point in a program’s execution.
-data Configuration term location cell value = Configuration
+data Configuration term address cell value = Configuration
   { configurationTerm        :: term                    -- ^ The “instruction,” i.e. the current term to evaluate.
-  , configurationRoots       :: Live location value        -- ^ The set of rooted addresses.
-  , configurationEnvironment :: Environment location value -- ^ The environment binding any free variables in 'configurationTerm'.
-  , configurationHeap        :: Heap location cell value   -- ^ The heap of values.
+  , configurationRoots       :: Live address            -- ^ The set of rooted addresses.
+  , configurationEnvironment :: Environment address     -- ^ The environment binding any free variables in 'configurationTerm'.
+  , configurationHeap        :: Heap address cell value -- ^ The heap of values.
   }
   deriving (Eq, Ord, Show)

src/Data/Abstract/Declarations.hs

@@ -2,6 +2,7 @@
 module Data.Abstract.Declarations  where
 
 import Data.Abstract.FreeVariables
+import Data.Abstract.Name
 import Data.Sum
 import Data.Term
 import Prologue

src/Data/Abstract/Environment.hs

@@ -1,7 +1,7 @@
 module Data.Abstract.Environment
   ( Environment(..)
   , addresses
-  , bind
+  , intersect
   , delete
   , head
   , emptyEnv
@@ -18,9 +18,8 @@ module Data.Abstract.Environment
   , roots
   ) where
 
-import           Data.Abstract.Address
-import           Data.Abstract.FreeVariables
 import           Data.Abstract.Live
+import           Data.Abstract.Name
 import           Data.Align
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Map as Map
@@ -29,42 +28,39 @@ import           Prelude hiding (head, lookup)
 import           Prologue
 
 -- $setup
--- >>> let bright = push (insert (name "foo") (Address (Precise 0)) emptyEnv)
--- >>> let shadowed = insert (name "foo") (Address (Precise 1)) bright
+-- >>> import Data.Abstract.Address
+-- >>> let bright = push (insert (name "foo") (Precise 0) emptyEnv)
+-- >>> let shadowed = insert (name "foo") (Precise 1) bright
 
 -- | A LIFO stack of maps of names to addresses, representing a lexically-scoped evaluation environment.
 --   All behaviors can be assumed to be frontmost-biased: looking up "a" will check the most specific
 --   scope for "a", then the next, and so on.
-newtype Environment location value = Environment { unEnvironment :: NonEmpty (Map.Map Name (Address location value)) }
+newtype Environment address = Environment { unEnvironment :: NonEmpty (Map.Map Name address) }
   deriving (Eq, Ord)
 
-instance Eq location   => Eq1   (Environment location) where liftEq      eq      (Environment a) (Environment b) = liftEq      (liftEq      (liftEq      eq))      a b
-instance Ord location  => Ord1  (Environment location) where liftCompare compare (Environment a) (Environment b) = liftCompare (liftCompare (liftCompare compare)) a b
-instance Show location => Show1 (Environment location) where liftShowsPrec _ _ = showsPrec
-
-mergeEnvs :: Environment location value -> Environment location value -> Environment location value
+mergeEnvs :: Environment address -> Environment address -> Environment address
 mergeEnvs (Environment (a :| as)) (Environment (b :| bs)) =
   Environment ((<>) a b :| alignWith (mergeThese (<>)) as bs)
 
-emptyEnv :: Environment location value
+emptyEnv :: Environment address
 emptyEnv = Environment (lowerBound :| [])
 
 -- | Make and enter a new empty scope in the given environment.
-push :: Environment location value -> Environment location value
+push :: Environment address -> Environment address
 push (Environment (a :| as)) = Environment (mempty :| a : as)
 
 -- | Remove the frontmost scope.
-pop :: Environment location value -> Environment location value
+pop :: Environment address -> Environment address
 pop (Environment (_ :| []))     = emptyEnv
 pop (Environment (_ :| a : as)) = Environment (a :| as)
 
 -- | Drop all scopes save for the frontmost one.
-head :: Environment location value -> Environment location value
+head :: Environment address -> Environment address
 head (Environment (a :| _)) = Environment (a :| [])
 
 -- | Take the union of two environments. When duplicate keys are found in the
 --   name to address map, the second definition wins.
-mergeNewer :: Environment location value -> Environment location value -> Environment location value
+mergeNewer :: Environment address -> Environment address -> Environment address
 mergeNewer (Environment a) (Environment b) =
     Environment (NonEmpty.fromList . reverse $ alignWith (mergeThese combine) (reverse as) (reverse bs))
     where
@@ -76,45 +72,45 @@ mergeNewer (Environment a) (Environment b) =
 --
 -- >>> pairs shadowed
 -- [("foo",Precise 1)]
-pairs :: Environment location value -> [(Name, Address location value)]
+pairs :: Environment address -> [(Name, address)]
 pairs = Map.toList . fold . unEnvironment
 
-unpairs :: [(Name, Address location value)] -> Environment location value
+unpairs :: [(Name, address)] -> Environment address
 unpairs = Environment . pure . Map.fromList
 
 -- | Lookup a 'Name' in the environment.
 --
 -- >>> lookup (name "foo") shadowed
 -- Just (Precise 1)
-lookup :: Name -> Environment location value -> Maybe (Address location value)
-lookup k = foldMapA (Map.lookup k) . unEnvironment
+lookup :: Name -> Environment address -> Maybe address
+lookup name = foldMapA (Map.lookup name) . unEnvironment
 
 -- | Insert a 'Name' in the environment.
-insert :: Name -> Address location value -> Environment location value -> Environment location value
-insert name address (Environment (a :| as)) = Environment (Map.insert name address a :| as)
+insert :: Name -> address -> Environment address -> Environment address
+insert name addr (Environment (a :| as)) = Environment (Map.insert name addr a :| as)
 
 -- | Remove a 'Name' from the environment.
 --
 -- >>> delete (name "foo") shadowed
 -- Environment []
-delete :: Name -> Environment location value -> Environment location value
+delete :: Name -> Environment address -> Environment address
 delete name = trim . Environment . fmap (Map.delete name) . unEnvironment
 
-trim :: Environment location value -> Environment location value
+trim :: Environment address -> Environment address
 trim (Environment (a :| as)) = Environment (a :| filtered)
   where filtered = filter (not . Map.null) as
 
-bind :: Foldable t => t Name -> Environment location value -> Environment location value
-bind names env = unpairs (mapMaybe lookupName (toList names))
+intersect :: Foldable t => t Name -> Environment address -> Environment address
+intersect names env = unpairs (mapMaybe lookupName (toList names))
   where
     lookupName name = (,) name <$> lookup name env
 
 -- | Get all bound 'Name's in an environment.
-names :: Environment location value -> [Name]
+names :: Environment address -> [Name]
 names = fmap fst . pairs
 
 -- | Lookup and alias name-value bindings from an environment.
-overwrite :: [(Name, Name)] -> Environment location value -> Environment location value
+overwrite :: [(Name, Name)] -> Environment address -> Environment address
 overwrite pairs env = unpairs $ mapMaybe lookupAndAlias pairs
   where
     lookupAndAlias (oldName, newName) = (,) newName <$> lookup oldName env
@@ -122,14 +118,14 @@ overwrite pairs env = unpairs $ mapMaybe lookupAndAlias pairs
 -- | Retrieve the 'Live' set of addresses to which the given free variable names are bound.
 --
 --   Unbound names are silently dropped.
-roots :: (Ord location, Foldable t) => Environment location value -> t Name -> Live location value
-roots env = foldMap (maybe mempty liveSingleton . flip lookup env)
+roots :: (Ord address, Foldable t) => Environment address -> t Name -> Live address
+roots env names = addresses (names `intersect` env)
 
-addresses :: Ord location => Environment location value -> Live location value
+addresses :: Ord address => Environment address -> Live address
 addresses = fromAddresses . map snd . pairs
 
 
-instance Lower (Environment location value) where lowerBound = emptyEnv
+instance Lower (Environment address) where lowerBound = emptyEnv
 
-instance Show location => Show (Environment location value) where
-  showsPrec d = showsUnaryWith showsPrec "Environment" d . map (first unName) . pairs
+instance Show address => Show (Environment address) where
+  showsPrec d = showsUnaryWith showsPrec "Environment" d . pairs

src/Data/Abstract/Evaluatable.hs

@@ -1,37 +1,38 @@
-{-# LANGUAGE ConstraintKinds, DefaultSignatures, GADTs, GeneralizedNewtypeDeriving, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE ConstraintKinds, DefaultSignatures, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
 module Data.Abstract.Evaluatable
 ( module X
 , Evaluatable(..)
+, evaluatePackageWith
+, isolate
+, traceResolve
+-- | Effects
+, EvalError(..)
+, throwEvalError
+, runEvalError
+, runEvalErrorWith
 , Unspecialized(..)
 , runUnspecialized
 , runUnspecializedWith
-, EvalError(..)
-, runEvalError
-, runEvalErrorWith
-, value
-, subtermValue
-, evaluateInScopedEnv
-, evaluatePackageWith
-, throwEvalError
-, traceResolve
-, builtin
-, isolate
-, Modules
+, Cell
 ) where
 
-import Control.Abstract as X hiding (Goto(..), LoopControl(..), Modules(..), Return(..), TermEvaluator(..))
-import Control.Abstract.Evaluator (LoopControl, Return(..))
-import Control.Abstract.Goto (Goto(..))
-import Control.Abstract.Modules (Modules(..))
-import Control.Abstract.TermEvaluator (TermEvaluator(..))
+import Control.Abstract
+import Control.Abstract.Context as X
+import Control.Abstract.Environment as X hiding (runEnvironmentError, runEnvironmentErrorWith)
+import Control.Abstract.Evaluator as X hiding (LoopControl(..), Return(..), catchLoopControl, runLoopControl, catchReturn, runReturn)
+import Control.Abstract.Exports as X
+import Control.Abstract.Heap as X hiding (AddressError(..), runAddressError, runAddressErrorWith)
+import Control.Abstract.Modules as X (Modules, ResolutionError(..), load, lookupModule, listModulesInDir, require, resolve)
+import Control.Abstract.Value as X
 import Data.Abstract.Declarations as X
 import Data.Abstract.Environment as X
 import Data.Abstract.Exports as Exports
 import Data.Abstract.FreeVariables as X
 import Data.Abstract.Module
 import Data.Abstract.ModuleTable as ModuleTable
+import Data.Abstract.Name as X
 import Data.Abstract.Package as Package
-import Data.ByteString.Char8 (pack, unpack)
+import Data.Abstract.Ref as X
 import Data.Scientific (Scientific)
 import Data.Semigroup.App
 import Data.Semigroup.Foldable
@@ -43,137 +44,169 @@ import Prologue
 
 -- | The 'Evaluatable' class defines the necessary interface for a term to be evaluated. While a default definition of 'eval' is given, instances with computational content must implement 'eval' to perform their small-step operational semantics.
 class Evaluatable constr where
-  eval :: ( EvaluatableConstraints location term value effects
+  eval :: ( EvaluatableConstraints address term value effects
           , Member Fail effects
           )
-       => SubtermAlgebra constr term (Evaluator location value effects (ValueRef value))
-  default eval :: (Member (Resumable (Unspecialized value)) effects, Show1 constr) => SubtermAlgebra constr term (Evaluator location value effects (ValueRef value))
+       => SubtermAlgebra constr term (Evaluator address value effects (ValueRef value))
+  default eval :: (Member (Resumable (Unspecialized value)) effects, Show1 constr) => SubtermAlgebra constr term (Evaluator address value effects (ValueRef value))
   eval expr = throwResumable (Unspecialized ("Eval unspecialized for " ++ liftShowsPrec (const (const id)) (const id) 0 expr ""))
 
-type EvaluatableConstraints location term value effects =
-  ( AbstractValue location value effects
+type EvaluatableConstraints address term value effects =
+  ( AbstractValue address value effects
   , Declarations term
   , FreeVariables term
-  , Members '[ Allocator location value
-             , LoopControl value
-             , Modules location value
-             , Reader (Environment location value)
-             , Reader ModuleInfo
-             , Reader PackageInfo
-             , Reader Span
-             , Resumable (EnvironmentError value)
-             , Resumable (EvalError value)
-             , Resumable ResolutionError
-             , Resumable (Unspecialized value)
-             , Return value
-             , State (Environment location value)
-             , State (Exports location value)
-             , State (Heap location (Cell location) value)
-             , Trace
-             ] effects
-  , Ord location
-  , Reducer value (Cell location value)
+  , Member (Allocator address value) effects
+  , Member (LoopControl value) effects
+  , Member (Modules address value) effects
+  , Member (Reader (Environment address)) effects
+  , Member (Reader ModuleInfo) effects
+  , Member (Reader PackageInfo) effects
+  , Member (Reader Span) effects
+  , Member (Resumable (EnvironmentError address)) effects
+  , Member (Resumable EvalError) effects
+  , Member (Resumable ResolutionError) effects
+  , Member (Resumable (Unspecialized value)) effects
+  , Member (Return value) effects
+  , Member (State (Environment address)) effects
+  , Member (State (Exports address)) effects
+  , Member (State (Heap address (Cell address) value)) effects
+  , Member Trace effects
+  , Ord address
+  , Reducer value (Cell address value)
   )
 
 
+-- | Evaluate a given package.
+evaluatePackageWith :: forall address term value inner outer
+                    -- FIXME: It’d be nice if we didn’t have to mention 'Addressable' here at all, but 'Located' addresses require knowledge of 'currentModule' to run. Can we fix that? If not, can we factor this effect list out?
+                    .  ( Addressable address (Reader ModuleInfo ': Modules address value ': Reader Span ': Reader PackageInfo ': outer)
+                       , Evaluatable (Base term)
+                       , EvaluatableConstraints address term value inner
+                       , Member Fail outer
+                       , Member Fresh outer
+                       , Member (Reader (Environment address)) outer
+                       , Member (Resumable (AddressError address value)) outer
+                       , Member (Resumable (LoadError address value)) outer
+                       , Member (State (Environment address)) outer
+                       , Member (State (Exports address)) outer
+                       , Member (State (Heap address (Cell address) value)) outer
+                       , Member (State (ModuleTable (Maybe (Environment address, value)))) outer
+                       , Member Trace outer
+                       , Recursive term
+                       , inner ~ (LoopControl value ': Return value ': Allocator address value ': Reader ModuleInfo ': Modules address value ': Reader Span ': Reader PackageInfo ': outer)
+                       )
+                    => (SubtermAlgebra Module      term (TermEvaluator term address value inner value)            -> SubtermAlgebra Module      term (TermEvaluator term address value inner value))
+                    -> (SubtermAlgebra (Base term) term (TermEvaluator term address value inner (ValueRef value)) -> SubtermAlgebra (Base term) term (TermEvaluator term address value inner (ValueRef value)))
+                    -> Package term
+                    -> TermEvaluator term address value outer [value]
+evaluatePackageWith analyzeModule analyzeTerm package
+  = runReader (packageInfo package)
+  . runReader lowerBound
+  . runReader (packageModules (packageBody package))
+  . withPrelude (packagePrelude (packageBody package))
+  . raiseHandler (runModules (runTermEvaluator . evalModule))
+  $ traverse (uncurry evaluateEntryPoint) (ModuleTable.toPairs (packageEntryPoints (packageBody package)))
+  where
+        evalModule m
+          = pairValueWithEnv
+          . runInModule (moduleInfo m)
+          . analyzeModule (subtermRef . moduleBody)
+          $ evalTerm <$> m
+        evalTerm term = Subterm term (TermEvaluator (value =<< runTermEvaluator (foldSubterms (analyzeTerm (TermEvaluator . eval . fmap (second runTermEvaluator))) term)))
+
+        runInModule info
+          = runReader info
+          . raiseHandler runAllocator
+          . raiseHandler runReturn
+          . raiseHandler runLoopControl
+
+        evaluateEntryPoint :: ModulePath -> Maybe Name -> TermEvaluator term address value (Modules address value ': Reader Span ': Reader PackageInfo ': outer) value
+        evaluateEntryPoint m sym = runInModule (ModuleInfo m) . TermEvaluator $ do
+          v <- maybe unit snd <$> require m
+          maybe (pure v) ((`call` []) <=< variable) sym
+
+        evalPrelude prelude = raiseHandler (runModules (runTermEvaluator . evalModule)) $ do
+          _ <- runInModule moduleInfoFromCallStack (TermEvaluator (defineBuiltins $> unit))
+          fst <$> evalModule prelude
+
+        withPrelude Nothing a = a
+        withPrelude (Just prelude) a = do
+          preludeEnv <- evalPrelude prelude
+          raiseHandler (withDefaultEnvironment preludeEnv) a
+
+        -- TODO: If the set of exports is empty because no exports have been
+        -- defined, do we export all terms, or no terms? This behavior varies across
+        -- languages. We need better semantics rather than doing it ad-hoc.
+        filterEnv ports env
+          | Exports.null ports = env
+          | otherwise          = Exports.toEnvironment ports `mergeEnvs` overwrite (Exports.aliases ports) env
+        pairValueWithEnv action = flip (,) <$> action <*> (filterEnv <$> TermEvaluator getExports <*> TermEvaluator getEnv)
+
+
+-- | Isolate the given action with an empty global environment and exports.
+isolate :: (Member (State (Environment address)) effects, Member (State (Exports address)) effects) => Evaluator address value effects a -> Evaluator address value effects a
+isolate = withEnv lowerBound . withExports lowerBound
+
+traceResolve :: (Show a, Show b, Member Trace effects) => a -> b -> Evaluator address value effects ()
+traceResolve name path = trace ("resolved " <> show name <> " -> " <> show path)
+
+
+-- Effects
+
 -- | The type of error thrown when failing to evaluate a term.
-data EvalError value resume where
-  FreeVariablesError :: [Name] -> EvalError value Name
+data EvalError return where
+  FreeVariablesError :: [Name] -> EvalError Name
   -- Indicates that our evaluator wasn't able to make sense of these literals.
-  IntegerFormatError  :: ByteString -> EvalError value Integer
-  FloatFormatError    :: ByteString -> EvalError value Scientific
-  RationalFormatError :: ByteString -> EvalError value Rational
-  DefaultExportError  :: EvalError value ()
-  ExportError         :: ModulePath -> Name -> EvalError value ()
-  EnvironmentLookupError :: value -> EvalError value value
+  IntegerFormatError  :: ByteString -> EvalError Integer
+  FloatFormatError    :: ByteString -> EvalError Scientific
+  RationalFormatError :: ByteString -> EvalError Rational
+  DefaultExportError  :: EvalError ()
+  ExportError         :: ModulePath -> Name -> EvalError ()
 
-runEvalError :: Effectful (m value) => m value (Resumable (EvalError value) ': effects) a -> m value effects (Either (SomeExc (EvalError value)) a)
-runEvalError = runResumable
+deriving instance Eq (EvalError return)
+deriving instance Show (EvalError return)
 
-runEvalErrorWith :: Effectful (m value) => (forall resume . EvalError value resume -> m value effects resume) -> m value (Resumable (EvalError value) ': effects) a -> m value effects a
-runEvalErrorWith = runResumableWith
-
--- | Evaluate a term within the context of the scoped environment of 'scopedEnvTerm'.
---   Throws an 'EnvironmentLookupError' if @scopedEnvTerm@ does not have an environment.
-evaluateInScopedEnv :: ( AbstractValue location value effects
-                       , Members '[ Resumable (EvalError value)
-                                  , State (Environment location value)
-                                  ] effects
-                       )
-                    => Evaluator location value effects value
-                    -> Evaluator location value effects value
-                    -> Evaluator location value effects value
-evaluateInScopedEnv scopedEnvTerm term = do
-  value <- scopedEnvTerm
-  scopedEnv <- scopedEnvironment value
-  maybe (throwEvalError (EnvironmentLookupError value)) (flip localEnv term . mergeEnvs) scopedEnv
-
-deriving instance Eq a => Eq (EvalError a b)
-deriving instance Show a => Show (EvalError a b)
-instance Show value => Show1 (EvalError value) where
-  liftShowsPrec _ _ = showsPrec
-instance Eq term => Eq1 (EvalError term) where
+instance Eq1 EvalError where
   liftEq _ (FreeVariablesError a) (FreeVariablesError b)   = a == b
   liftEq _ DefaultExportError DefaultExportError           = True
   liftEq _ (ExportError a b) (ExportError c d)             = (a == c) && (b == d)
   liftEq _ (IntegerFormatError a) (IntegerFormatError b)   = a == b
   liftEq _ (FloatFormatError a) (FloatFormatError b)       = a == b
   liftEq _ (RationalFormatError a) (RationalFormatError b) = a == b
-  liftEq _ (EnvironmentLookupError a) (EnvironmentLookupError b) = a == b
   liftEq _ _ _                                             = False
 
+instance Show1 EvalError where
+  liftShowsPrec _ _ = showsPrec
 
-throwEvalError :: Member (Resumable (EvalError value)) effects => EvalError value resume -> Evaluator location value effects resume
+throwEvalError :: (Effectful m, Member (Resumable EvalError) effects) => EvalError resume -> m effects resume
 throwEvalError = throwResumable
 
+runEvalError :: Effectful m => m (Resumable EvalError ': effects) a -> m effects (Either (SomeExc EvalError) a)
+runEvalError = runResumable
+
+runEvalErrorWith :: Effectful m => (forall resume . EvalError resume -> m effects resume) -> m (Resumable EvalError ': effects) a -> m effects a
+runEvalErrorWith = runResumableWith
+
 
 data Unspecialized a b where
-  Unspecialized :: Prelude.String -> Unspecialized value (ValueRef value)
+  Unspecialized :: String -> Unspecialized value (ValueRef value)
+
+deriving instance Eq (Unspecialized a b)
+deriving instance Show (Unspecialized a b)
 
 instance Eq1 (Unspecialized a) where
   liftEq _ (Unspecialized a) (Unspecialized b) = a == b
 
-deriving instance Eq (Unspecialized a b)
-deriving instance Show (Unspecialized a b)
 instance Show1 (Unspecialized a) where
   liftShowsPrec _ _ = showsPrec
 
--- | Evaluates a 'Value' returning the referenced value
-value :: ( AbstractValue location value effects
-         , Members '[ Allocator location value
-                    , Reader (Environment location value)
-                    , Resumable (EnvironmentError value)
-                    , Resumable (EvalError value)
-                    , State (Environment location value)
-                    , State (Heap location (Cell location) value)
-                    ] effects
-         )
-      => ValueRef value
-      -> Evaluator location value effects value
-value (LvalLocal var) = variable var
-value (LvalMember obj prop) = evaluateInScopedEnv (pure obj) (variable prop)
-value (Rval val) = pure val
-
--- | Evaluates a 'Subterm' to its rval
-subtermValue :: ( AbstractValue location value effects
-                , Members '[ Allocator location value
-                           , Reader (Environment location value)
-                           , Resumable (EnvironmentError value)
-                           , Resumable (EvalError value)
-                           , State (Environment location value)
-                           , State (Heap location (Cell location) value)
-                           ] effects
-                )
-             => Subterm term (Evaluator location value effects (ValueRef value))
-             -> Evaluator location value effects value
-subtermValue = value <=< subtermRef
-
 runUnspecialized :: Effectful (m value) => m value (Resumable (Unspecialized value) ': effects) a -> m value effects (Either (SomeExc (Unspecialized value)) a)
 runUnspecialized = runResumable
 
 runUnspecializedWith :: Effectful (m value) => (forall resume . Unspecialized value resume -> m value effects resume) -> m value (Resumable (Unspecialized value) ': effects) a -> m value effects a
 runUnspecializedWith = runResumableWith
 
+
 -- Instances
 
 -- | If we can evaluate any syntax which can occur in a 'Sum', we can evaluate the 'Sum'.
@@ -191,110 +224,4 @@ instance Evaluatable s => Evaluatable (TermF s a) where
 ---   3. Only the last statement’s return value is returned.
 instance Evaluatable [] where
   -- 'nonEmpty' and 'foldMap1' enable us to return the last statement’s result instead of 'unit' for non-empty lists.
-  eval = maybe (Rval <$> unit) (runApp . foldMap1 (App . subtermRef)) . nonEmpty
-
-
-traceResolve :: (Show a, Show b, Member Trace effects) => a -> b -> Evaluator location value effects ()
-traceResolve name path = trace ("resolved " <> show name <> " -> " <> show path)
-
-
-builtin :: ( HasCallStack
-           , Members '[ Allocator location value
-                      , Reader (Environment location value)
-                      , Reader ModuleInfo
-                      , Reader Span
-                      , State (Environment location value)
-                      , State (Heap location (Cell location) value)
-                      ] effects
-           , Ord location
-           , Reducer value (Cell location value)
-           )
-        => String
-        -> Evaluator location value effects value
-        -> Evaluator location value effects ()
-builtin n def = withCurrentCallStack callStack $ do
-  let name = X.name ("__semantic_" <> pack n)
-  addr <- alloc name
-  modifyEnv (X.insert name addr)
-  def >>= assign addr
-
--- | Evaluate a given package.
-evaluatePackageWith :: forall location term value inner inner' outer
-                    -- FIXME: It’d be nice if we didn’t have to mention 'Addressable' here at all, but 'Located' locations require knowledge of 'currentModule' to run. Can we fix that? If not, can we factor this effect list out?
-                    .  ( Addressable location (Reader ModuleInfo ': Modules location value ': State (Gotos location value (Reader Span ': Reader PackageInfo ': outer)) ': Reader Span ': Reader PackageInfo ': outer)
-                       , Evaluatable (Base term)
-                       , EvaluatableConstraints location term value inner
-                       , Members '[ Fail
-                                  , Fresh
-                                  , Reader (Environment location value)
-                                  , Resumable (AddressError location value)
-                                  , Resumable (LoadError location value)
-                                  , State (Environment location value)
-                                  , State (Exports location value)
-                                  , State (Heap location (Cell location) value)
-                                  , State (ModuleTable (Maybe (Environment location value, value)))
-                                  , Trace
-                                  ] outer
-                       , Recursive term
-                       , inner ~ (Goto inner' value ': inner')
-                       , inner' ~ (LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': State (Gotos location value (Reader Span ': Reader PackageInfo ': outer)) ': Reader Span ': Reader PackageInfo ': outer)
-                       )
-                    => (SubtermAlgebra Module      term (TermEvaluator term location value inner value) -> SubtermAlgebra Module      term (TermEvaluator term location value inner value))
-                    -> (SubtermAlgebra (Base term) term (TermEvaluator term location value inner (ValueRef value)) -> SubtermAlgebra (Base term) term (TermEvaluator term location value inner (ValueRef value)))
-                    -> Package term
-                    -> TermEvaluator term location value outer [value]
-evaluatePackageWith analyzeModule analyzeTerm package
-  = runReader (packageInfo package)
-  . runReader lowerBound
-  . fmap fst
-  . runState (lowerBound :: Gotos location value (Reader Span ': Reader PackageInfo ': outer))
-  . runReader (packageModules (packageBody package))
-  . withPrelude (packagePrelude (packageBody package))
-  . raiseHandler (runModules (runTermEvaluator . evalModule))
-  $ traverse (uncurry evaluateEntryPoint) (ModuleTable.toPairs (packageEntryPoints (packageBody package)))
-  where
-        evalModule m
-          = pairValueWithEnv
-          . runInModule (moduleInfo m)
-          . analyzeModule (subtermRef . moduleBody)
-          $ evalTerm <$> m
-        evalTerm term = Subterm term (TermEvaluator (value =<< runTermEvaluator (foldSubterms (analyzeTerm (TermEvaluator . eval . fmap (second runTermEvaluator))) term)))
-
-        runInModule info
-          = runReader info
-          . raiseHandler runAllocator
-          . raiseHandler runReturn
-          . raiseHandler runLoopControl
-          . raiseHandler (runGoto Gotos getGotos)
-
-        evaluateEntryPoint :: ModulePath -> Maybe Name -> TermEvaluator term location value (Modules location value ': State (Gotos location value (Reader Span ': Reader PackageInfo ': outer)) ': Reader Span ': Reader PackageInfo ': outer) value
-        evaluateEntryPoint m sym = runInModule (ModuleInfo m) . TermEvaluator $ do
-          v <- maybe unit (pure . snd) <$> require m
-          maybe v ((`call` []) <=< variable) sym
-
-        evalPrelude prelude = raiseHandler (runModules (runTermEvaluator . evalModule)) $ do
-          _ <- runInModule moduleInfoFromCallStack . TermEvaluator $ do
-            builtin "print" (closure ["s"] lowerBound (variable "s" >>= asString >>= trace . unpack >> unit))
-            unit
-          fst <$> evalModule prelude
-
-        withPrelude Nothing a = a
-        withPrelude (Just prelude) a = do
-          preludeEnv <- evalPrelude prelude
-          raiseHandler (withDefaultEnvironment preludeEnv) a
-
-        -- TODO: If the set of exports is empty because no exports have been
-        -- defined, do we export all terms, or no terms? This behavior varies across
-        -- languages. We need better semantics rather than doing it ad-hoc.
-        filterEnv ports env
-          | Exports.null ports = env
-          | otherwise          = Exports.toEnvironment ports `mergeEnvs` overwrite (Exports.aliases ports) env
-        pairValueWithEnv action = flip (,) <$> action <*> (filterEnv <$> TermEvaluator getExports <*> TermEvaluator getEnv)
-
-newtype Gotos location value outer = Gotos { getGotos :: GotoTable (LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': State (Gotos location value outer) ': outer) value }
-  deriving (Lower)
-
-
--- | Isolate the given action with an empty global environment and exports.
-isolate :: Members '[State (Environment location value), State (Exports location value)] effects => Evaluator location value effects a -> Evaluator location value effects a
-isolate = withEnv lowerBound . withExports lowerBound
+  eval = maybe (pure (Rval unit)) (runApp . foldMap1 (App . subtermRef)) . nonEmpty

src/Data/Abstract/Exports.hs

@@ -7,34 +7,30 @@ module Data.Abstract.Exports
     , toEnvironment
     ) where
 
-import Prelude hiding (null)
-import Prologue hiding (null)
-import Data.Abstract.Address
 import Data.Abstract.Environment (Environment, unpairs)
-import Data.Abstract.FreeVariables
+import Data.Abstract.Name
 import qualified Data.Map as Map
 import Data.Semilattice.Lower
+import Prelude hiding (null)
+import Prologue hiding (null)
 
 -- | A map of export names to an alias & address tuple.
-newtype Exports location value = Exports { unExports :: Map.Map Name (Name, Maybe (Address location value)) }
+newtype Exports address = Exports { unExports :: Map.Map Name (Name, Maybe address) }
   deriving (Eq, Lower, Monoid, Ord, Semigroup)
 
-null :: Exports location value -> Bool
+null :: Exports address -> Bool
 null = Map.null . unExports
 
-toEnvironment :: Exports location value -> Environment location value
-toEnvironment exports = unpairs (mapMaybe collectExport (toList (unExports exports)))
-  where
-    collectExport (_, Nothing) = Nothing
-    collectExport (n, Just value)  = Just (n, value)
+toEnvironment :: Exports address -> Environment address
+toEnvironment exports = unpairs (mapMaybe sequenceA (toList (unExports exports)))
 
-insert :: Name -> Name -> Maybe (Address location value) -> Exports location value -> Exports location value
+insert :: Name -> Name -> Maybe address -> Exports address -> Exports address
 insert name alias address = Exports . Map.insert name (alias, address) . unExports
 
 -- TODO: Should we filter for duplicates here?
-aliases :: Exports location value -> [(Name, Name)]
+aliases :: Exports address -> [(Name, Name)]
 aliases = Map.toList . fmap fst . unExports
 
 
-instance Show location => Show (Exports location value) where
+instance Show address => Show (Exports address) where
   showsPrec d = showsUnaryWith showsPrec "Exports" d . Map.toList . unExports

src/Data/Abstract/FreeVariables.hs

@@ -1,25 +1,11 @@
 {-# LANGUAGE DefaultSignatures, GeneralizedNewtypeDeriving, UndecidableInstances #-}
 module Data.Abstract.FreeVariables where
 
-import qualified Data.ByteString.Char8 as BC
-import           Data.String
+import Data.Abstract.Name
 import           Data.Sum
 import           Data.Term
 import           Prologue
 
--- | The type of variable names.
-newtype Name = Name { unName :: ByteString }
-  deriving (Eq, Hashable, Ord)
-
-name :: ByteString -> Name
-name = Name
-
-instance IsString Name where
-  fromString = Name . BC.pack
-
-instance Show Name where showsPrec d (Name str) = showsPrec d str
-
-
 -- | Types which can contain unbound variables.
 class FreeVariables term where
   -- | The set of free variables in the given value.

src/Data/Abstract/Heap.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Data.Abstract.Heap where
 
-import Data.Abstract.Address
 import Data.Abstract.Live
 import qualified Data.Map.Monoidal as Monoidal
 import Data.Semigroup.Reducer
@@ -9,38 +8,38 @@ import Data.Semilattice.Lower
 import Prologue
 
 -- | A map of addresses onto cells holding their values.
-newtype Heap location cell value = Heap { unHeap :: Monoidal.Map location (cell value) }
+newtype Heap address cell value = Heap { unHeap :: Monoidal.Map address (cell value) }
   deriving (Eq, Foldable, Functor, Lower, Monoid, Ord, Semigroup, Traversable)
 
 -- | Look up the cell of values for an 'Address' in a 'Heap', if any.
-heapLookup :: Ord location => Address location value -> Heap location cell value -> Maybe (cell value)
-heapLookup (Address address) = Monoidal.lookup address . unHeap
+heapLookup :: Ord address => address -> Heap address cell value -> Maybe (cell value)
+heapLookup address = Monoidal.lookup address . unHeap
 
 -- | Look up the list of values stored for a given address, if any.
-heapLookupAll :: (Ord location, Foldable cell) => Address location value -> Heap location cell value -> Maybe [value]
+heapLookupAll :: (Ord address, Foldable cell) => address -> Heap address cell value -> Maybe [value]
 heapLookupAll address = fmap toList . heapLookup address
 
 -- | Append a value onto the cell for a given address, inserting a new cell if none existed.
-heapInsert :: (Ord location, Reducer value (cell value)) => Address location value -> value -> Heap location cell value -> Heap location cell value
+heapInsert :: (Ord address, Reducer value (cell value)) => address -> value -> Heap address cell value -> Heap address cell value
 heapInsert address value = flip snoc (address, value)
 
 -- | Manually insert a cell into the heap at a given address.
-heapInit :: Ord location => Address location value -> cell value -> Heap location cell value -> Heap location cell value
-heapInit (Address address) cell (Heap h) = Heap (Monoidal.insert address cell h)
+heapInit :: Ord address => address -> cell value -> Heap address cell value -> Heap address cell value
+heapInit address cell (Heap h) = Heap (Monoidal.insert address cell h)
 
 -- | The number of addresses extant in a 'Heap'.
-heapSize :: Heap location cell value -> Int
+heapSize :: Heap address cell value -> Int
 heapSize = Monoidal.size . unHeap
 
--- | Restrict a 'Heap' to only those 'Address'es in the given 'Live' set (in essence garbage collecting the rest).
-heapRestrict :: Ord location => Heap location cell value -> Live location value -> Heap location cell value
-heapRestrict (Heap m) roots = Heap (Monoidal.filterWithKey (\ address _ -> Address address `liveMember` roots) m)
+-- | Restrict a 'Heap' to only those addresses in the given 'Live' set (in essence garbage collecting the rest).
+heapRestrict :: Ord address => Heap address cell value -> Live address -> Heap address cell value
+heapRestrict (Heap m) roots = Heap (Monoidal.filterWithKey (\ address _ -> address `liveMember` roots) m)
 
 
-instance (Ord location, Reducer value (cell value)) => Reducer (Address location value, value) (Heap location cell value) where
-  unit = Heap . unit . first unAddress
-  cons (Address key, a) (Heap heap) = Heap (cons (key, a) heap)
-  snoc (Heap heap) (Address key, a) = Heap (snoc heap (key, a))
+instance (Ord address, Reducer value (cell value)) => Reducer (address, value) (Heap address cell value) where
+  unit = Heap . unit
+  cons (addr, a) (Heap heap) = Heap (cons (addr, a) heap)
+  snoc (Heap heap) (addr, a) = Heap (snoc heap (addr, a))
 
-instance (Show location, Show (cell value)) => Show (Heap location cell value) where
+instance (Show address, Show (cell value)) => Show (Heap address cell value) where
   showsPrec d = showsUnaryWith showsPrec "Heap" d . Monoidal.pairs . unHeap

src/Data/Abstract/Live.hs

@@ -1,42 +1,41 @@
 {-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-}
 module Data.Abstract.Live where
 
-import Data.Abstract.Address
 import Data.Semilattice.Lower
 import Data.Set as Set
 import Prologue
 
 -- | A set of live addresses (whether roots or reachable).
-newtype Live location value = Live { unLive :: Set location }
+newtype Live address = Live { unLive :: Set address }
   deriving (Eq, Lower, Monoid, Ord, Semigroup)
 
-fromAddresses :: (Foldable t, Ord location) => t (Address location value) -> Live location value
+fromAddresses :: (Foldable t, Ord address) => t address -> Live address
 fromAddresses = Prologue.foldr liveInsert lowerBound
 
 -- | Construct a 'Live' set containing only the given address.
-liveSingleton :: Address location value -> Live location value
-liveSingleton = Live . Set.singleton . unAddress
+liveSingleton :: address -> Live address
+liveSingleton = Live . Set.singleton
 
 -- | Insert an address into a 'Live' set.
-liveInsert :: Ord location => Address location value -> Live location value -> Live location value
-liveInsert addr = Live . Set.insert (unAddress addr) . unLive
+liveInsert :: Ord address => address -> Live address -> Live address
+liveInsert addr = Live . Set.insert addr . unLive
 
 -- | Delete an address from a 'Live' set, if present.
-liveDelete :: Ord location => Address location value -> Live location value -> Live location value
-liveDelete addr = Live . Set.delete (unAddress addr) . unLive
+liveDelete :: Ord address => address -> Live address -> Live address
+liveDelete addr = Live . Set.delete addr . unLive
 
 -- | Compute the (asymmetric) difference of two 'Live' sets, i.e. delete every element of the second set from the first set.
-liveDifference :: Ord location => Live location value -> Live location value -> Live location value
+liveDifference :: Ord address => Live address -> Live address -> Live address
 liveDifference = fmap Live . (Set.difference `on` unLive)
 
--- | Test whether an 'Address' is in a 'Live' set.
-liveMember :: Ord location => Address location value -> Live location value -> Bool
-liveMember addr = Set.member (unAddress addr) . unLive
+-- | Test whether an address is in a 'Live' set.
+liveMember :: Ord address => address -> Live address -> Bool
+liveMember addr = Set.member addr . unLive
 
 -- | Decompose a 'Live' set into a pair of one member address and the remaining set, or 'Nothing' if empty.
-liveSplit :: Live location value -> Maybe (Address location value, Live location value)
-liveSplit = fmap (bimap Address Live) . Set.minView . unLive
+liveSplit :: Live address -> Maybe (address, Live address)
+liveSplit = fmap (fmap Live) . Set.minView . unLive
 
 
-instance Show location => Show (Live location value) where
+instance Show address => Show (Live address) where
   showsPrec d = showsUnaryWith showsPrec "Live" d . Set.toList . unLive

src/Data/Abstract/Name.hs

@@ -0,0 +1,55 @@
+module Data.Abstract.Name
+( Name
+-- * Constructors
+, name
+, nameI
+, unName
+) where
+
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.Char as Char
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
+import           Data.String
+import           Prologue
+
+-- | The type of variable names.
+data Name
+  = Name ByteString
+  | I Int
+  deriving (Eq, Ord)
+
+-- | Construct a 'Name' from a 'ByteString'.
+name :: ByteString -> Name
+name = Name
+
+-- | Construct a 'Name' from an 'Int'. This is suitable for automatic generation, e.g. using a Fresh effect, but should not be used for human-generated names.
+nameI :: Int -> Name
+nameI = I
+
+-- | Extract a human-readable 'ByteString' from a 'Name'.
+unName :: Name -> ByteString
+unName (Name name) = name
+unName (I i)       = Text.encodeUtf8 . Text.pack $ '_' : (alphabet !! a) : replicate n 'ʹ'
+  where alphabet = ['a'..'z']
+        (n, a) = i `divMod` length alphabet
+
+instance IsString Name where
+  fromString = Name . BC.pack
+
+-- $
+-- >>> I 0
+-- "_a"
+-- >>> I 26
+-- "_aʹ"
+instance Show Name where
+  showsPrec _ = prettyShowString . Text.unpack . Text.decodeUtf8 . unName
+    where prettyShowString str = showChar '"' . foldr ((.) . prettyChar) id str . showChar '"'
+          prettyChar c
+            | c `elem` ['\\', '\"'] = Char.showLitChar c
+            | Char.isPrint c        = showChar c
+            | otherwise             = Char.showLitChar c
+
+instance Hashable Name where
+  hashWithSalt salt (Name name) = hashWithSalt salt name
+  hashWithSalt salt (I i)       = salt `hashWithSalt` (1 :: Int) `hashWithSalt` i

src/Data/Abstract/Package.hs

@@ -1,10 +1,10 @@
 {-# LANGUAGE TupleSections #-}
 module Data.Abstract.Package where
 
-import Data.Abstract.FreeVariables
 import Data.Abstract.Module
 import Data.Abstract.ModuleTable as ModuleTable
 import qualified Data.Map as Map
+import Data.Abstract.Name
 
 type PackageName = Name
 

src/Data/Abstract/Ref.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE GADTs #-}
+module Data.Abstract.Ref where
+
+import Data.Abstract.Name
+
+-- | 'ValueRef' is the type subterms evaluate to and can represent either values directly ('Rval'), or references to values (lvals - such as local variables or object members)
+data ValueRef value where
+  -- | A value.
+  Rval       :: value -> ValueRef value
+  -- | A local variable. No environment is attached—it’s assumed that 'LvalLocal' will be evaluated in the same scope it was constructed in.
+  LvalLocal  :: Name -> ValueRef value
+  -- | An object member.
+  LvalMember :: value -> Name -> ValueRef value
+  deriving (Eq, Ord, Show)

src/Data/Abstract/Type.hs

@@ -9,7 +9,6 @@ module Data.Abstract.Type
 
 import Control.Abstract
 import Data.Abstract.Environment as Env
-import Data.Abstract.Evaluatable
 import Data.Semigroup.Foldable (foldMap1)
 import Data.Semigroup.Reducer (Reducer)
 import Prologue hiding (TypeError)
@@ -95,52 +94,71 @@ unify t1 t2
   | t1 == t2  = pure t2
   | otherwise = throwResumable (UnificationError t1 t2)
 
-instance Ord location => ValueRoots location Type where
+instance Ord address => ValueRoots address Type where
   valueRoots _ = mempty
 
 
 instance AbstractHole Type where
   hole = Hole
 
--- | Discard the value arguments (if any), constructing a 'Type' instead.
-instance ( Members '[ Allocator location Type
-                    , Fresh
-                    , NonDet
-                    , Reader (Environment location Type)
-                    , Resumable (AddressError location Type)
-                    , Resumable (EvalError Type)
-                    , Resumable TypeError
-                    , Return Type
-                    , State (Environment location Type)
-                    , State (Heap location (Cell location) Type)
-                    ] effects
-         , Ord location
-         , Reducer Type (Cell location Type)
+instance AbstractIntro Type where
+  unit       = Unit
+  integer _  = Int
+  boolean _  = Bool
+  string _   = String
+  float _    = Float
+  symbol _   = Symbol
+  rational _ = Rational
+  multiple   = zeroOrMoreProduct
+  hash       = Hash
+  kvPair k v = k :* v
+
+  null        = Null
+
+
+instance ( Member (Allocator address Type) effects
+         , Member Fresh effects
+         , Member (Resumable TypeError) effects
+         , Member (Return Type) effects
+         , Member (State (Environment address)) effects
+         , Member (State (Heap address (Cell address) Type)) effects
+         , Ord address
+         , Reducer Type (Cell address Type)
          )
-      => AbstractValue location Type effects where
+      => AbstractFunction address Type effects where
   closure names _ body = do
     (env, tvars) <- foldr (\ name rest -> do
       a <- alloc name
       tvar <- Var <$> fresh
       assign a tvar
       bimap (Env.insert name a) (tvar :) <$> rest) (pure (emptyEnv, [])) names
-    (zeroOrMoreProduct tvars :->) <$> localEnv (mergeEnvs env) (body `catchReturn` \ (Return value) -> pure value)
+    (zeroOrMoreProduct tvars :->) <$> locally (bindAll env *> body `catchReturn` \ (Return value) -> pure value)
 
-  unit       = pure Unit
-  integer _  = pure Int
-  boolean _  = pure Bool
-  string _   = pure String
-  float _    = pure Float
-  symbol _   = pure Symbol
-  rational _ = pure Rational
-  multiple   = pure . zeroOrMoreProduct
+  call op params = do
+    tvar <- fresh
+    paramTypes <- sequenceA params
+    let needed = zeroOrMoreProduct paramTypes :-> Var tvar
+    unified <- op `unify` needed
+    case unified of
+      _ :-> ret -> pure ret
+      gotten    -> throwResumable (UnificationError needed gotten)
+
+
+-- | Discard the value arguments (if any), constructing a 'Type' instead.
+instance ( Member (Allocator address Type) effects
+         , Member Fresh effects
+         , Member NonDet effects
+         , Member (Resumable TypeError) effects
+         , Member (Return Type) effects
+         , Member (State (Environment address)) effects
+         , Member (State (Heap address (Cell address) Type)) effects
+         , Ord address
+         , Reducer Type (Cell address Type)
+         )
+      => AbstractValue address Type effects where
   array fields = do
     var <- fresh
     Array <$> foldr (\ t1 -> (unify t1 =<<)) (pure (Var var)) fields
-  hash       = pure . Hash
-  kvPair k v = pure (k :* v)
-
-  null          = pure Null
 
   klass _ _ _   = pure Object
   namespace _ _ = pure Unit
@@ -152,9 +170,6 @@ instance ( Members '[ Allocator location Type
     t1 <- fresh
     t2 <- fresh
     unify t (Var t1 :* Var t2) $> (Var t1, Var t2)
-  asBool t   = unify t Bool *> (pure True <|> pure False)
-
-  isHole ty = pure (ty == Hole)
 
   index arr sub = do
     _ <- unify sub Int
@@ -181,13 +196,4 @@ instance ( Members '[ Allocator location Type
     (Int, Float) ->                     pure Int
     _                 -> unify left right $> Bool
 
-  call op params = do
-    tvar <- fresh
-    paramTypes <- sequenceA params
-    let needed = zeroOrMoreProduct paramTypes :-> Var tvar
-    unified <- op `unify` needed
-    case unified of
-      _ :-> ret -> pure ret
-      gotten    -> throwResumable (UnificationError needed gotten)
-
   loop f = f empty

src/Data/Abstract/Value.hs

@@ -4,333 +4,210 @@ module Data.Abstract.Value where
 import Control.Abstract
 import Data.Abstract.Environment (Environment, emptyEnv, mergeEnvs)
 import qualified Data.Abstract.Environment as Env
-import Data.Abstract.FreeVariables
+import Data.Abstract.Name
 import qualified Data.Abstract.Number as Number
+import Data.Coerce
 import Data.List (genericIndex, genericLength)
 import Data.Scientific (Scientific)
 import Data.Scientific.Exts
 import Data.Semigroup.Reducer
 import qualified Data.Set as Set
-import Data.Sum
-import Prologue hiding (TypeError, project)
-import Prelude hiding (Float, Integer, String, Rational)
-import qualified Prelude
+import Prologue
 
-type ValueConstructors location
-  = '[Array
-    , Boolean
-    , Class location
-    , Closure location
-    , Float
-    , Hash
-    , Integer
-    , KVPair
-    , Namespace location
-    , Null
-    , Rational
-    , String
-    , Symbol
-    , Tuple
-    , Unit
-    , Hole
-    ]
+data Value address body
+  = Closure PackageInfo ModuleInfo [Name] (ClosureBody address body) (Environment address)
+  | Unit
+  | Boolean Bool
+  | Integer  (Number.Number Integer)
+  | Rational (Number.Number Rational)
+  | Float    (Number.Number Scientific)
+  | String ByteString
+  | Symbol ByteString
+  | Tuple [Value address body]
+  | Array [Value address body]
+  | Class Name (Environment address)
+  | Namespace Name (Environment address)
+  | KVPair (Value address body) (Value address body)
+  | Hash [Value address body]
+  | Null
+  | Hole
+  deriving (Eq, Ord, Show)
 
--- | Open union of primitive values that terms can be evaluated to.
---   Fix by another name.
-newtype Value location = Value (Sum (ValueConstructors location) (Value location))
-  deriving (Eq, Show, Ord)
+data ClosureBody address body = ClosureBody { closureBodyId :: Int, closureBody :: body (Value address body) }
 
--- | Identical to 'inject', but wraps the resulting sub-entity in a 'Value'.
-injValue :: (f :< ValueConstructors location) => f (Value location) -> Value location
-injValue = Value . inject
+instance Eq   (ClosureBody address body) where
+  (==) = (==) `on` closureBodyId
 
--- | Identical to 'prj', but unwraps the argument out of its 'Value' wrapper.
-prjValue :: (f :< ValueConstructors location) => Value location -> Maybe (f (Value location))
-prjValue (Value v) = project v
+instance Ord  (ClosureBody address body) where
+  compare = compare `on` closureBodyId
 
--- | Convenience function for projecting two values.
-prjPair :: (f :< ValueConstructors location , g :< ValueConstructors location)
-        => (Value location, Value location)
-        -> Maybe (f (Value location), g (Value location))
-prjPair = bitraverse prjValue prjValue
-
--- TODO: Parameterize Value by the set of constructors s.t. each language can have a distinct value union.
-
--- | A function value consisting of a package & module info, a list of parameter 'Name's, a 'Label' to jump to the body of the function, and an 'Environment' of bindings captured by the body.
-data Closure location value = Closure PackageInfo ModuleInfo [Name] Label (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
-
--- | The unit value. Typically used to represent the result of imperative statements.
-data Unit value = Unit
-  deriving (Eq, Generic1, Ord, Show)
-
-instance Eq1 Unit where liftEq = genericLiftEq
-instance Ord1 Unit where liftCompare = genericLiftCompare
-instance Show1 Unit where liftShowsPrec = genericLiftShowsPrec
-
-data Hole value = Hole
-  deriving (Eq, Generic1, Ord, Show)
-
-instance Eq1 Hole where liftEq = genericLiftEq
-instance Ord1 Hole where liftCompare = genericLiftCompare
-instance Show1 Hole where liftShowsPrec = genericLiftShowsPrec
-
--- | Boolean values.
-newtype Boolean value = Boolean Prelude.Bool
-  deriving (Eq, Generic1, Ord, Show)
-
-instance Eq1 Boolean where liftEq = genericLiftEq
-instance Ord1 Boolean where liftCompare = genericLiftCompare
-instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec
-
--- | Arbitrary-width integral values.
-newtype Integer value = Integer (Number.Number Prelude.Integer)
-  deriving (Eq, Generic1, Ord, Show)
-
-instance Eq1 Integer where liftEq = genericLiftEq
-instance Ord1 Integer where liftCompare = genericLiftCompare
-instance Show1 Integer where liftShowsPrec = genericLiftShowsPrec
-
--- | Arbitrary-width rational values values.
-newtype Rational value = Rational (Number.Number Prelude.Rational)
-  deriving (Eq, Generic1, Ord, Show)
-
-instance Eq1 Rational where liftEq = genericLiftEq
-instance Ord1 Rational where liftCompare = genericLiftCompare
-instance Show1 Rational where liftShowsPrec = genericLiftShowsPrec
-
--- | String values.
-newtype String value = String ByteString
-  deriving (Eq, Generic1, Ord, Show)
-
-instance Eq1 String where liftEq = genericLiftEq
-instance Ord1 String where liftCompare = genericLiftCompare
-instance Show1 String where liftShowsPrec = genericLiftShowsPrec
-
--- | Possibly-interned Symbol values.
---   TODO: Should this store a 'Text'?
-newtype Symbol value = Symbol ByteString
-  deriving (Eq, Generic1, Ord, Show)
-
-instance Eq1 Symbol where liftEq = genericLiftEq
-instance Ord1 Symbol where liftCompare = genericLiftCompare
-instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec
-
--- | Float values.
-newtype Float value = Float (Number.Number 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. Fixed-size at interpretation time.
---   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
-
--- | Zero or more values. Dynamically resized as needed at interpretation time.
---   TODO: Vector? Seq?
-newtype Array value = Array [value]
-  deriving (Eq, Generic1, Ord, Show)
-
-instance Eq1 Array where liftEq = genericLiftEq
-instance Ord1 Array where liftCompare = genericLiftCompare
-instance Show1 Array where liftShowsPrec = genericLiftShowsPrec
-
--- | Class values. There will someday be a difference between classes and objects,
---   but for the time being we're pretending all languages have prototypical inheritance.
-data Class location value = Class
-  { _className  :: Name
-  , _classScope :: Environment location value
-  } deriving (Eq, Generic1, Ord, Show)
-
-instance Eq location => Eq1 (Class location) where liftEq = genericLiftEq
-instance Ord location => Ord1 (Class location) where liftCompare = genericLiftCompare
-instance Show location => Show1 (Class location) where liftShowsPrec = genericLiftShowsPrec
-
-data Namespace location value = Namespace
-  { namespaceName  :: Name
-  , namespaceScope :: Environment location value
-  } deriving (Eq, Generic1, Ord, Show)
-
-instance Eq location => Eq1 (Namespace location) where liftEq = genericLiftEq
-instance Ord location => Ord1 (Namespace location) where liftCompare = genericLiftCompare
-instance Show location => Show1 (Namespace location) where liftShowsPrec = genericLiftShowsPrec
-
-data KVPair value = KVPair value value
-  deriving (Eq, Generic1, Ord, Show)
-
-instance Eq1 KVPair where liftEq = genericLiftEq
-instance Ord1 KVPair where liftCompare = genericLiftCompare
-instance Show1 KVPair where liftShowsPrec = genericLiftShowsPrec
-
--- You would think this would be a @Map value value@ or a @[(value, value)].
--- You would be incorrect, as we can't derive a Generic1 instance for the above,
--- and in addition a 'Map' representation would lose information given hash literals
--- that assigned multiple values to one given key. Instead, this holds KVPair
--- values. The smart constructor for hashes in 'AbstractValue' ensures that these are
--- only populated with pairs.
-newtype Hash value = Hash [value]
-  deriving (Eq, Generic1, Ord, Show)
-
-instance Eq1 Hash where liftEq = genericLiftEq
-instance Ord1 Hash where liftCompare = genericLiftCompare
-instance Show1 Hash where liftShowsPrec = genericLiftShowsPrec
-
-data Null value = Null
-  deriving (Eq, Generic1, Ord, Show)
-
-instance Eq1 Null where liftEq = genericLiftEq
-instance Ord1 Null where liftCompare = genericLiftCompare
-instance Show1 Null where liftShowsPrec = genericLiftShowsPrec
+instance Show (ClosureBody address body) where
+  showsPrec d (ClosureBody i _) = showsBinaryWith showsPrec (const showChar) "ClosureBody" d i '_'
 
 
-instance Ord location => ValueRoots location (Value location) where
+instance Ord address => ValueRoots address (Value address body) where
   valueRoots v
-    | Just (Closure _ _ _ _ env) <- prjValue v = Env.addresses env
+    | Closure _ _ _ _ env <- v = Env.addresses env
     | otherwise                = mempty
 
 
-instance AbstractHole (Value location) where
-  hole = injValue Hole
+instance AbstractHole (Value address body) where
+  hole = Hole
+
+instance ( Coercible body (Eff effects)
+         , Member (Allocator address (Value address body)) effects
+         , Member Fresh effects
+         , Member (Reader ModuleInfo) effects
+         , Member (Reader PackageInfo) effects
+         , Member (Resumable (ValueError address body)) effects
+         , Member (Return (Value address body)) effects
+         , Member (State (Environment address)) effects
+         , Member (State (Heap address (Cell address) (Value address body))) effects
+         , Ord address
+         , Reducer (Value address body) (Cell address (Value address body))
+         , Show address
+         )
+      => AbstractFunction address (Value address body) effects where
+  closure parameters freeVariables body = do
+    packageInfo <- currentPackage
+    moduleInfo <- currentModule
+    i <- fresh
+    Closure packageInfo moduleInfo parameters (ClosureBody i (coerce (lowerEff body))) . Env.intersect (foldr Set.delete freeVariables parameters) <$> getEnv
+
+  call op params = do
+    case op of
+      Closure packageInfo moduleInfo names (ClosureBody _ body) env -> do
+        -- Evaluate the bindings and body with the closure’s package/module info in scope in order to
+        -- charge them to the closure's origin.
+        withCurrentPackage packageInfo . withCurrentModule moduleInfo $ do
+          bindings <- foldr (\ (name, param) rest -> do
+            v <- param
+            a <- alloc name
+            assign a v
+            Env.insert name a <$> rest) (pure env) (zip names params)
+          locally (bindAll bindings *> raiseEff (coerce body) `catchReturn` \ (Return value) -> pure value)
+      _ -> throwValueError (CallError op)
+
+
+instance Show address => AbstractIntro (Value address body) where
+  unit     = Unit
+  integer  = Integer . Number.Integer
+  boolean  = Boolean
+  string   = String
+  float    = Float . Number.Decimal
+  symbol   = Symbol
+  rational = Rational . Number.Ratio
+
+  multiple = Tuple
+
+  kvPair = KVPair
+  hash = Hash . map (uncurry KVPair)
+
+  null     = Null
+
 
 -- | Construct a 'Value' wrapping the value arguments (if any).
-instance ( Members '[ Allocator location (Value location)
-                    , Fail
-                    , LoopControl (Value location)
-                    , Reader (Environment location (Value location))
-                    , Reader ModuleInfo
-                    , Reader PackageInfo
-                    , Resumable (ValueError location)
-                    , Return (Value location)
-                    , State (Environment location (Value location))
-                    , State (Heap location (Cell location) (Value location))
-                    ] effects
-         , Ord location
-         , Reducer (Value location) (Cell location (Value location))
-         , Show location
+instance ( Coercible body (Eff effects)
+         , Member (Allocator address (Value address body)) effects
+         , Member Fresh effects
+         , Member (LoopControl (Value address body)) effects
+         , Member (Reader (Environment address)) effects
+         , Member (Reader ModuleInfo) effects
+         , Member (Reader PackageInfo) effects
+         , Member (Resumable (ValueError address body)) effects
+         , Member (Return (Value address body)) effects
+         , Member (State (Environment address)) effects
+         , Member (State (Heap address (Cell address) (Value address body))) effects
+         , Ord address
+         , Reducer (Value address body) (Cell address (Value address body))
+         , Show address
          )
-      => AbstractValue location (Value location) (Goto effects (Value location) ': effects) where
-  unit     = pure . injValue $ Unit
-  integer  = pure . injValue . Integer . Number.Integer
-  boolean  = pure . injValue . Boolean
-  string   = pure . injValue . String
-  float    = pure . injValue . Float . Number.Decimal
-  symbol   = pure . injValue . Symbol
-  rational = pure . injValue . Rational . Number.Ratio
-
-  multiple = pure . injValue . Tuple
-  array    = pure . injValue . Array
-
-  kvPair k = pure . injValue . KVPair k
-
-  null     = pure . injValue $ Null
-
+      => AbstractValue address (Value address body) effects where
   asPair val
-    | Just (KVPair k v) <- prjValue val = pure (k, v)
+    | KVPair k v <- val = pure (k, v)
     | otherwise = throwValueError $ KeyValueError val
 
-  hash = pure . injValue . Hash . fmap (injValue . uncurry KVPair)
+  array    = pure . Array
 
-  klass n [] env = pure . injValue $ Class n env
+  klass n [] env = pure $ Class n env
   klass n supers env = do
     product <- foldl mergeEnvs emptyEnv . catMaybes <$> traverse scopedEnvironment supers
-    pure . injValue $ Class n (mergeEnvs product env)
+    pure $ Class n (mergeEnvs product env)
 
   namespace n env = do
     maybeAddr <- lookupEnv n
     env' <- maybe (pure emptyEnv) (asNamespaceEnv <=< deref) maybeAddr
-    pure (injValue (Namespace n (Env.mergeNewer env' env)))
+    pure (Namespace n (Env.mergeNewer env' env))
     where asNamespaceEnv v
-            | Just (Namespace _ env') <- prjValue v = pure env'
+            | Namespace _ env' <- v = pure env'
             | otherwise             = throwValueError $ NamespaceError ("expected " <> show v <> " to be a namespace")
 
   scopedEnvironment o
-    | Just (Class _ env) <- prjValue o = pure (Just env)
-    | Just (Namespace _ env) <- prjValue o = pure (Just env)
+    | Class _ env <- o = pure (Just env)
+    | Namespace _ env <- o = pure (Just env)
     | otherwise = pure Nothing
 
   asString v
-    | Just (String n) <- prjValue v = pure n
+    | String n <- v = pure n
     | otherwise     = throwValueError $ StringError v
 
   ifthenelse cond if' else' = do
-    isHole <- isHole cond
-    if isHole then
-      pure hole
-    else do
-      bool <- asBool cond
+    bool <- case cond of { Boolean b -> pure b ; _ -> throwValueError (BoolError cond) }
     if bool then if' else else'
 
-  asBool val
-    | Just (Boolean b) <- prjValue val = pure b
-    | otherwise = throwValueError $ BoolError val
-
-  isHole val = pure (prjValue val == Just Hole)
-
   index = go where
     tryIdx list ii
       | ii > genericLength list = throwValueError (BoundsError list ii)
       | otherwise               = pure (genericIndex list ii)
     go arr idx
-      | (Just (Array arr, Integer (Number.Integer i))) <- prjPair (arr, idx) = tryIdx arr i
-      | (Just (Tuple tup, Integer (Number.Integer i))) <- prjPair (arr, idx) = tryIdx tup i
+      | (Array arr, Integer (Number.Integer i)) <- (arr, idx) = tryIdx arr i
+      | (Tuple tup, Integer (Number.Integer i)) <- (arr, idx) = tryIdx tup i
       | otherwise = throwValueError (IndexError arr idx)
 
   liftNumeric f arg
-    | Just (Integer (Number.Integer i)) <- prjValue arg = integer $ f i
-    | Just (Float (Number.Decimal d))   <- prjValue arg = float   $ f d
-    | Just (Rational (Number.Ratio r))  <- prjValue arg = rational $ f r
+    | Integer (Number.Integer i) <- arg = pure . integer  $ f i
+    | Float (Number.Decimal d)   <- arg = pure . float    $ f d
+    | Rational (Number.Ratio r)  <- arg = pure . rational $ f r
     | otherwise = throwValueError (NumericError arg)
 
   liftNumeric2 f left right
-    | Just (Integer  i, Integer j)  <- prjPair pair = tentative f i j & specialize
-    | Just (Integer  i, Rational j) <- prjPair pair = tentative f i j & specialize
-    | Just (Integer  i, Float j)    <- prjPair pair = tentative f i j & specialize
-    | Just (Rational i, Integer j)  <- prjPair pair = tentative f i j & specialize
-    | Just (Rational i, Rational j) <- prjPair pair = tentative f i j & specialize
-    | Just (Rational i, Float j)    <- prjPair pair = tentative f i j & specialize
-    | Just (Float    i, Integer j)  <- prjPair pair = tentative f i j & specialize
-    | Just (Float    i, Rational j) <- prjPair pair = tentative f i j & specialize
-    | Just (Float    i, Float j)    <- prjPair pair = tentative f i j & specialize
+    | (Integer  i, Integer j)  <- pair = tentative f i j & specialize
+    | (Integer  i, Rational j) <- pair = tentative f i j & specialize
+    | (Integer  i, Float j)    <- pair = tentative f i j & specialize
+    | (Rational i, Integer j)  <- pair = tentative f i j & specialize
+    | (Rational i, Rational j) <- pair = tentative f i j & specialize
+    | (Rational i, Float j)    <- pair = tentative f i j & specialize
+    | (Float    i, Integer j)  <- pair = tentative f i j & specialize
+    | (Float    i, Rational j) <- pair = tentative f i j & specialize
+    | (Float    i, Float j)    <- pair = tentative f i j & specialize
     | otherwise = throwValueError (Numeric2Error left right)
       where
         tentative x i j = attemptUnsafeArithmetic (x i j)
 
         -- Dispatch whatever's contained inside a 'Number.SomeNumber' to its appropriate 'MonadValue' ctor
-        specialize :: (AbstractValue location (Value location) effects, Member (Resumable (ValueError location)) effects) => Either ArithException Number.SomeNumber -> Evaluator location (Value location) effects (Value location)
+        specialize :: (AbstractValue address (Value address body) effects, Member (Resumable (ValueError address body)) effects) => Either ArithException Number.SomeNumber -> Evaluator address (Value address body) effects (Value address body)
         specialize (Left exc) = throwValueError (ArithmeticError exc)
-        specialize (Right (Number.SomeNumber (Number.Integer i))) = integer i
-        specialize (Right (Number.SomeNumber (Number.Ratio r)))   = rational r
-        specialize (Right (Number.SomeNumber (Number.Decimal d))) = float d
+        specialize (Right (Number.SomeNumber (Number.Integer i))) = pure $ integer i
+        specialize (Right (Number.SomeNumber (Number.Ratio r)))   = pure $ rational r
+        specialize (Right (Number.SomeNumber (Number.Decimal d))) = pure $ float d
         pair = (left, right)
 
   liftComparison comparator left right
-    | Just (Integer (Number.Integer i), Integer (Number.Integer j)) <- prjPair pair = go i j
-    | Just (Integer (Number.Integer i), Float   (Number.Decimal j)) <- prjPair pair = go (fromIntegral i) j
-    | Just (Float   (Number.Decimal i), Integer (Number.Integer j)) <- prjPair pair = go i                (fromIntegral j)
-    | Just (Float   (Number.Decimal i), Float   (Number.Decimal j)) <- prjPair pair = go i j
-    | Just (String  i,                  String  j)                  <- prjPair pair = go i j
-    | Just (Boolean i,                  Boolean j)                  <- prjPair pair = go i j
-    | Just (Unit,                       Unit)                       <- prjPair pair = boolean True
+    | (Integer (Number.Integer i), Integer (Number.Integer j)) <- pair = go i j
+    | (Integer (Number.Integer i), Float   (Number.Decimal j)) <- pair = go (fromIntegral i) j
+    | (Float   (Number.Decimal i), Integer (Number.Integer j)) <- pair = go i                (fromIntegral j)
+    | (Float   (Number.Decimal i), Float   (Number.Decimal j)) <- pair = go i j
+    | (String  i,                  String  j)                  <- pair = go i j
+    | (Boolean i,                  Boolean j)                  <- pair = go i j
+    | (Unit,                       Unit)                       <- pair = pure $ boolean True
     | otherwise = throwValueError (ComparisonError left right)
       where
         -- Explicit type signature is necessary here because we're passing all sorts of things
         -- to these comparison functions.
-        go :: (AbstractValue location (Value location) effects, Ord a) => a -> a -> Evaluator location (Value location) effects (Value location)
+        go :: (AbstractValue address (Value address body) effects, Ord a) => a -> a -> Evaluator address (Value address body) effects (Value address body)
         go l r = case comparator of
-          Concrete f  -> boolean (f l r)
-          Generalized -> integer (orderingToInt (compare l r))
+          Concrete f  -> pure $ boolean (f l r)
+          Generalized -> pure $ integer (orderingToInt (compare l r))
 
         -- Map from [LT, EQ, GT] to [-1, 0, 1]
         orderingToInt :: Ordering -> Prelude.Integer
@@ -340,35 +217,14 @@ instance ( Members '[ Allocator location (Value location)
 
 
   liftBitwise operator target
-    | Just (Integer (Number.Integer i)) <- prjValue target = integer $ operator i
+    | Integer (Number.Integer i) <- target = pure . integer $ operator i
     | otherwise = throwValueError (BitwiseError target)
 
   liftBitwise2 operator left right
-    | Just (Integer (Number.Integer i), Integer (Number.Integer j)) <- prjPair pair = integer $ operator i j
+    | (Integer (Number.Integer i), Integer (Number.Integer j)) <- pair = pure . integer $ operator i j
     | otherwise = throwValueError (Bitwise2Error left right)
       where pair = (left, right)
 
-  closure parameters freeVariables body = do
-    packageInfo <- currentPackage
-    moduleInfo <- currentModule
-    l <- label body
-    injValue . Closure packageInfo moduleInfo parameters l . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv
-
-  call op params = do
-    case prjValue op of
-      Just (Closure packageInfo moduleInfo names label env) -> do
-        body <- goto label
-        -- Evaluate the bindings and body with the closure’s package/module info in scope in order to
-        -- charge them to the closure's origin.
-        withCurrentPackage packageInfo . withCurrentModule moduleInfo $ do
-          bindings <- foldr (\ (name, param) rest -> do
-            v <- param
-            a <- alloc name
-            assign a v
-            Env.insert name a <$> rest) (pure env) (zip names params)
-          localEnv (mergeEnvs bindings) (body `catchReturn` \ (Return value) -> pure value)
-      Nothing -> throwValueError (CallError op)
-
   loop x = catchLoopControl (fix x) (\ control -> case control of
     Break value -> pure value
     -- FIXME: Figure out how to deal with this. Ruby treats this as the result of the current block iteration, while PHP specifies a breakout level and TypeScript appears to take a label.
@@ -376,25 +232,25 @@ instance ( Members '[ Allocator location (Value location)
 
 
 -- | The type of exceptions that can be thrown when constructing values in 'Value'’s 'MonadValue' instance.
-data ValueError location resume where
-  StringError            :: Value location                   -> ValueError location ByteString
-  BoolError              :: Value location                   -> ValueError location Bool
-  IndexError             :: Value location -> Value location -> ValueError location (Value location)
-  NamespaceError         :: Prelude.String                   -> ValueError location (Environment location (Value location))
-  CallError              :: Value location                   -> ValueError location (Value location)
-  NumericError           :: Value location                   -> ValueError location (Value location)
-  Numeric2Error          :: Value location -> Value location -> ValueError location (Value location)
-  ComparisonError        :: Value location -> Value location -> ValueError location (Value location)
-  BitwiseError           :: Value location                   -> ValueError location (Value location)
-  Bitwise2Error          :: Value location -> Value location -> ValueError location (Value location)
-  KeyValueError          :: Value location                   -> ValueError location (Value location, Value location)
+data ValueError address body resume where
+  StringError            :: Value address body                       -> ValueError address body ByteString
+  BoolError              :: Value address body                       -> ValueError address body Bool
+  IndexError             :: Value address body -> Value address body -> ValueError address body (Value address body)
+  NamespaceError         :: Prelude.String                           -> ValueError address body (Environment address)
+  CallError              :: Value address body                       -> ValueError address body (Value address body)
+  NumericError           :: Value address body                       -> ValueError address body (Value address body)
+  Numeric2Error          :: Value address body -> Value address body -> ValueError address body (Value address body)
+  ComparisonError        :: Value address body -> Value address body -> ValueError address body (Value address body)
+  BitwiseError           :: Value address body                       -> ValueError address body (Value address body)
+  Bitwise2Error          :: Value address body -> Value address body -> ValueError address body (Value address body)
+  KeyValueError          :: Value address body                       -> ValueError address body (Value address body, Value address body)
   -- Indicates that we encountered an arithmetic exception inside Haskell-native number crunching.
-  ArithmeticError        :: ArithException                   -> ValueError location (Value location)
+  ArithmeticError        :: ArithException                           -> ValueError address body (Value address body)
   -- Out-of-bounds error
-  BoundsError            :: [Value location] -> Prelude.Integer -> ValueError location (Value location)
+  BoundsError            :: [Value address body] -> Prelude.Integer  -> ValueError address body (Value address body)
 
 
-instance Eq location => Eq1 (ValueError location) where
+instance Eq address => Eq1 (ValueError address body) where
   liftEq _ (StringError a) (StringError b)                       = a == b
   liftEq _ (NamespaceError a) (NamespaceError b)                 = a == b
   liftEq _ (CallError a) (CallError b)                           = a == b
@@ -408,15 +264,15 @@ instance Eq location => Eq1 (ValueError location) where
   liftEq _ (BoundsError a b) (BoundsError c d)                   = (a == c) && (b == d)
   liftEq _ _             _                                       = False
 
-deriving instance Show location => Show (ValueError location resume)
-instance Show location => Show1 (ValueError location) where
+deriving instance Show address => Show (ValueError address body resume)
+instance Show address => Show1 (ValueError address body) where
   liftShowsPrec _ _ = showsPrec
 
-throwValueError :: Member (Resumable (ValueError location)) effects => ValueError location resume -> Evaluator location (Value location) effects resume
+throwValueError :: Member (Resumable (ValueError address body)) effects => ValueError address body resume -> Evaluator address (Value address body) effects resume
 throwValueError = throwResumable
 
-runValueError :: Effectful (m location (Value location)) => m location (Value location) (Resumable (ValueError location) ': effects) a -> m location (Value location) effects (Either (SomeExc (ValueError location)) a)
+runValueError :: Effectful (m address (Value address body)) => m address (Value address body) (Resumable (ValueError address body) ': effects) a -> m address (Value address body) effects (Either (SomeExc (ValueError address body)) a)
 runValueError = runResumable
 
-runValueErrorWith :: Effectful (m location (Value location)) => (forall resume . ValueError location resume -> m location (Value location) effects resume) -> m location (Value location) (Resumable (ValueError location) ': effects) a -> m location (Value location) effects a
+runValueErrorWith :: Effectful (m address (Value address body)) => (forall resume . ValueError address body resume -> m address (Value address body) effects resume) -> m address (Value address body) (Resumable (ValueError address body) ': effects) a -> m address (Value address body) effects a
 runValueErrorWith = runResumableWith

src/Data/Align/Generic.hs

@@ -1,78 +0,0 @@
-{-# LANGUAGE DataKinds, DefaultSignatures, TypeOperators, UndecidableInstances #-}
-module Data.Align.Generic where
-
-import Control.Applicative
-import Control.Monad
-import Data.Functor (($>))
-import Data.List.NonEmpty (NonEmpty(..))
-import Data.Maybe (fromMaybe)
-import Data.Sum
-import Data.These
-import GHC.Generics
-
--- | Functors which can be aligned (structure-unioning-ly zipped). The default implementation will operate generically over the constructors in the aligning type.
-class GAlign f where
-  -- | Perform generic alignment of values of some functor, applying the given function to alignments of elements.
-  galignWith :: Alternative g => (These a1 a2 -> g b) -> f a1 -> f a2 -> g (f b)
-  default galignWith :: (Alternative g, Generic1 f, GAlign (Rep1 f)) => (These a1 a2 -> g b) -> f a1 -> f a2 -> g (f b)
-  galignWith f a b = to1 <$> galignWith f (from1 a) (from1 b)
-
-galign :: (Alternative g, GAlign f) => f a1 -> f a2 -> g (f (These a1 a2))
-galign = galignWith pure
-
--- 'Data.Align.Align' instances
-
-instance GAlign Maybe where
-  galignWith f (Just a1) (Just a2) = Just <$> f (These a1 a2)
-  galignWith f (Just a1) Nothing   = Just <$> f (This a1)
-  galignWith f Nothing   (Just a2) = Just <$> f (That a2)
-  galignWith _ Nothing   Nothing   = pure Nothing
-
-instance GAlign [] where
-  galignWith f (a1:as1) (a2:as2) = (:) <$> f (These a1 a2) <*> galignWith f as1 as2
-  galignWith f []       as2      = traverse (f . That) as2
-  galignWith f as1      []       = traverse (f . This) as1
-
-instance GAlign NonEmpty where
-  galignWith f (a1:|as1) (a2:|as2) = (:|) <$> f (These a1 a2) <*> galignWith f as1 as2
-
-instance Apply GAlign fs => GAlign (Sum fs) where
-  galignWith f = (fromMaybe empty .) . apply2' @GAlign (\ inj -> (fmap inj .) . galignWith f)
-
-
--- Generics
-
--- | 'GAlign' over unit constructors.
-instance GAlign U1 where
-  galignWith _ _ _ = pure U1
-
--- | 'GAlign' over parameters.
-instance GAlign Par1 where
-  galignWith f (Par1 a) (Par1 b) = Par1 <$> f (These a b)
-
--- | 'GAlign' over non-parameter fields. Only equal values are aligned.
-instance Eq c => GAlign (K1 i c) where
-  galignWith _ (K1 a) (K1 b) = guard (a == b) $> K1 b
-
--- | 'GAlign' over applications over parameters.
-instance GAlign f => GAlign (Rec1 f) where
-  galignWith f (Rec1 a) (Rec1 b) = Rec1 <$> galignWith f a b
-
--- | 'GAlign' over metainformation (constructor names, etc).
-instance GAlign f => GAlign (M1 i c f) where
-  galignWith f (M1 a) (M1 b) = M1 <$> galignWith f a b
-
--- | 'GAlign' over sums. Returns 'Nothing' for disjoint constructors.
-instance (GAlign f, GAlign g) => GAlign (f :+: g) where
-  galignWith f a b = case (a, b) of
-    (L1 a, L1 b) -> L1 <$> galignWith f a b
-    (R1 a, R1 b) -> R1 <$> galignWith f a b
-    _ -> empty
-
--- | 'GAlign' over products.
-instance (GAlign f, GAlign g) => GAlign (f :*: g) where
-  galignWith f (a1 :*: b1) (a2 :*: b2) = (:*:) <$> galignWith f a1 a2 <*> galignWith f b1 b2
-
--- | 'GAlign' over type compositions.
-instance (Traversable f, Applicative f, GAlign g) => GAlign (f :.: g) where
-  galignWith f (Comp1 a) (Comp1 b) = Comp1 <$> sequenceA (galignWith f <$> a <*> b)

src/Data/Diff.hs

@@ -89,13 +89,13 @@ diffPatches = para $ \ diff -> case diff of
 
 
 -- | Recover the before state of a diff.
-beforeTerm :: (Mergeable syntax, Traversable syntax) => Diff syntax ann1 ann2 -> Maybe (Term syntax ann1)
+beforeTerm :: (Foldable syntax, Mergeable syntax) => Diff syntax ann1 ann2 -> Maybe (Term syntax ann1)
 beforeTerm = cata $ \ diff -> case diff of
   Patch patch -> (before patch >>= \ (In  a     l) -> termIn a <$> sequenceAlt l) <|> (after patch >>= asum)
   Merge                              (In (a, _) l) -> termIn a <$> sequenceAlt l
 
 -- | Recover the after state of a diff.
-afterTerm :: (Mergeable syntax, Traversable syntax) => Diff syntax ann1 ann2 -> Maybe (Term syntax ann2)
+afterTerm :: (Foldable syntax, Mergeable syntax) => Diff syntax ann1 ann2 -> Maybe (Term syntax ann2)
 afterTerm = cata $ \ diff -> case diff of
   Patch patch -> (after patch >>= \ (In     b  r) -> termIn b <$> sequenceAlt r) <|> (before patch >>= asum)
   Merge                             (In (_, b) r) -> termIn b <$> sequenceAlt r

src/Data/Mergeable.hs

@@ -13,71 +13,62 @@ import GHC.Generics
 --
 -- This is a kind of distributive law which produces (at least) the union of the two functors’ shapes; i.e. unlike 'Traversable', an 'empty' value in the inner functor does not produce an 'empty' result, and unlike 'Crosswalk', an 'empty' value in the outer functor does not produce an 'empty' result.
 --
--- For example, we can use 'merge' to select one side or the other of a diff node in 'Syntax', while correctly handling the fact that some patches don’t have any content for that side:
---
--- @
--- let before = iter (\ (a :< s) -> cofree . (fst a :<) <$> sequenceAlt syntax) . fmap (maybeFst . unPatch)
--- @
+-- For example, 'Data.Diff' uses 'sequenceAlt' to select one side or the other of a diff node, while correctly handling the fact that some patches don’t have any content for that side.
 class Functor t => Mergeable t where
-  -- | Merge a functor by mapping its elements into an 'Alternative' functor, combining them, and pushing the 'Mergeable' functor inside.
-  merge :: Alternative f => (a -> f b) -> t a -> f (t b)
-  default merge :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => (a -> f b) -> t a -> f (t b)
-  merge = genericMerge
-
-  -- | Sequnce a 'Mergeable' functor by 'merge'ing the 'Alternative' values.
+  -- | Sequence a 'Mergeable' functor by merging the 'Alternative' values.
   sequenceAlt :: Alternative f => t (f a) -> f (t a)
-  sequenceAlt = merge id
+  default sequenceAlt :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => t (f a) -> f (t a)
+  sequenceAlt = genericSequenceAlt
 
 
 -- Instances
 
 instance Mergeable [] where
-  merge f (x:xs) = ((:) <$> f x <|> pure id) <*> merge f xs
-  merge _ [] = pure []
+  sequenceAlt = foldr (\ x -> (((:) <$> x <|> pure id) <*>)) (pure [])
 
 instance Mergeable NonEmpty where
-  merge f (x:|[]) = (:|) <$> f x <*> pure []
-  merge f (x1:|x2:xs) = (:|) <$> f x1 <*> merge f (x2 : xs) <|> merge f (x2:|xs)
+  sequenceAlt (x :|[])    = (:|) <$> x  <*> pure []
+  sequenceAlt (x1:|x2:xs) = (:|) <$> x1 <*> sequenceAlt (x2 : xs) <|> sequenceAlt (x2:|xs)
 
 instance Mergeable Maybe where
-  merge f (Just a) = Just <$> f a
-  merge _ Nothing = pure empty
+  sequenceAlt = maybe (pure empty) (fmap Just)
 
-instance Mergeable Identity where merge f = fmap Identity . f . runIdentity
+instance Mergeable Identity where
+  sequenceAlt = fmap Identity . runIdentity
 
 instance (Apply Functor fs, Apply Mergeable fs) => Mergeable (Sum fs) where
-  merge f = apply' @Mergeable (\ reinj g -> reinj <$> merge f g)
+  sequenceAlt = apply' @Mergeable (\ reinj t -> reinj <$> sequenceAlt t)
 
 
 -- Generics
 
 class GMergeable t where
-  gmerge :: Alternative f => (a -> f b) -> t a -> f (t b)
+  gsequenceAlt :: Alternative f => t (f a) -> f (t a)
 
-genericMerge :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => (a -> f b) -> t a -> f (t b)
-genericMerge f = fmap to1 . gmerge f . from1
+genericSequenceAlt :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => t (f a) -> f (t a)
+genericSequenceAlt = fmap to1 . gsequenceAlt . from1
 
 
 -- Instances
 
 instance GMergeable U1 where
-  gmerge _ _ = pure U1
+  gsequenceAlt _ = pure U1
 
 instance GMergeable Par1 where
-  gmerge f (Par1 a) = Par1 <$> f a
+  gsequenceAlt (Par1 a) = Par1 <$> a
 
 instance GMergeable (K1 i c) where
-  gmerge _ (K1 a) = pure (K1 a)
+  gsequenceAlt (K1 a) = pure (K1 a)
 
 instance Mergeable f => GMergeable (Rec1 f) where
-  gmerge f (Rec1 a) = Rec1 <$> merge f a
+  gsequenceAlt (Rec1 a) = Rec1 <$> sequenceAlt a
 
 instance GMergeable f => GMergeable (M1 i c f) where
-  gmerge f (M1 a) = M1 <$> gmerge f a
+  gsequenceAlt (M1 a) = M1 <$> gsequenceAlt a
 
 instance (GMergeable f, GMergeable g) => GMergeable (f :+: g) where
-  gmerge f (L1 a) = L1 <$> gmerge f a
-  gmerge f (R1 b) = R1 <$> gmerge f b
+  gsequenceAlt (L1 a) = L1 <$> gsequenceAlt a
+  gsequenceAlt (R1 a) = R1 <$> gsequenceAlt a
 
 instance (GMergeable f, GMergeable g) => GMergeable (f :*: g) where
-  gmerge f (a :*: b) = (:*:) <$> gmerge f a <*> gmerge f b
+  gsequenceAlt (a :*: b) = (:*:) <$> gsequenceAlt a <*> gsequenceAlt b

src/Data/Syntax.hs

@@ -133,7 +133,7 @@ instance (Element f all, c f, Generate c all fs) => Generate c all (f ': fs) whe
 
 -- | An identifier of some other construct, whether a containing declaration (e.g. a class name) or a reference (e.g. a variable).
 newtype Identifier a = Identifier Name
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, Generic, Named)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, Named)
 
 instance Eq1 Identifier where liftEq = genericLiftEq
 instance Ord1 Identifier where liftCompare = genericLiftCompare
@@ -152,7 +152,7 @@ instance Declarations1 Identifier where
   liftDeclaredName _ (Identifier x) = pure x
 
 newtype Program a = Program [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Program where liftEq = genericLiftEq
 instance Ord1 Program where liftCompare = genericLiftCompare
@@ -165,7 +165,7 @@ instance Evaluatable Program where
 
 -- | An accessibility modifier, e.g. private, public, protected, etc.
 newtype AccessibilityModifier a = AccessibilityModifier ByteString
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 AccessibilityModifier where liftEq = genericLiftEq
 instance Ord1 AccessibilityModifier where liftCompare = genericLiftCompare
@@ -180,7 +180,7 @@ instance Evaluatable AccessibilityModifier
 --
 --   This can be used to represent an implicit no-op, e.g. the alternative in an 'if' statement without an 'else'.
 data Empty a = Empty
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Generic, Named, Message, Message1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named, Message1)
 
 instance ToJSONFields1 Empty
 
@@ -189,11 +189,11 @@ instance Ord1 Empty where liftCompare _ _ _ = EQ
 instance Show1 Empty where liftShowsPrec _ _ _ _ = showString "Empty"
 
 instance Evaluatable Empty where
-  eval _ = Rval <$> unit
+  eval _ = pure (Rval unit)
 
 -- | Syntax representing a parsing or assignment error.
 data Error a = Error { errorCallStack :: ErrorStack, errorExpected :: [String], errorActual :: Maybe String, errorChildren :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Error where liftEq = genericLiftEq
 instance Ord1 Error where liftCompare = genericLiftCompare
@@ -246,7 +246,7 @@ instance Ord ErrorStack where
 
 
 data Context a = Context { contextTerms :: NonEmpty a, contextSubject :: a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Context
 

src/Data/Syntax/Comment.hs

@@ -9,7 +9,7 @@ import Diffing.Algorithm
 
 -- | An unnested comment (line or block).
 newtype Comment a = Comment { commentContent :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Comment where liftEq = genericLiftEq
 instance Ord1 Comment where liftCompare = genericLiftCompare
@@ -19,7 +19,7 @@ instance ToJSONFields1 Comment where
   toJSONFields1 f@Comment{..} = withChildren f ["contents" .= unpack commentContent ]
 
 instance Evaluatable Comment where
-  eval _ = Rval <$> unit
+  eval _ = pure (Rval unit)
 
 -- TODO: nested comment types
 -- TODO: documentation comment types

src/Data/Syntax/Declaration.hs

@@ -9,7 +9,7 @@ import Diffing.Algorithm
 import Prologue
 
 data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Diffable Function where
   equivalentBySubterm = Just . functionName
@@ -27,7 +27,7 @@ instance Evaluatable Function where
   eval Function{..} = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm functionName)
     (v, addr) <- letrec name (closure (paramNames functionParameters) (Set.fromList (freeVariables functionBody)) (subtermValue functionBody))
-    modifyEnv (Env.insert name addr)
+    bind name addr
     pure (Rval v)
     where paramNames = foldMap (freeVariables . subterm)
 
@@ -36,7 +36,7 @@ instance Declarations a => Declarations (Function a) where
 
 
 data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Method where liftEq = genericLiftEq
 instance Ord1 Method where liftCompare = genericLiftCompare
@@ -53,14 +53,14 @@ instance Evaluatable Method where
   eval Method{..} = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm methodName)
     (v, addr) <- letrec name (closure (paramNames methodParameters) (Set.fromList (freeVariables methodBody)) (subtermValue methodBody))
-    modifyEnv (Env.insert name addr)
+    bind name addr
     pure (Rval v)
     where paramNames = foldMap (freeVariables . subterm)
 
 
 -- | A method signature in TypeScript or a method spec in Go.
 data MethodSignature a = MethodSignature { _methodSignatureContext :: ![a], _methodSignatureName :: !a, _methodSignatureParameters :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 MethodSignature where liftEq = genericLiftEq
 instance Ord1 MethodSignature where liftCompare = genericLiftCompare
@@ -73,7 +73,7 @@ instance Evaluatable MethodSignature
 
 
 newtype RequiredParameter a = RequiredParameter { requiredParameter :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 RequiredParameter where liftEq = genericLiftEq
 instance Ord1 RequiredParameter where liftCompare = genericLiftCompare
@@ -86,7 +86,7 @@ instance Evaluatable RequiredParameter
 
 
 newtype OptionalParameter a = OptionalParameter { optionalParameter :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 OptionalParameter where liftEq = genericLiftEq
 instance Ord1 OptionalParameter where liftCompare = genericLiftCompare
@@ -103,7 +103,7 @@ instance Evaluatable OptionalParameter
 -- 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, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 VariableDeclaration where liftEq = genericLiftEq
 instance Ord1 VariableDeclaration where liftCompare = genericLiftCompare
@@ -112,8 +112,8 @@ instance Show1 VariableDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance ToJSONFields1 VariableDeclaration
 
 instance Evaluatable VariableDeclaration where
-  eval (VariableDeclaration [])   = Rval <$> unit
-  eval (VariableDeclaration decs) = Rval <$> (multiple =<< traverse subtermValue decs)
+  eval (VariableDeclaration [])   = pure (Rval unit)
+  eval (VariableDeclaration decs) = Rval . multiple <$> traverse subtermValue decs
 
 instance Declarations a => Declarations (VariableDeclaration a) where
   declaredName (VariableDeclaration vars) = case vars of
@@ -123,7 +123,7 @@ instance Declarations a => Declarations (VariableDeclaration a) where
 
 -- | A TypeScript/Java style interface declaration to implement.
 data InterfaceDeclaration a = InterfaceDeclaration { interfaceDeclarationContext :: ![a], interfaceDeclarationIdentifier :: !a, interfaceDeclarationBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 InterfaceDeclaration where liftEq = genericLiftEq
 instance Ord1 InterfaceDeclaration where liftCompare = genericLiftCompare
@@ -140,7 +140,7 @@ instance Declarations a => Declarations (InterfaceDeclaration a) where
 
 -- | A public field definition such as a field definition in a JavaScript class.
 data PublicFieldDefinition a = PublicFieldDefinition { publicFieldContext :: ![a], publicFieldPropertyName :: !a, publicFieldValue :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 PublicFieldDefinition where liftEq = genericLiftEq
 instance Ord1 PublicFieldDefinition where liftCompare = genericLiftCompare
@@ -153,7 +153,7 @@ instance Evaluatable PublicFieldDefinition
 
 
 data Variable a = Variable { variableName :: !a, variableType :: !a, variableValue :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Variable where liftEq = genericLiftEq
 instance Ord1 Variable where liftCompare = genericLiftCompare
@@ -165,7 +165,7 @@ instance ToJSONFields1 Variable
 instance Evaluatable Variable
 
 data Class a = Class { classContext :: ![a], classIdentifier :: !a, classSuperclasses :: ![a], classBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Declarations a => Declarations (Class a) where
   declaredName (Class _ name _ _) = declaredName name
@@ -187,11 +187,11 @@ instance Evaluatable Class where
       void $ subtermValue classBody
       classEnv <- Env.head <$> getEnv
       klass name supers classEnv
-    Rval <$> (v <$ modifyEnv (Env.insert name addr))
+    Rval v <$ bind name addr
 
 -- | A decorator in Python
 data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Decorator where liftEq = genericLiftEq
 instance Ord1 Decorator where liftCompare = genericLiftCompare
@@ -207,7 +207,7 @@ instance Evaluatable Decorator
 
 -- | An ADT, i.e. a disjoint sum of products, like 'data' in Haskell, or 'enum' in Rust or Swift.
 data Datatype a = Datatype { datatypeName :: !a, datatypeConstructors :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Data.Syntax.Declaration.Datatype where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Declaration.Datatype where liftCompare = genericLiftCompare
@@ -221,7 +221,7 @@ instance Evaluatable Data.Syntax.Declaration.Datatype
 
 -- | A single constructor in a datatype, or equally a 'struct' in C, Rust, or Swift.
 data Constructor a = Constructor { constructorName :: !a, constructorFields :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Data.Syntax.Declaration.Constructor where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Declaration.Constructor where liftCompare = genericLiftCompare
@@ -235,7 +235,7 @@ instance Evaluatable Data.Syntax.Declaration.Constructor
 
 -- | Comprehension (e.g. ((a for b in c if a()) in Python)
 data Comprehension a = Comprehension { comprehensionValue :: !a, comprehensionBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Comprehension where liftEq = genericLiftEq
 instance Ord1 Comprehension where liftCompare = genericLiftCompare
@@ -249,7 +249,7 @@ instance Evaluatable Comprehension
 
 -- | A declared type (e.g. `a []int` in Go).
 data Type a = Type { typeName :: !a, typeKind :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Type where liftEq = genericLiftEq
 instance Ord1 Type where liftCompare = genericLiftCompare
@@ -263,7 +263,7 @@ instance Evaluatable Type
 
 -- | Type alias declarations in Javascript/Haskell, etc.
 data TypeAlias a = TypeAlias { typeAliasContext :: ![a], typeAliasIdentifier :: !a, typeAliasKind :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 TypeAlias where liftEq = genericLiftEq
 instance Ord1 TypeAlias where liftCompare = genericLiftCompare
@@ -278,7 +278,7 @@ instance Evaluatable TypeAlias where
     v <- subtermValue typeAliasKind
     addr <- lookupOrAlloc name
     assign addr v
-    Rval <$> (modifyEnv (Env.insert name addr) $> v)
+    Rval v <$ bind name addr
 
 instance Declarations a => Declarations (TypeAlias a) where
   declaredName TypeAlias{..} = declaredName typeAliasIdentifier

src/Data/Syntax/Directive.hs

@@ -11,7 +11,7 @@ import           Prologue
 
 -- A file directive like the Ruby constant `__FILE__`.
 data File a = File
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 File where liftEq = genericLiftEq
 instance Ord1 File where liftCompare = genericLiftCompare
@@ -20,12 +20,12 @@ instance Show1 File where liftShowsPrec = genericLiftShowsPrec
 instance ToJSONFields1 File
 
 instance Evaluatable File where
-  eval File = Rval <$> (currentModule >>= string . BC.pack . modulePath)
+  eval File = Rval . string . BC.pack . modulePath <$> currentModule
 
 
 -- A line directive like the Ruby constant `__LINE__`.
 data Line a = Line
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Line where liftEq = genericLiftEq
 instance Ord1 Line where liftCompare = genericLiftCompare
@@ -34,4 +34,4 @@ instance Show1 Line where liftShowsPrec = genericLiftShowsPrec
 instance ToJSONFields1 Line
 
 instance Evaluatable Line where
-  eval Line = Rval <$> (currentSpan >>= integer . fromIntegral . posLine . spanStart)
+  eval Line = Rval . integer . fromIntegral . posLine . spanStart <$> currentSpan

src/Data/Syntax/Expression.hs

@@ -10,7 +10,7 @@ import Prologue hiding (index)
 
 -- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell.
 data Call a = Call { callContext :: ![a], callFunction :: !a, callParams :: ![a], callBlock :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Call where liftEq = genericLiftEq
 instance Ord1 Call where liftCompare = genericLiftCompare
@@ -31,7 +31,7 @@ data Comparison a
   | Equal !a !a
   | StrictEqual !a !a
   | Comparison !a !a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Comparison where liftEq = genericLiftEq
 instance Ord1 Comparison where liftCompare = genericLiftCompare
@@ -62,7 +62,7 @@ data Arithmetic a
   | Modulo !a !a
   | Power !a !a
   | Negate !a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Arithmetic where liftEq = genericLiftEq
 instance Ord1 Arithmetic where liftCompare = genericLiftCompare
@@ -85,7 +85,7 @@ instance Evaluatable Arithmetic where
 data Match a
   = Matches !a !a
   | NotMatches !a !a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Match where liftEq = genericLiftEq
 instance Ord1 Match where liftCompare = genericLiftCompare
@@ -102,7 +102,7 @@ data Boolean a
   | And !a !a
   | Not !a
   | XOr !a !a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Boolean where liftEq = genericLiftEq
 instance Ord1 Boolean where liftCompare = genericLiftCompare
@@ -119,12 +119,12 @@ instance Evaluatable Boolean where
     go (Or a b) = do
       cond <- a
       ifthenelse cond (pure cond) b
-    go (Not a) = a >>= asBool >>= boolean . not
-    go (XOr a b) = liftA2 (/=) (a >>= asBool) (b >>= asBool) >>= boolean
+    go (Not a) = a >>= fmap (boolean . not) . asBool
+    go (XOr a b) = boolean <$> liftA2 (/=) (a >>= asBool) (b >>= asBool)
 
 -- | Javascript delete operator
 newtype Delete a = Delete a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Delete where liftEq = genericLiftEq
 instance Ord1 Delete where liftCompare = genericLiftCompare
@@ -138,7 +138,7 @@ instance Evaluatable Delete
 
 -- | A sequence expression such as Javascript or C's comma operator.
 data SequenceExpression a = SequenceExpression { _firstExpression :: !a, _secondExpression :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 SequenceExpression where liftEq = genericLiftEq
 instance Ord1 SequenceExpression where liftCompare = genericLiftCompare
@@ -152,7 +152,7 @@ instance Evaluatable SequenceExpression
 
 -- | Javascript void operator
 newtype Void a = Void a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Void where liftEq = genericLiftEq
 instance Ord1 Void where liftCompare = genericLiftCompare
@@ -166,7 +166,7 @@ instance Evaluatable Void
 
 -- | Javascript typeof operator
 newtype Typeof a = Typeof a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Typeof where liftEq = genericLiftEq
 instance Ord1 Typeof where liftCompare = genericLiftCompare
@@ -187,7 +187,7 @@ data Bitwise a
   | RShift !a !a
   | UnsignedRShift !a !a
   | Complement a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Bitwise where liftEq = genericLiftEq
 instance Ord1 Bitwise where liftCompare = genericLiftCompare
@@ -211,7 +211,7 @@ instance Evaluatable Bitwise where
 -- | Member Access (e.g. a.b)
 data MemberAccess a
   = MemberAccess !a !a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 MemberAccess where liftEq = genericLiftEq
 instance Ord1 MemberAccess where liftCompare = genericLiftCompare
@@ -231,7 +231,7 @@ instance Evaluatable MemberAccess where
 data Subscript a
   = Subscript !a ![a]
   | Member !a !a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Subscript where liftEq = genericLiftEq
 instance Ord1 Subscript where liftCompare = genericLiftCompare
@@ -249,7 +249,7 @@ instance Evaluatable Subscript where
 
 -- | Enumeration (e.g. a[1:10:1] in Python (start at index 1, stop at index 10, step 1 element from start to stop))
 data Enumeration a = Enumeration { enumerationStart :: !a, enumerationEnd :: !a, enumerationStep :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Enumeration where liftEq = genericLiftEq
 instance Ord1 Enumeration where liftCompare = genericLiftCompare
@@ -263,7 +263,7 @@ instance Evaluatable Enumeration
 
 -- | InstanceOf (e.g. a instanceof b in JavaScript
 data InstanceOf a = InstanceOf { instanceOfSubject :: !a, instanceOfObject :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 InstanceOf where liftEq = genericLiftEq
 instance Ord1 InstanceOf where liftCompare = genericLiftCompare
@@ -277,7 +277,7 @@ instance Evaluatable InstanceOf
 
 -- | ScopeResolution (e.g. import a.b in Python or a::b in C++)
 newtype ScopeResolution a = ScopeResolution [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 ScopeResolution where liftEq = genericLiftEq
 instance Ord1 ScopeResolution where liftCompare = genericLiftCompare
@@ -291,7 +291,7 @@ instance Evaluatable ScopeResolution
 
 -- | A non-null expression such as Typescript or Swift's ! expression.
 newtype NonNullExpression a = NonNullExpression { nonNullExpression :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 NonNullExpression where liftEq = genericLiftEq
 instance Ord1 NonNullExpression where liftCompare = genericLiftCompare
@@ -305,7 +305,7 @@ instance Evaluatable NonNullExpression
 
 -- | An await expression in Javascript or C#.
 newtype Await a = Await { awaitSubject :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Await where liftEq = genericLiftEq
 instance Ord1 Await where liftCompare = genericLiftCompare
@@ -319,7 +319,7 @@ instance Evaluatable Await
 
 -- | An object constructor call in Javascript, Java, etc.
 newtype New a = New { newSubject :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 New where liftEq = genericLiftEq
 instance Ord1 New where liftCompare = genericLiftCompare
@@ -333,7 +333,7 @@ instance Evaluatable New
 
 -- | A cast expression to a specified type.
 data Cast a =  Cast { castSubject :: !a, castType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Cast where liftEq = genericLiftEq
 instance Ord1 Cast where liftCompare = genericLiftCompare

src/Data/Syntax/Literal.hs

@@ -15,7 +15,7 @@ import           Text.Read (readMaybe)
 -- Boolean
 
 newtype Boolean a = Boolean { booleanContent :: Bool }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Generic, Named, Message1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named, Message1)
 
 true :: Boolean a
 true = Boolean True
@@ -28,7 +28,7 @@ instance Ord1 Boolean where liftCompare = genericLiftCompare
 instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Boolean where
-  eval (Boolean x) = Rval <$> boolean x
+  eval (Boolean x) = pure (Rval (boolean x))
 
 instance ToJSONFields1 Boolean where
   toJSONFields1 (Boolean b) = noChildren [ "value" .= b ]
@@ -37,7 +37,7 @@ instance ToJSONFields1 Boolean where
 
 -- | A literal integer of unspecified width. No particular base is implied.
 newtype Integer a = Integer { integerContent :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Data.Syntax.Literal.Integer where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Literal.Integer where liftCompare = genericLiftCompare
@@ -46,7 +46,7 @@ instance Show1 Data.Syntax.Literal.Integer where liftShowsPrec = genericLiftShow
 instance Evaluatable Data.Syntax.Literal.Integer where
   -- TODO: This instance probably shouldn't have readInteger?
   eval (Data.Syntax.Literal.Integer x) =
-    Rval <$> (integer =<< maybeM (throwEvalError (IntegerFormatError x)) (fst <$> readInteger x))
+    Rval . integer <$> maybeM (throwEvalError (IntegerFormatError x)) (fst <$> readInteger x)
 
 instance ToJSONFields1 Data.Syntax.Literal.Integer where
   toJSONFields1 (Integer i) = noChildren ["asString" .= unpack i]
@@ -58,7 +58,7 @@ instance ToJSONFields1 Data.Syntax.Literal.Integer where
 
 -- | A literal float of unspecified width.
 newtype Float a = Float { floatContent  :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Generic, Named, Message1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named, Message1)
 
 instance Eq1 Data.Syntax.Literal.Float where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Literal.Float where liftCompare = genericLiftCompare
@@ -66,14 +66,14 @@ instance Show1 Data.Syntax.Literal.Float where liftShowsPrec = genericLiftShowsP
 
 instance Evaluatable Data.Syntax.Literal.Float where
   eval (Float s) =
-    Rval <$> (float =<< either (const (throwEvalError (FloatFormatError s))) pure (parseScientific s))
+    Rval . float <$> either (const (throwEvalError (FloatFormatError s))) pure (parseScientific s)
 
 instance ToJSONFields1 Float where
   toJSONFields1 (Float f) = noChildren ["asString" .= unpack f]
 
 -- Rational literals e.g. `2/3r`
 newtype Rational a = Rational ByteString
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Data.Syntax.Literal.Rational where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Literal.Rational where liftCompare = genericLiftCompare
@@ -84,14 +84,14 @@ instance Evaluatable Data.Syntax.Literal.Rational where
     let
       trimmed = B.takeWhile (/= 'r') r
       parsed = readMaybe @Prelude.Integer (unpack trimmed)
-    in Rval <$> (rational =<< maybe (throwEvalError (RationalFormatError r)) (pure . toRational) parsed)
+    in Rval . rational <$> maybe (throwEvalError (RationalFormatError r)) (pure . toRational) parsed
 
 instance ToJSONFields1 Data.Syntax.Literal.Rational where
   toJSONFields1 (Rational r) = noChildren ["asString" .= unpack r]
 
 -- Complex literals e.g. `3 + 2i`
 newtype Complex a = Complex ByteString
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Data.Syntax.Literal.Complex where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Literal.Complex where liftCompare = genericLiftCompare
@@ -106,7 +106,7 @@ instance ToJSONFields1 Complex where
 -- Strings, symbols
 
 newtype String a = String { stringElements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Data.Syntax.Literal.String where liftEq = genericLiftEq
 instance Ord1 Data.Syntax.Literal.String where liftCompare = genericLiftCompare
@@ -121,7 +121,7 @@ instance ToJSONFields1 Data.Syntax.Literal.String
 
 -- | An interpolation element within a string literal.
 newtype InterpolationElement a = InterpolationElement { interpolationBody :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 InterpolationElement where liftEq = genericLiftEq
 instance Ord1 InterpolationElement where liftCompare = genericLiftCompare
@@ -134,7 +134,7 @@ instance ToJSONFields1 InterpolationElement
 
 -- | A sequence of textual contents within a string literal.
 newtype TextElement a = TextElement { textElementContent :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Generic, Named, Message1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named, Message1)
 
 instance Eq1 TextElement where liftEq = genericLiftEq
 instance Ord1 TextElement where liftCompare = genericLiftCompare
@@ -144,21 +144,21 @@ instance ToJSONFields1 TextElement where
   toJSONFields1 (TextElement c) = noChildren ["asString" .= unpack c]
 
 instance Evaluatable TextElement where
-  eval (TextElement x) = Rval <$> string x
+  eval (TextElement x) = pure (Rval (string x))
 
 data Null a = Null
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Generic, Named, Message1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named, Message1)
 
 instance Eq1 Null where liftEq = genericLiftEq
 instance Ord1 Null where liftCompare = genericLiftCompare
 instance Show1 Null where liftShowsPrec = genericLiftShowsPrec
 
-instance Evaluatable Null where eval _ = Rval <$> null
+instance Evaluatable Null where eval _ = pure (Rval null)
 
 instance ToJSONFields1 Null
 
 newtype Symbol a = Symbol { symbolContent :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Symbol where liftEq = genericLiftEq
 instance Ord1 Symbol where liftCompare = genericLiftCompare
@@ -167,10 +167,10 @@ instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec
 instance ToJSONFields1 Symbol
 
 instance Evaluatable Symbol where
-  eval (Symbol s) = Rval <$> symbol s
+  eval (Symbol s) = pure (Rval (symbol s))
 
 newtype Regex a = Regex { regexContent :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Regex where liftEq = genericLiftEq
 instance Ord1 Regex where liftCompare = genericLiftCompare
@@ -190,7 +190,7 @@ instance Evaluatable Regex
 -- Collections
 
 newtype Array a = Array { arrayElements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Generic, Named, Message1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named, Message1)
 
 instance Eq1 Array where liftEq = genericLiftEq
 instance Ord1 Array where liftCompare = genericLiftCompare
@@ -202,7 +202,7 @@ instance Evaluatable Array where
   eval (Array a) = Rval <$> (array =<< traverse subtermValue a)
 
 newtype Hash a = Hash { hashElements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Generic, Named, Message1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named, Message1)
 
 instance Eq1 Hash where liftEq = genericLiftEq
 instance Ord1 Hash where liftCompare = genericLiftCompare
@@ -211,10 +211,10 @@ instance Show1 Hash where liftShowsPrec = genericLiftShowsPrec
 instance ToJSONFields1 Hash
 
 instance Evaluatable Hash where
-  eval t = Rval <$> (traverse (subtermValue >=> asPair) (hashElements t) >>= hash)
+  eval t = Rval . hash <$> traverse (subtermValue >=> asPair) (hashElements t)
 
 data KeyValue a = KeyValue { key :: !a, value :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Generic, Named, Message1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, Named, Message1)
 
 instance Eq1 KeyValue where liftEq = genericLiftEq
 instance Ord1 KeyValue where liftCompare = genericLiftCompare
@@ -224,22 +224,22 @@ instance ToJSONFields1 KeyValue
 
 instance Evaluatable KeyValue where
   eval (fmap subtermValue -> KeyValue{..}) =
-    Rval <$> join (kvPair <$> key <*> value)
+    Rval <$> (kvPair <$> key <*> value)
 
 instance ToJSONFields1 Tuple
 
 newtype Tuple a = Tuple { tupleContents :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Tuple where liftEq = genericLiftEq
 instance Ord1 Tuple where liftCompare = genericLiftCompare
 instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Tuple where
-  eval (Tuple cs) = Rval <$> (multiple =<< traverse subtermValue cs)
+  eval (Tuple cs) = Rval . multiple <$> traverse subtermValue cs
 
 newtype Set a = Set { setElements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Set where liftEq = genericLiftEq
 instance Ord1 Set where liftCompare = genericLiftCompare
@@ -255,7 +255,7 @@ instance Evaluatable Set
 
 -- | A declared pointer (e.g. var pointer *int in Go)
 newtype Pointer a = Pointer a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Pointer where liftEq = genericLiftEq
 instance Ord1 Pointer where liftCompare = genericLiftCompare
@@ -269,7 +269,7 @@ instance Evaluatable Pointer
 
 -- | A reference to a pointer's address (e.g. &pointer in Go)
 newtype Reference a = Reference a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Reference where liftEq = genericLiftEq
 instance Ord1 Reference where liftCompare = genericLiftCompare

src/Data/Syntax/Statement.hs

@@ -1,8 +1,6 @@
 {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, ViewPatterns #-}
 module Data.Syntax.Statement where
 
-import Control.Abstract.Evaluator (ValueRef(..))
-import qualified Data.Abstract.Environment as Env
 import Data.Abstract.Evaluatable
 import Data.ByteString.Char8 (unpack)
 import Data.JSON.Fields
@@ -12,7 +10,7 @@ import Prologue
 
 -- | Conditional. This must have an else block, which can be filled with some default value when omitted in the source, e.g. 'pure ()' for C-style if-without-else or 'pure Nothing' for Ruby-style, in both cases assuming some appropriate Applicative context into which the If will be lifted.
 data If a = If { ifCondition :: !a, ifThenBody :: !a, ifElseBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 If where liftEq = genericLiftEq
 instance Ord1 If where liftCompare = genericLiftCompare
@@ -27,7 +25,7 @@ instance Evaluatable If where
 
 -- | Else statement. The else condition is any term, that upon successful completion, continues evaluation to the elseBody, e.g. `for ... else` in Python.
 data Else a = Else { elseCondition :: !a, elseBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Else where liftEq = genericLiftEq
 instance Ord1 Else where liftCompare = genericLiftCompare
@@ -42,7 +40,7 @@ instance Evaluatable Else
 
 -- | Goto statement (e.g. `goto a` in Go).
 newtype Goto a = Goto { gotoLocation :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Goto where liftEq = genericLiftEq
 instance Ord1 Goto where liftCompare = genericLiftCompare
@@ -56,7 +54,7 @@ instance Evaluatable Goto
 
 -- | A pattern-matching or computed jump control-flow statement, like 'switch' in C or JavaScript, or 'case' in Ruby or Haskell.
 data Match a = Match { matchSubject :: !a, matchPatterns :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Match where liftEq = genericLiftEq
 instance Ord1 Match where liftCompare = genericLiftCompare
@@ -70,7 +68,7 @@ instance Evaluatable Match
 
 -- | A pattern in a pattern-matching or computed jump control-flow statement, like 'case' in C or JavaScript, 'when' in Ruby, or the left-hand side of '->' in the body of Haskell 'case' expressions.
 data Pattern a = Pattern { _pattern :: !a, patternBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Pattern where liftEq = genericLiftEq
 instance Ord1 Pattern where liftCompare = genericLiftCompare
@@ -84,7 +82,7 @@ instance Evaluatable Pattern
 
 -- | A let statement or local binding, like 'a as b' or 'let a = b'.
 data Let a  = Let { letVariable :: !a, letValue :: !a, letBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Let where liftEq = genericLiftEq
 instance Ord1 Let where liftCompare = genericLiftCompare
@@ -96,14 +94,14 @@ instance Evaluatable Let where
   eval Let{..} = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm letVariable)
     addr <- snd <$> letrec name (subtermValue letValue)
-    Rval <$> localEnv (Env.insert name addr) (subtermValue letBody)
+    Rval <$> locally (bind name addr *> subtermValue letBody)
 
 
 -- Assignment
 
 -- | Assignment to a variable or other lvalue.
 data Assignment a = Assignment { assignmentContext :: ![a], assignmentTarget :: !a, assignmentValue :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Assignment where liftEq = genericLiftEq
 instance Ord1 Assignment where liftCompare = genericLiftCompare
@@ -120,7 +118,7 @@ instance Evaluatable Assignment where
       LvalLocal nam -> do
         addr <- lookupOrAlloc nam
         assign addr rhs
-        modifyEnv (Env.insert nam addr)
+        bind nam addr
       LvalMember _ _ ->
         -- we don't yet support mutable object properties:
         pure ()
@@ -132,7 +130,7 @@ instance Evaluatable Assignment where
 
 -- | Post increment operator (e.g. 1++ in Go, or i++ in C).
 newtype PostIncrement a = PostIncrement a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 PostIncrement where liftEq = genericLiftEq
 instance Ord1 PostIncrement where liftCompare = genericLiftCompare
@@ -146,7 +144,7 @@ instance Evaluatable PostIncrement
 
 -- | Post decrement operator (e.g. 1-- in Go, or i-- in C).
 newtype PostDecrement a = PostDecrement a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 PostDecrement where liftEq = genericLiftEq
 instance Ord1 PostDecrement where liftCompare = genericLiftCompare
@@ -161,7 +159,7 @@ instance Evaluatable PostDecrement
 -- Returns
 
 newtype Return a = Return a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Return where liftEq = genericLiftEq
 instance Ord1 Return where liftCompare = genericLiftCompare
@@ -173,7 +171,7 @@ instance Evaluatable Return where
   eval (Return x) = Rval <$> (subtermValue x >>= earlyReturn)
 
 newtype Yield a = Yield a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Yield where liftEq = genericLiftEq
 instance Ord1 Yield where liftCompare = genericLiftCompare
@@ -186,7 +184,7 @@ instance Evaluatable Yield
 
 
 newtype Break a = Break a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Break where liftEq = genericLiftEq
 instance Ord1 Break where liftCompare = genericLiftCompare
@@ -198,7 +196,7 @@ instance Evaluatable Break where
   eval (Break x) = Rval <$> (subtermValue x >>= throwBreak)
 
 newtype Continue a = Continue a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Continue where liftEq = genericLiftEq
 instance Ord1 Continue where liftCompare = genericLiftCompare
@@ -210,7 +208,7 @@ instance Evaluatable Continue where
   eval (Continue a) = Rval <$> (subtermValue a >>= throwContinue)
 
 newtype Retry a = Retry a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Retry where liftEq = genericLiftEq
 instance Ord1 Retry where liftCompare = genericLiftCompare
@@ -223,7 +221,7 @@ instance Evaluatable Retry
 
 
 newtype NoOp a = NoOp a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 NoOp where liftEq = genericLiftEq
 instance Ord1 NoOp where liftCompare = genericLiftCompare
@@ -232,12 +230,12 @@ instance Show1 NoOp where liftShowsPrec = genericLiftShowsPrec
 instance ToJSONFields1 NoOp
 
 instance Evaluatable NoOp where
-  eval _ = Rval <$> unit
+  eval _ = pure (Rval unit)
 
 -- Loops
 
 data For a = For { forBefore :: !a, forCondition :: !a, forStep :: !a, forBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 For where liftEq = genericLiftEq
 instance Ord1 For where liftCompare = genericLiftCompare
@@ -250,7 +248,7 @@ instance Evaluatable For where
 
 
 data ForEach a = ForEach { forEachBinding :: !a, forEachSubject :: !a, forEachBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 ForEach where liftEq = genericLiftEq
 instance Ord1 ForEach where liftCompare = genericLiftCompare
@@ -263,7 +261,7 @@ instance Evaluatable ForEach
 
 
 data While a = While { whileCondition :: !a, whileBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 While where liftEq = genericLiftEq
 instance Ord1 While where liftCompare = genericLiftCompare
@@ -275,7 +273,7 @@ instance Evaluatable While where
   eval While{..} = Rval <$> while (subtermValue whileCondition) (subtermValue whileBody)
 
 data DoWhile a = DoWhile { doWhileCondition :: !a, doWhileBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 DoWhile where liftEq = genericLiftEq
 instance Ord1 DoWhile where liftCompare = genericLiftCompare
@@ -289,7 +287,7 @@ instance Evaluatable DoWhile where
 -- Exception handling
 
 newtype Throw a = Throw a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Throw where liftEq = genericLiftEq
 instance Ord1 Throw where liftCompare = genericLiftCompare
@@ -302,7 +300,7 @@ instance Evaluatable Throw
 
 
 data Try a = Try { tryBody :: !a, tryCatch :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Try where liftEq = genericLiftEq
 instance Ord1 Try where liftCompare = genericLiftCompare
@@ -315,7 +313,7 @@ instance Evaluatable Try
 
 
 data Catch a = Catch { catchException :: !a, catchBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Catch where liftEq = genericLiftEq
 instance Ord1 Catch where liftCompare = genericLiftCompare
@@ -328,7 +326,7 @@ instance Evaluatable Catch
 
 
 newtype Finally a = Finally a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Finally where liftEq = genericLiftEq
 instance Ord1 Finally where liftCompare = genericLiftCompare
@@ -344,7 +342,7 @@ instance Evaluatable Finally
 
 -- | ScopeEntry (e.g. `BEGIN {}` block in Ruby or Perl).
 newtype ScopeEntry a = ScopeEntry [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 ScopeEntry where liftEq = genericLiftEq
 instance Ord1 ScopeEntry where liftCompare = genericLiftCompare
@@ -358,7 +356,7 @@ instance Evaluatable ScopeEntry
 
 -- | ScopeExit (e.g. `END {}` block in Ruby or Perl).
 newtype ScopeExit a = ScopeExit [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 ScopeExit where liftEq = genericLiftEq
 instance Ord1 ScopeExit where liftCompare = genericLiftCompare
@@ -371,7 +369,7 @@ instance Evaluatable ScopeExit
 
 -- | HashBang line (e.g. `#!/usr/bin/env node`)
 newtype HashBang a = HashBang ByteString
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 HashBang where liftEq = genericLiftEq
 instance Ord1 HashBang where liftCompare = genericLiftCompare

src/Data/Syntax/Type.hs

@@ -7,7 +7,7 @@ import Diffing.Algorithm
 import Prologue hiding (Map)
 
 data Array a = Array { arraySize :: Maybe a, arrayElementType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Array where liftEq = genericLiftEq
 instance Ord1 Array where liftCompare = genericLiftCompare
@@ -21,7 +21,7 @@ instance Evaluatable Array
 
 -- TODO: What about type variables? re: FreeVariables1
 data Annotation a = Annotation { annotationSubject :: !a, annotationType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Annotation where liftEq = genericLiftEq
 instance Ord1 Annotation where liftCompare = genericLiftCompare
@@ -35,7 +35,7 @@ instance Evaluatable Annotation where
 
 
 data Function a = Function { functionParameters :: [a], functionReturn :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Function where liftEq = genericLiftEq
 instance Ord1 Function where liftCompare = genericLiftCompare
@@ -48,7 +48,7 @@ instance Evaluatable Function
 
 
 newtype Interface a = Interface [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Interface where liftEq = genericLiftEq
 instance Ord1 Interface where liftCompare = genericLiftCompare
@@ -61,7 +61,7 @@ instance Evaluatable Interface
 
 
 data Map a = Map { mapKeyType :: a, mapElementType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Map where liftEq = genericLiftEq
 instance Ord1 Map where liftCompare = genericLiftCompare
@@ -74,7 +74,7 @@ instance Evaluatable Map
 
 
 newtype Parenthesized a = Parenthesized a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Parenthesized where liftEq = genericLiftEq
 instance Ord1 Parenthesized where liftCompare = genericLiftCompare
@@ -87,7 +87,7 @@ instance Evaluatable Parenthesized
 
 
 newtype Pointer a = Pointer a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Pointer where liftEq = genericLiftEq
 instance Ord1 Pointer where liftCompare = genericLiftCompare
@@ -100,7 +100,7 @@ instance Evaluatable Pointer
 
 
 newtype Product a = Product [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Product where liftEq = genericLiftEq
 instance Ord1 Product where liftCompare = genericLiftCompare
@@ -113,7 +113,7 @@ instance Evaluatable Product
 
 
 data Readonly a = Readonly
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Readonly where liftEq = genericLiftEq
 instance Ord1 Readonly where liftCompare = genericLiftCompare
@@ -126,7 +126,7 @@ instance Evaluatable Readonly
 
 
 newtype Slice a = Slice a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Slice where liftEq = genericLiftEq
 instance Ord1 Slice where liftCompare = genericLiftCompare
@@ -139,7 +139,7 @@ instance Evaluatable Slice
 
 
 newtype TypeParameters a = TypeParameters [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 TypeParameters where liftEq = genericLiftEq
 instance Ord1 TypeParameters where liftCompare = genericLiftCompare

src/Diffing/Algorithm.hs

@@ -1,5 +1,4 @@
-{-# LANGUAGE DataKinds, DefaultSignatures, GADTs, RankNTypes, TypeOperators, UndecidableInstances #-}
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- FIXME
+{-# LANGUAGE DefaultSignatures, GADTs, TypeOperators, UndecidableInstances #-}
 module Diffing.Algorithm where
 
 import Control.Monad.Free.Freer
@@ -143,6 +142,10 @@ class Diffable f where
                  -> Algorithm term1 term2 result (f result)
   algorithmFor = genericAlgorithmFor
 
+  tryAlignWith :: Alternative g => (These a1 a2 -> g b) -> f a1 -> f a2 -> g (f b)
+  default tryAlignWith :: (Alternative g, Generic1 f, GDiffable (Rep1 f)) => (These a1 a2 -> g b) -> f a1 -> f a2 -> g (f b)
+  tryAlignWith f a b = to1 <$> gtryAlignWith f (from1 a) (from1 b)
+
   -- | Construct an algorithm to diff against positions inside an @f@.
   --
   --   This is very like 'traverse', with two key differences:
@@ -190,6 +193,8 @@ genericComparableTo a1 a2 = gcomparableTo (from1 a1) (from1 a2)
 instance Apply Diffable fs => Diffable (Sum fs) where
   algorithmFor u1 u2 = fromMaybe empty (apply2' @Diffable (\ inj f1 f2 -> inj <$> algorithmFor f1 f2) u1 u2)
 
+  tryAlignWith f u1 u2 = fromMaybe empty (apply2' @Diffable (\ inj t1 t2 -> inj <$> tryAlignWith f t1 t2) u1 u2)
+
   subalgorithmFor blur focus = apply' @Diffable (\ inj f -> inj <$> subalgorithmFor blur focus f)
 
   equivalentBySubterm = apply @Diffable equivalentBySubterm
@@ -201,18 +206,31 @@ instance Apply Diffable fs => Diffable (Sum fs) where
 instance Diffable Maybe where
   algorithmFor = diffMaybe
 
+  tryAlignWith f (Just a1) (Just a2) = Just <$> f (These a1 a2)
+  tryAlignWith f (Just a1) Nothing   = Just <$> f (This a1)
+  tryAlignWith f Nothing   (Just a2) = Just <$> f (That a2)
+  tryAlignWith _ Nothing   Nothing   = pure Nothing
+
 -- | Diff two lists using RWS.
 instance Diffable [] where
   algorithmFor = byRWS
 
+  tryAlignWith f (a1:as1) (a2:as2) = (:) <$> f (These a1 a2) <*> tryAlignWith f as1 as2
+  tryAlignWith f []       as2      = traverse (f . That) as2
+  tryAlignWith f as1      []       = traverse (f . This) as1
+
 -- | Diff two non-empty lists using RWS.
 instance Diffable NonEmpty where
-  algorithmFor (a1:|as1) (a2:|as2) = (\ (a:as) -> a:|as) <$> byRWS (a1:as1) (a2:as2)
+  algorithmFor (a1:|as1) (a2:|as2) = nonEmpty <$> byRWS (a1:as1) (a2:as2) >>= maybe empty pure
+
+  tryAlignWith f (a1:|as1) (a2:|as2) = (:|) <$> f (These a1 a2) <*> tryAlignWith f as1 as2
 
 -- | A generic type class for diffing two terms defined by the Generic1 interface.
 class GDiffable f where
   galgorithmFor :: f term1 -> f term2 -> Algorithm term1 term2 result (f result)
 
+  gtryAlignWith :: Alternative g => (These a1 a2 -> g b) -> f a1 -> f a2 -> g (f b)
+
   gcomparableTo :: f term1 -> f term2 -> Bool
   gcomparableTo _ _ = True
 
@@ -220,6 +238,8 @@ class GDiffable f where
 instance GDiffable f => GDiffable (M1 i c f) where
   galgorithmFor (M1 a1) (M1 a2) = M1 <$> galgorithmFor a1 a2
 
+  gtryAlignWith f (M1 a) (M1 b) = M1 <$> gtryAlignWith f a b
+
   gcomparableTo (M1 a1) (M1 a2) = gcomparableTo a1 a2
 
 -- | Diff the fields of a product type.
@@ -227,6 +247,8 @@ instance GDiffable f => GDiffable (M1 i c f) where
 instance (GDiffable f, GDiffable g) => GDiffable (f :*: g) where
   galgorithmFor (a1 :*: b1) (a2 :*: b2) = (:*:) <$> galgorithmFor a1 a2 <*> galgorithmFor b1 b2
 
+  gtryAlignWith f (a1 :*: b1) (a2 :*: b2) = (:*:) <$> gtryAlignWith f a1 a2 <*> gtryAlignWith f b1 b2
+
 -- | Diff the constructors of a sum type.
 -- i.e. data Foo a = Foo a | Bar a (the 'Foo a' is captured by L1 and 'Bar a' is R1).
 instance (GDiffable f, GDiffable g) => GDiffable (f :+: g) where
@@ -234,6 +256,11 @@ instance (GDiffable f, GDiffable g) => GDiffable (f :+: g) where
   galgorithmFor (R1 b1) (R1 b2) = R1 <$> galgorithmFor b1 b2
   galgorithmFor _ _ = empty
 
+  gtryAlignWith f a b = case (a, b) of
+    (L1 a, L1 b) -> L1 <$> gtryAlignWith f a b
+    (R1 a, R1 b) -> R1 <$> gtryAlignWith f a b
+    _ -> empty
+
   gcomparableTo (L1 _) (L1 _) = True
   gcomparableTo (R1 _) (R1 _) = True
   gcomparableTo _      _      = False
@@ -243,18 +270,26 @@ instance (GDiffable f, GDiffable g) => GDiffable (f :+: g) where
 instance GDiffable Par1 where
   galgorithmFor (Par1 a1) (Par1 a2) = Par1 <$> diff a1 a2
 
+  gtryAlignWith f (Par1 a) (Par1 b) = Par1 <$> f (These a b)
+
 -- | Diff two constant parameters (K1 is the Generic1 newtype representing type parameter constants).
 -- i.e. data Foo = Foo Int (the 'Int' is a constant parameter).
 instance Eq c => GDiffable (K1 i c) where
   galgorithmFor (K1 a1) (K1 a2) = guard (a1 == a2) $> K1 a1
 
+  gtryAlignWith _ (K1 a) (K1 b) = guard (a == b) $> K1 b
+
 -- | Diff two terms whose constructors contain 0 type parameters.
 -- i.e. data Foo = Foo.
 instance GDiffable U1 where
   galgorithmFor _ _ = pure U1
 
+  gtryAlignWith _ _ _ = pure U1
+
 -- | Diff two 'Diffable' containers of parameters.
 instance Diffable f => GDiffable (Rec1 f) where
   galgorithmFor a1 a2 = Rec1 <$> algorithmFor (unRec1 a1) (unRec1 a2)
 
+  gtryAlignWith f (Rec1 a) (Rec1 b) = Rec1 <$> tryAlignWith f a b
+
 {-# ANN module ("HLint: ignore Avoid return" :: String) #-}

src/Diffing/Algorithm/RWS.hs

@@ -14,23 +14,23 @@ module Diffing.Algorithm.RWS
 , equalTerms
 ) where
 
-import Prologue
-import Data.Align.Generic (galignWith)
 import Control.Monad.State.Strict
 import Data.Diff (DiffF(..), deleting, inserting, merge, replacing)
 import qualified Data.KdMap.Static as KdMap
 import Data.List (sortOn)
 import Data.Record
 import Data.Term as Term
+import Diffing.Algorithm
 import Diffing.Algorithm.RWS.FeatureVector
 import Diffing.Algorithm.SES
+import Prologue
 
 -- | A relation on 'Term's, guaranteed constant-time in the size of the 'Term' by parametricity.
 --
 --   This is used both to determine whether two root terms can be compared in O(1), and, recursively, to determine whether two nodes are equal in O(n); thus, comparability is defined s.t. two terms are equal if they are recursively comparable subterm-wise.
 type ComparabilityRelation syntax ann1 ann2 = forall a b. TermF syntax ann1 a -> TermF syntax ann2 b -> Bool
 
-rws :: (Foldable syntax, Functor syntax, GAlign syntax)
+rws :: (Foldable syntax, Functor syntax, Diffable syntax)
     => ComparabilityRelation syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2))
     -> (Term syntax (Record (FeatureVector ': fields1)) -> Term syntax (Record (FeatureVector ': fields2)) -> Bool)
     -> [Term syntax (Record (FeatureVector ': fields1))]
@@ -153,13 +153,13 @@ equalTerms canCompare = go
 -- | Return an edit distance between two terms, up to a certain depth.
 --
 --   Computes a constant-time approximation to the edit distance of a diff. This is done by comparing at most _m_ nodes, & assuming the rest are zero-cost.
-editDistanceUpTo :: (GAlign syntax, Foldable syntax, Functor syntax) => Int -> Term syntax ann1 -> Term syntax ann2 -> Int
+editDistanceUpTo :: (Diffable syntax, Foldable syntax, Functor syntax) => Int -> Term syntax ann1 -> Term syntax ann2 -> Int
 editDistanceUpTo m a b = diffCost m (approximateDiff a b)
   where diffCost = flip . cata $ \ diff m -> case diff of
           _ | m <= 0 -> 0
           Merge body -> sum (fmap ($ pred m) body)
           body -> succ (sum (fmap ($ pred m) body))
-        approximateDiff a b = maybe (replacing a b) (merge (termAnnotation a, termAnnotation b)) (galignWith (Just . these deleting inserting approximateDiff) (termOut a) (termOut b))
+        approximateDiff a b = maybe (replacing a b) (merge (termAnnotation a, termAnnotation b)) (tryAlignWith (Just . these deleting inserting approximateDiff) (termOut a) (termOut b))
 
 
 data Label syntax where

src/Diffing/Interpreter.hs

@@ -1,11 +1,10 @@
-{-# LANGUAGE DataKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-}
+{-# LANGUAGE GADTs, RankNTypes, TypeOperators #-}
 module Diffing.Interpreter
 ( diffTerms
 , diffTermPair
 ) where
 
 import Control.Monad.Free.Freer
-import Data.Align.Generic (galignWith)
 import Data.Diff
 import Data.Record
 import Data.Term
@@ -14,7 +13,7 @@ import Diffing.Algorithm.RWS
 import Prologue
 
 -- | Diff two à la carte terms recursively.
-diffTerms :: (Diffable syntax, Eq1 syntax, GAlign syntax, Hashable1 syntax, Traversable syntax)
+diffTerms :: (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax)
           => Term syntax (Record fields1)
           -> Term syntax (Record fields2)
           -> Diff syntax (Record fields1) (Record fields2)
@@ -23,13 +22,12 @@ diffTerms t1 t2 = stripDiff (fromMaybe (replacing t1' t2') (runAlgorithm (diff t
                      , defaultFeatureVectorDecorator t2)
 
 -- | Diff a 'These' of terms.
-diffTermPair :: (Diffable syntax, Eq1 syntax, GAlign syntax, Hashable1 syntax, Traversable syntax) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Diff syntax (Record fields1) (Record fields2)
+diffTermPair :: (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Diff syntax (Record fields1) (Record fields2)
 diffTermPair = these deleting inserting diffTerms
 
 
 -- | Run an 'Algorithm' to completion in an 'Alternative' context using the supplied comparability & equivalence relations.
-runAlgorithm :: forall syntax fields1 fields2 m result
-             .  (Diffable syntax, Eq1 syntax, GAlign syntax, Traversable syntax, Alternative m, Monad m)
+runAlgorithm :: (Diffable syntax, Eq1 syntax, Traversable syntax, Alternative m, Monad m)
              => Algorithm
                   (Term syntax (Record (FeatureVector ': fields1)))
                   (Term syntax (Record (FeatureVector ': fields2)))
@@ -38,7 +36,7 @@ runAlgorithm :: forall syntax fields1 fields2 m result
              -> m result
 runAlgorithm = iterFreerA (\ yield step -> case step of
   Diffing.Algorithm.Diff t1 t2 -> runAlgorithm (algorithmForTerms t1 t2) <|> pure (replacing t1 t2) >>= yield
-  Linear (Term (In ann1 f1)) (Term (In ann2 f2)) -> merge (ann1, ann2) <$> galignWith (runAlgorithm . diffThese) f1 f2 >>= yield
+  Linear (Term (In ann1 f1)) (Term (In ann2 f2)) -> merge (ann1, ann2) <$> tryAlignWith (runAlgorithm . diffThese) f1 f2 >>= yield
   RWS as bs -> traverse (runAlgorithm . diffThese) (rws comparableTerms equivalentTerms as bs) >>= yield
   Delete a -> yield (deleting a)
   Insert b -> yield (inserting b)

src/Language/Go/Assignment.hs

@@ -7,7 +7,7 @@ module Language.Go.Assignment
 ) where
 
 import Assigning.Assignment hiding (Assignment, Error)
-import Data.Abstract.FreeVariables (name)
+import Data.Abstract.Name (name)
 import Data.Record
 import Data.Syntax (contextualize, emptyTerm, parseError, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1)
 import Language.Go.Grammar as Grammar

src/Language/Go/Syntax.hs

@@ -1,8 +1,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 module Language.Go.Syntax where
 
-import           Data.Abstract.Evaluatable hiding (Label)
-import           Data.Abstract.FreeVariables (Name (..), name)
+import           Data.Abstract.Evaluatable
 import           Data.Abstract.Module
 import qualified Data.Abstract.Package as Package
 import           Data.Abstract.Path
@@ -29,14 +28,14 @@ importPath str = let path = stripQuotes str in ImportPath (BC.unpack path) (path
 defaultAlias :: ImportPath -> Name
 defaultAlias = name . BC.pack . takeFileName . unPath
 
-resolveGoImport :: Members '[ Modules location value
-                            , Reader ModuleInfo
-                            , Reader Package.PackageInfo
-                            , Resumable ResolutionError
-                            , Trace
-                            ] effects
+resolveGoImport :: ( Member (Modules address value) effects
+                   , Member (Reader ModuleInfo) effects
+                   , Member (Reader Package.PackageInfo) effects
+                   , Member (Resumable ResolutionError) effects
+                   , Member Trace effects
+                   )
                 => ImportPath
-                -> Evaluator location value effects [ModulePath]
+                -> Evaluator address value effects [ModulePath]
 resolveGoImport (ImportPath path Relative) = do
   ModuleInfo{..} <- currentModule
   paths <- listModulesInDir (joinPaths (takeDirectory modulePath) path)
@@ -57,7 +56,7 @@ resolveGoImport (ImportPath path NonRelative) = do
 --
 -- If the list of symbols is empty copy everything to the calling environment.
 data Import a = Import { importFrom :: ImportPath, importWildcardToken :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Import where liftEq = genericLiftEq
 instance Ord1 Import where liftCompare = genericLiftCompare
@@ -71,15 +70,15 @@ instance Evaluatable Import where
     for_ paths $ \path -> do
       traceResolve (unPath importPath) path
       importedEnv <- maybe emptyEnv fst <$> isolate (require path)
-      modifyEnv (mergeEnvs importedEnv)
-    Rval <$> unit
+      bindAll importedEnv
+    pure (Rval unit)
 
 
 -- | Qualified Import declarations (symbols are qualified in calling environment).
 --
 -- If the list of symbols is empty copy and qualify everything to the calling environment.
 data QualifiedImport a = QualifiedImport { qualifiedImportFrom :: !ImportPath, qualifiedImportAlias :: !a}
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 QualifiedImport where liftEq = genericLiftEq
 instance Ord1 QualifiedImport where liftCompare = genericLiftCompare
@@ -95,13 +94,13 @@ instance Evaluatable QualifiedImport where
       for_ paths $ \p -> do
         traceResolve (unPath importPath) p
         importedEnv <- maybe emptyEnv fst <$> isolate (require p)
-        modifyEnv (mergeEnvs importedEnv)
+        bindAll importedEnv
       makeNamespace alias addr Nothing
-    Rval <$> unit
+    pure (Rval unit)
 
 -- | Side effect only imports (no symbols made available to the calling environment).
 data SideEffectImport a = SideEffectImport { sideEffectImportFrom :: !ImportPath, sideEffectImportToken :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 SideEffectImport where liftEq = genericLiftEq
 instance Ord1 SideEffectImport where liftCompare = genericLiftCompare
@@ -114,11 +113,11 @@ instance Evaluatable SideEffectImport where
     paths <- resolveGoImport importPath
     traceResolve (unPath importPath) paths
     for_ paths $ \path -> isolate (require path)
-    Rval <$> unit
+    pure (Rval unit)
 
 -- A composite literal in Go
 data Composite a = Composite { compositeType :: !a, compositeElement :: !a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Composite where liftEq = genericLiftEq
 instance Ord1 Composite where liftCompare = genericLiftCompare
@@ -131,7 +130,7 @@ 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, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 DefaultPattern where liftEq = genericLiftEq
 instance Ord1 DefaultPattern where liftCompare = genericLiftCompare
@@ -144,7 +143,7 @@ instance Evaluatable DefaultPattern
 
 -- | A defer statement in Go (e.g. `defer x()`).
 newtype Defer a = Defer { deferBody :: a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Defer where liftEq = genericLiftEq
 instance Ord1 Defer where liftCompare = genericLiftCompare
@@ -157,7 +156,7 @@ 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, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Go where liftEq = genericLiftEq
 instance Ord1 Go where liftCompare = genericLiftCompare
@@ -170,7 +169,7 @@ instance Evaluatable Go
 
 -- | A label statement in Go (e.g. `label:continue`).
 data Label a = Label { _labelName :: !a, labelStatement :: !a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Label where liftEq = genericLiftEq
 instance Ord1 Label where liftCompare = genericLiftCompare
@@ -183,7 +182,7 @@ instance Evaluatable Label
 
 -- | A rune literal in Go (e.g. `'⌘'`).
 newtype Rune a = Rune { _runeLiteral :: ByteString }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Rune
 
@@ -196,7 +195,7 @@ 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).
 newtype Select a = Select { selectCases :: a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Select
 
@@ -209,7 +208,7 @@ 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, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Send where liftEq = genericLiftEq
 instance Ord1 Send where liftCompare = genericLiftCompare
@@ -222,7 +221,7 @@ 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, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Slice where liftEq = genericLiftEq
 instance Ord1 Slice where liftCompare = genericLiftCompare
@@ -235,7 +234,7 @@ 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, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 TypeSwitch where liftEq = genericLiftEq
 instance Ord1 TypeSwitch where liftCompare = genericLiftCompare
@@ -248,7 +247,7 @@ 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, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 TypeSwitchGuard where liftEq = genericLiftEq
 instance Ord1 TypeSwitchGuard where liftCompare = genericLiftCompare
@@ -261,7 +260,7 @@ 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, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Receive where liftEq = genericLiftEq
 instance Ord1 Receive where liftCompare = genericLiftCompare
@@ -274,7 +273,7 @@ instance Evaluatable Receive
 
 -- | A receive operator unary expression in Go (e.g. `<-channel` )
 newtype ReceiveOperator a = ReceiveOperator a
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 ReceiveOperator where liftEq = genericLiftEq
 instance Ord1 ReceiveOperator where liftCompare = genericLiftCompare
@@ -287,7 +286,7 @@ instance Evaluatable ReceiveOperator
 
 -- | A field declaration in a Go struct type declaration.
 data Field a = Field { fieldContext :: ![a], fieldName :: !a }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Field where liftEq = genericLiftEq
 instance Ord1 Field where liftCompare = genericLiftCompare
@@ -300,7 +299,7 @@ instance Evaluatable Field
 
 
 data Package a = Package { packageName :: !a, packageContents :: ![a] }
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Package where liftEq = genericLiftEq
 instance Ord1 Package where liftCompare = genericLiftCompare
@@ -314,7 +313,7 @@ instance Evaluatable Package where
 
 -- | 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, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 TypeAssertion where liftEq = genericLiftEq
 instance Ord1 TypeAssertion where liftCompare = genericLiftCompare
@@ -327,7 +326,7 @@ 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, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 TypeConversion where liftEq = genericLiftEq
 instance Ord1 TypeConversion where liftCompare = genericLiftCompare
@@ -340,7 +339,7 @@ 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, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Variadic where liftEq = genericLiftEq
 instance Ord1 Variadic where liftCompare = genericLiftCompare

src/Language/Go/Type.hs

@@ -8,7 +8,7 @@ import Diffing.Algorithm
 
 -- | A Bidirectional channel in Go (e.g. `chan`).
 newtype BidirectionalChannel a = BidirectionalChannel a
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 BidirectionalChannel where liftEq = genericLiftEq
 instance Ord1 BidirectionalChannel where liftCompare = genericLiftCompare
@@ -21,7 +21,7 @@ instance Evaluatable BidirectionalChannel
 
 -- | A Receive channel in Go (e.g. `<-chan`).
 newtype ReceiveChannel a = ReceiveChannel a
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 ReceiveChannel where liftEq = genericLiftEq
 instance Ord1 ReceiveChannel where liftCompare = genericLiftCompare
@@ -34,7 +34,7 @@ instance Evaluatable ReceiveChannel
 
 -- | A Send channel in Go (e.g. `chan<-`).
 newtype SendChannel a = SendChannel a
-  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 SendChannel where liftEq = genericLiftEq
 instance Ord1 SendChannel where liftCompare = genericLiftCompare

src/Language/Haskell/Assignment.hs

@@ -9,18 +9,23 @@ module Language.Haskell.Assignment
 import Assigning.Assignment hiding (Assignment, Error)
 import Data.Record
 import Data.Sum
-import Data.Syntax (emptyTerm, handleError, parseError, makeTerm, contextualize, postContextualize)
+import Data.Syntax (emptyTerm, handleError, parseError, makeTerm, makeTerm'', contextualize, postContextualize)
 import Language.Haskell.Grammar as Grammar
 import qualified Assigning.Assignment as Assignment
-import qualified Data.Abstract.FreeVariables as FV
+import qualified Data.Abstract.Name as Name
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Comment as Comment
+import qualified Data.Syntax.Declaration as Declaration
+import qualified Data.Syntax.Literal as Literal
 import qualified Data.Term as Term
 import qualified Language.Haskell.Syntax as Syntax
 import Prologue
 
 type Syntax = '[
     Comment.Comment
+  , Declaration.Function
+  , Literal.Float
+  , Literal.Integer
   , Syntax.Context
   , Syntax.Empty
   , Syntax.Error
@@ -37,16 +42,26 @@ assignment :: Assignment
 assignment = handleError $ module' <|> parseError
 
 module' :: Assignment
-module' = makeTerm <$> symbol Module <*> children (Syntax.Module <$> moduleIdentifier <*> pure [] <*> (where' <|> emptyTerm))
+module' = makeTerm
+       <$> symbol Module
+       <*> children (Syntax.Module <$> (moduleIdentifier <|> emptyTerm) <*> pure [] <*> (where' <|> expressions <|> emptyTerm))
+
+
+expressions :: Assignment
+expressions = makeTerm'' <$> location <*> many expression
 
 expression :: Assignment
 expression = term (handleError (choice expressionChoices))
 
 expressionChoices :: [Assignment.Assignment [] Grammar Term]
 expressionChoices = [
-                      constructorIdentifier
+                      comment
+                    , constructorIdentifier
+                    , float
+                    , functionDeclaration
+                    , integer
                     , moduleIdentifier
-                    , comment
+                    , variableIdentifier
                     , where'
                     ]
 
@@ -56,11 +71,36 @@ term term = contextualize comment (postContextualize comment term)
 comment :: Assignment
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
+variableIdentifier :: Assignment
+variableIdentifier = makeTerm <$> symbol VariableIdentifier <*> (Syntax.Identifier . Name.name <$> source)
+
 constructorIdentifier :: Assignment
-constructorIdentifier = makeTerm <$> symbol ConstructorIdentifier <*> (Syntax.Identifier . FV.name <$> source)
+constructorIdentifier = makeTerm <$> symbol ConstructorIdentifier <*> (Syntax.Identifier . Name.name <$> source)
 
 moduleIdentifier :: Assignment
-moduleIdentifier = makeTerm <$> symbol ModuleIdentifier <*> (Syntax.Identifier . FV.name <$> source)
+moduleIdentifier = makeTerm <$> symbol ModuleIdentifier <*> (Syntax.Identifier . Name.name <$> source)
 
 where' :: Assignment
 where' = makeTerm <$> (symbol Where <|> symbol Where') <*> children (many expression)
+
+functionBody :: Assignment
+functionBody = makeTerm <$> symbol FunctionBody <*> children (many expression)
+
+functionDeclaration :: Assignment
+functionDeclaration = makeTerm
+                   <$> symbol FunctionDeclaration
+                   <*> children (Declaration.Function
+                               <$> pure []
+                               <*> variableIdentifier
+                               <*> (manyTermsTill expression (symbol FunctionBody) <|> pure [])
+                               <*> functionBody)
+
+integer :: Assignment
+integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> source)
+
+float :: Assignment
+float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
+
+-- | Match a series of terms or comments until a delimiter is matched.
+manyTermsTill :: Assignment.Assignment [] Grammar Term -> Assignment.Assignment [] Grammar b -> Assignment.Assignment [] Grammar [Term]
+manyTermsTill step = manyTill (step <|> comment)

src/Language/Haskell/Syntax.hs

@@ -11,7 +11,7 @@ data Module a = Module { moduleIdentifier :: !a
                        , moduleExports    :: ![a]
                        , moduleStatements :: !a
                        }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Module where liftEq = genericLiftEq
 instance Ord1 Module where liftCompare = genericLiftCompare

src/Language/Markdown/Syntax.hs

@@ -7,7 +7,7 @@ import Data.JSON.Fields
 import Diffing.Algorithm
 
 newtype Document a = Document [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Document
 
@@ -19,7 +19,7 @@ instance Show1 Document where liftShowsPrec = genericLiftShowsPrec
 -- Block elements
 
 newtype Paragraph a = Paragraph [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Paragraph
 
@@ -28,7 +28,7 @@ instance Ord1 Paragraph where liftCompare = genericLiftCompare
 instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
 
 data Heading a = Heading { headingLevel :: Int, headingContent :: [a], sectionContent :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Heading
 
@@ -37,7 +37,7 @@ instance Ord1 Heading where liftCompare = genericLiftCompare
 instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
 
 newtype UnorderedList a = UnorderedList [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 UnorderedList
 
@@ -48,7 +48,7 @@ instance Show1 UnorderedList where liftShowsPrec = genericLiftShowsPrec
 instance ToJSONFields1 OrderedList
 
 newtype OrderedList a = OrderedList [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 OrderedList where liftEq = genericLiftEq
 instance Ord1 OrderedList where liftCompare = genericLiftCompare
@@ -57,7 +57,7 @@ instance Show1 OrderedList where liftShowsPrec = genericLiftShowsPrec
 instance ToJSONFields1 BlockQuote
 
 newtype BlockQuote a = BlockQuote [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 BlockQuote where liftEq = genericLiftEq
 instance Ord1 BlockQuote where liftCompare = genericLiftCompare
@@ -66,7 +66,7 @@ instance Show1 BlockQuote where liftShowsPrec = genericLiftShowsPrec
 instance ToJSONFields1 ThematicBreak
 
 data ThematicBreak a = ThematicBreak
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 ThematicBreak where liftEq = genericLiftEq
 instance Ord1 ThematicBreak where liftCompare = genericLiftCompare
@@ -76,14 +76,14 @@ instance ToJSONFields1 HTMLBlock where
   toJSONFields1 (HTMLBlock b) = noChildren [ "asString" .= unpack b ]
 
 newtype HTMLBlock a = HTMLBlock ByteString
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 HTMLBlock where liftEq = genericLiftEq
 instance Ord1 HTMLBlock where liftCompare = genericLiftCompare
 instance Show1 HTMLBlock where liftShowsPrec = genericLiftShowsPrec
 
 newtype Table a = Table [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Table
 
@@ -92,7 +92,7 @@ instance Ord1 Table where liftCompare = genericLiftCompare
 instance Show1 Table where liftShowsPrec = genericLiftShowsPrec
 
 newtype TableRow a = TableRow [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 TableRow
 
@@ -101,7 +101,7 @@ instance Ord1 TableRow where liftCompare = genericLiftCompare
 instance Show1 TableRow where liftShowsPrec = genericLiftShowsPrec
 
 newtype TableCell a = TableCell [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 TableCell
 
@@ -113,7 +113,7 @@ instance Show1 TableCell where liftShowsPrec = genericLiftShowsPrec
 -- Inline elements
 
 newtype Strong a = Strong [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Strong
 
@@ -122,7 +122,7 @@ instance Ord1 Strong where liftCompare = genericLiftCompare
 instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec
 
 newtype Emphasis a = Emphasis [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Emphasis
 
@@ -131,7 +131,7 @@ instance Ord1 Emphasis where liftCompare = genericLiftCompare
 instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec
 
 newtype Text a = Text ByteString
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Text where
   toJSONFields1 (Text s) = noChildren ["asString" .= unpack s ]
@@ -141,7 +141,7 @@ instance Ord1 Text where liftCompare = genericLiftCompare
 instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
 
 data Link a = Link { linkURL :: ByteString, linkTitle :: Maybe ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 -- TODO: Better ToJSONFields1 instance
 instance ToJSONFields1 Link
@@ -151,7 +151,7 @@ instance Ord1 Link where liftCompare = genericLiftCompare
 instance Show1 Link where liftShowsPrec = genericLiftShowsPrec
 
 data Image a = Image { imageURL :: ByteString, imageTitle :: Maybe ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 -- TODO: Better ToJSONFields1 instance
 instance ToJSONFields1 Image
@@ -161,7 +161,7 @@ instance Ord1 Image where liftCompare = genericLiftCompare
 instance Show1 Image where liftShowsPrec = genericLiftShowsPrec
 
 data Code a = Code { codeLanguage :: Maybe ByteString, codeContent :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 -- TODO: Better ToJSONFields1 instance
 instance ToJSONFields1 Code
@@ -171,7 +171,7 @@ instance Ord1 Code where liftCompare = genericLiftCompare
 instance Show1 Code where liftShowsPrec = genericLiftShowsPrec
 
 data LineBreak a = LineBreak
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 LineBreak
 
@@ -182,7 +182,7 @@ instance Show1 LineBreak where liftShowsPrec = genericLiftShowsPrec
 instance ToJSONFields1 Strikethrough
 
 newtype Strikethrough a = Strikethrough [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Strikethrough where liftEq = genericLiftEq
 instance Ord1 Strikethrough where liftCompare = genericLiftCompare

src/Language/PHP/Assignment.hs

@@ -12,7 +12,7 @@ import Data.Sum
 import Data.Syntax (emptyTerm, handleError, parseError, infixContext, makeTerm, makeTerm', makeTerm1, contextualize, postContextualize)
 import Language.PHP.Grammar as Grammar
 import qualified Assigning.Assignment as Assignment
-import qualified Data.Abstract.FreeVariables as FV
+import qualified Data.Abstract.Name as Name
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Comment as Comment
@@ -445,7 +445,7 @@ classConstDeclaration :: Assignment
 classConstDeclaration = makeTerm <$> symbol ClassConstDeclaration <*> children (Syntax.ClassConstDeclaration <$> (term visibilityModifier <|> emptyTerm) <*> manyTerm constElement)
 
 visibilityModifier :: Assignment
-visibilityModifier = makeTerm <$> symbol VisibilityModifier <*> (Syntax.Identifier . FV.name <$> source)
+visibilityModifier = makeTerm <$> symbol VisibilityModifier <*> (Syntax.Identifier . Name.name <$> source)
 
 constElement :: Assignment
 constElement = makeTerm <$> symbol ConstElement <*> children (Statement.Assignment [] <$> term name <*> term expression)
@@ -651,7 +651,7 @@ propertyDeclaration :: Assignment
 propertyDeclaration = makeTerm <$> symbol PropertyDeclaration <*> children (Syntax.PropertyDeclaration <$> term propertyModifier <*> someTerm propertyElement)
 
 propertyModifier :: Assignment
-propertyModifier = (makeTerm <$> symbol PropertyModifier <*> children (Syntax.PropertyModifier <$> (term visibilityModifier <|> emptyTerm) <*> (term staticModifier <|> emptyTerm))) <|> term (makeTerm <$> symbol PropertyModifier <*> (Syntax.Identifier . FV.name <$> source))
+propertyModifier = (makeTerm <$> symbol PropertyModifier <*> children (Syntax.PropertyModifier <$> (term visibilityModifier <|> emptyTerm) <*> (term staticModifier <|> emptyTerm))) <|> term (makeTerm <$> symbol PropertyModifier <*> (Syntax.Identifier . Name.name <$> source))
 
 propertyElement :: Assignment
 propertyElement = makeTerm <$> symbol PropertyElement <*> children (Statement.Assignment [] <$> term variableName <*> term propertyInitializer) <|> (symbol PropertyElement *> children (term variableName))
@@ -712,7 +712,7 @@ namespaceAliasingClause = makeTerm <$> symbol NamespaceAliasingClause <*> childr
 
 -- | TODO Do something better than Identifier
 namespaceFunctionOrConst :: Assignment
-namespaceFunctionOrConst = makeTerm <$> symbol NamespaceFunctionOrConst <*> (Syntax.Identifier . FV.name <$> source)
+namespaceFunctionOrConst = makeTerm <$> symbol NamespaceFunctionOrConst <*> (Syntax.Identifier . Name.name <$> source)
 
 globalDeclaration :: Assignment
 globalDeclaration = makeTerm <$> symbol GlobalDeclaration <*> children (Syntax.GlobalDeclaration <$> manyTerm simpleVariable')
@@ -748,7 +748,7 @@ variableName :: Assignment
 variableName = makeTerm <$> symbol VariableName <*> children (Syntax.VariableName <$> term name)
 
 name :: Assignment
-name = makeTerm <$> (symbol Name <|> symbol Name') <*> (Syntax.Identifier . FV.name <$> source)
+name = makeTerm <$> (symbol Name <|> symbol Name') <*> (Syntax.Identifier . Name.name <$> source)
 
 functionStaticDeclaration :: Assignment
 functionStaticDeclaration = makeTerm <$> symbol FunctionStaticDeclaration <*> children (Declaration.VariableDeclaration <$> manyTerm staticVariableDeclaration)

src/Language/PHP/Syntax.hs

@@ -12,7 +12,7 @@ import           Prelude hiding (fail)
 import           Prologue hiding (Text)
 
 newtype Text a = Text ByteString
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Text where
   toJSONFields1 (Text t) = noChildren ["asString" .= BC.unpack t]
@@ -24,7 +24,7 @@ instance Evaluatable Text
 
 
 newtype VariableName a = VariableName a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 VariableName
 
@@ -41,43 +41,40 @@ instance Evaluatable VariableName
 -- file, the complete contents of the included file are treated as though it
 -- were defined inside that function.
 
-resolvePHPName :: Members '[ Modules location value
-                           , Resumable ResolutionError
-                           ] effects
+resolvePHPName :: ( Member (Modules address value) effects
+                  , Member (Resumable ResolutionError) effects
+                  )
                => ByteString
-               -> Evaluator location value effects ModulePath
+               -> Evaluator address value effects ModulePath
 resolvePHPName n = do
   modulePath <- resolve [name]
   maybe (throwResumable $ NotFoundError name [name] Language.PHP) pure modulePath
   where name = toName n
         toName = BC.unpack . dropRelativePrefix . stripQuotes
 
-include :: ( AbstractValue location value effects
-           , Members '[ Allocator location value
-                      , Modules location value
-                      , Reader (Environment location value)
-                      , Resumable ResolutionError
-                      , Resumable (EnvironmentError value)
-                      , Resumable (EvalError value)
-                      , State (Environment location value)
-                      , State (Exports location value)
-                      , State (Heap location (Cell location) value)
-                      , Trace
-                      ] effects
+include :: ( AbstractValue address value effects
+           , Member (Allocator address value) effects
+           , Member (Modules address value) effects
+           , Member (Reader (Environment address)) effects
+           , Member (Resumable ResolutionError) effects
+           , Member (Resumable (EnvironmentError address)) effects
+           , Member (State (Environment address)) effects
+           , Member (State (Exports address)) effects
+           , Member Trace effects
            )
-        => Subterm term (Evaluator location value effects (ValueRef value))
-        -> (ModulePath -> Evaluator location value effects (Maybe (Environment location value, value)))
-        -> Evaluator location value effects (ValueRef value)
+        => Subterm term (Evaluator address value effects (ValueRef value))
+        -> (ModulePath -> Evaluator address value effects (Maybe (Environment address, value)))
+        -> Evaluator address value effects (ValueRef value)
 include pathTerm f = do
   name <- subtermValue pathTerm >>= asString
   path <- resolvePHPName name
   traceResolve name path
-  (importedEnv, v) <- isolate (f path) >>= maybeM ((,) emptyEnv <$> unit)
-  modifyEnv (mergeEnvs importedEnv)
+  (importedEnv, v) <- isolate (f path) >>= maybeM (pure (emptyEnv, unit))
+  bindAll importedEnv
   pure (Rval v)
 
 newtype Require a = Require a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Require where liftEq          = genericLiftEq
 instance Ord1 Require where liftCompare    = genericLiftCompare
@@ -90,7 +87,7 @@ instance Evaluatable Require where
 
 
 newtype RequireOnce a = RequireOnce a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 RequireOnce where liftEq = genericLiftEq
 instance Ord1 RequireOnce where liftCompare = genericLiftCompare
@@ -103,7 +100,7 @@ instance Evaluatable RequireOnce where
 
 
 newtype Include a = Include a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Include where liftEq          = genericLiftEq
 instance Ord1 Include where liftCompare    = genericLiftCompare
@@ -116,7 +113,7 @@ instance Evaluatable Include where
 
 
 newtype IncludeOnce a = IncludeOnce a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 IncludeOnce where liftEq          = genericLiftEq
 instance Ord1 IncludeOnce where liftCompare    = genericLiftCompare
@@ -129,7 +126,7 @@ instance Evaluatable IncludeOnce where
 
 
 newtype ArrayElement a = ArrayElement a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 ArrayElement
 
@@ -139,7 +136,7 @@ instance Show1 ArrayElement where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ArrayElement
 
 newtype GlobalDeclaration a = GlobalDeclaration [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 GlobalDeclaration
 
@@ -149,7 +146,7 @@ instance Show1 GlobalDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable GlobalDeclaration
 
 newtype SimpleVariable a = SimpleVariable a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 SimpleVariable
 
@@ -161,7 +158,7 @@ instance Evaluatable SimpleVariable
 
 -- | TODO: Unify with TypeScript's PredefinedType
 newtype CastType a = CastType { _castType :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 CastType
 
@@ -171,7 +168,7 @@ instance Show1 CastType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable CastType
 
 newtype ErrorControl a = ErrorControl a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 ErrorControl
 
@@ -181,7 +178,7 @@ instance Show1 ErrorControl where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ErrorControl
 
 newtype Clone a = Clone a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Clone
 
@@ -191,7 +188,7 @@ instance Show1 Clone where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Clone
 
 newtype ShellCommand a = ShellCommand ByteString
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 ShellCommand
 
@@ -202,7 +199,7 @@ instance Evaluatable ShellCommand
 
 -- | TODO: Combine with TypeScript update expression.
 newtype Update a = Update { _updateSubject :: a }
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Update
 
@@ -212,7 +209,7 @@ instance Show1 Update where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Update
 
 newtype NewVariable a = NewVariable [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 NewVariable
 
@@ -222,7 +219,7 @@ instance Show1 NewVariable where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable NewVariable
 
 newtype RelativeScope a = RelativeScope ByteString
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 RelativeScope
 
@@ -232,7 +229,7 @@ instance Show1 RelativeScope where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable RelativeScope
 
 data QualifiedName a = QualifiedName !a !a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 QualifiedName
 
@@ -244,7 +241,7 @@ instance Evaluatable QualifiedName where
   eval (fmap subtermValue -> QualifiedName name iden) = Rval <$> evaluateInScopedEnv name iden
 
 newtype NamespaceName a = NamespaceName (NonEmpty a)
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 NamespaceName
 
@@ -257,7 +254,7 @@ instance Evaluatable NamespaceName where
   eval (NamespaceName xs) = Rval <$> foldl1 evaluateInScopedEnv (fmap subtermValue xs)
 
 newtype ConstDeclaration a = ConstDeclaration [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 ConstDeclaration
 
@@ -267,7 +264,7 @@ instance Show1 ConstDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ConstDeclaration
 
 data ClassConstDeclaration a = ClassConstDeclaration a [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 ClassConstDeclaration
 
@@ -277,7 +274,7 @@ instance Show1 ClassConstDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ClassConstDeclaration
 
 newtype ClassInterfaceClause a = ClassInterfaceClause [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 ClassInterfaceClause
 
@@ -287,7 +284,7 @@ instance Show1 ClassInterfaceClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ClassInterfaceClause
 
 newtype ClassBaseClause a = ClassBaseClause a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 ClassBaseClause
 
@@ -298,7 +295,7 @@ instance Evaluatable ClassBaseClause
 
 
 newtype UseClause a = UseClause [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 UseClause
 
@@ -308,7 +305,7 @@ instance Show1 UseClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable UseClause
 
 newtype ReturnType a = ReturnType a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 ReturnType
 
@@ -318,7 +315,7 @@ instance Show1 ReturnType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ReturnType
 
 newtype TypeDeclaration a = TypeDeclaration a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 TypeDeclaration
 
@@ -328,7 +325,7 @@ instance Show1 TypeDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypeDeclaration
 
 newtype BaseTypeDeclaration a = BaseTypeDeclaration a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 BaseTypeDeclaration
 
@@ -338,7 +335,7 @@ instance Show1 BaseTypeDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable BaseTypeDeclaration
 
 newtype ScalarType a = ScalarType ByteString
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 ScalarType
 
@@ -348,7 +345,7 @@ instance Show1 ScalarType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ScalarType
 
 newtype EmptyIntrinsic a = EmptyIntrinsic a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 EmptyIntrinsic
 
@@ -358,7 +355,7 @@ instance Show1 EmptyIntrinsic where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable EmptyIntrinsic
 
 newtype ExitIntrinsic a = ExitIntrinsic a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 ExitIntrinsic
 
@@ -368,7 +365,7 @@ instance Show1 ExitIntrinsic where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ExitIntrinsic
 
 newtype IssetIntrinsic a = IssetIntrinsic a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 IssetIntrinsic
 
@@ -378,7 +375,7 @@ instance Show1 IssetIntrinsic where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable IssetIntrinsic
 
 newtype EvalIntrinsic a = EvalIntrinsic a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 EvalIntrinsic
 
@@ -388,7 +385,7 @@ instance Show1 EvalIntrinsic where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable EvalIntrinsic
 
 newtype PrintIntrinsic a = PrintIntrinsic a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 PrintIntrinsic
 
@@ -398,7 +395,7 @@ instance Show1 PrintIntrinsic where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable PrintIntrinsic
 
 newtype NamespaceAliasingClause a = NamespaceAliasingClause a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 NamespaceAliasingClause
 
@@ -408,7 +405,7 @@ instance Show1 NamespaceAliasingClause where liftShowsPrec = genericLiftShowsPre
 instance Evaluatable NamespaceAliasingClause
 
 newtype NamespaceUseDeclaration a = NamespaceUseDeclaration [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 NamespaceUseDeclaration
 
@@ -418,7 +415,7 @@ instance Show1 NamespaceUseDeclaration where liftShowsPrec = genericLiftShowsPre
 instance Evaluatable NamespaceUseDeclaration
 
 newtype NamespaceUseClause a = NamespaceUseClause [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 NamespaceUseClause
 
@@ -428,7 +425,7 @@ instance Show1 NamespaceUseClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable NamespaceUseClause
 
 newtype NamespaceUseGroupClause a = NamespaceUseGroupClause [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 NamespaceUseGroupClause
 
@@ -438,7 +435,7 @@ instance Show1 NamespaceUseGroupClause where liftShowsPrec = genericLiftShowsPre
 instance Evaluatable NamespaceUseGroupClause
 
 data Namespace a = Namespace { namespaceName :: a, namespaceBody :: a }
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance Eq1 Namespace where liftEq = genericLiftEq
 instance Ord1 Namespace where liftCompare = genericLiftCompare
@@ -459,7 +456,7 @@ instance Evaluatable Namespace where
         go xs <* makeNamespace name addr Nothing
 
 data TraitDeclaration a = TraitDeclaration { traitName :: a, traitStatements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 TraitDeclaration
 
@@ -469,7 +466,7 @@ instance Show1 TraitDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TraitDeclaration
 
 data AliasAs a = AliasAs { aliasAsName  :: a, aliasAsModifier :: a, aliasAsClause :: a }
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 AliasAs
 
@@ -479,7 +476,7 @@ instance Show1 AliasAs where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable AliasAs
 
 data InsteadOf a = InsteadOf a a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 InsteadOf
 
@@ -489,7 +486,7 @@ instance Show1 InsteadOf where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable InsteadOf
 
 newtype TraitUseSpecification a = TraitUseSpecification [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 TraitUseSpecification
 
@@ -499,7 +496,7 @@ instance Show1 TraitUseSpecification where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TraitUseSpecification
 
 data TraitUseClause a = TraitUseClause [a] a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 TraitUseClause
 
@@ -509,7 +506,7 @@ instance Show1 TraitUseClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TraitUseClause
 
 data DestructorDeclaration a = DestructorDeclaration [a] a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 DestructorDeclaration
 
@@ -519,7 +516,7 @@ instance Show1 DestructorDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable DestructorDeclaration
 
 newtype Static a = Static ByteString
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Static
 
@@ -529,7 +526,7 @@ instance Show1 Static where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Static
 
 newtype ClassModifier a = ClassModifier ByteString
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 ClassModifier
 
@@ -539,7 +536,7 @@ instance Show1 ClassModifier where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ClassModifier
 
 data ConstructorDeclaration a = ConstructorDeclaration [a] [a] a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 ConstructorDeclaration
 
@@ -549,7 +546,7 @@ instance Show1 ConstructorDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ConstructorDeclaration
 
 data PropertyDeclaration a = PropertyDeclaration a [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 PropertyDeclaration
 
@@ -559,7 +556,7 @@ instance Show1 PropertyDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable PropertyDeclaration
 
 data PropertyModifier a = PropertyModifier a a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 PropertyModifier
 
@@ -569,7 +566,7 @@ instance Show1 PropertyModifier where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable PropertyModifier
 
 data InterfaceDeclaration a = InterfaceDeclaration a a [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 InterfaceDeclaration
 
@@ -579,7 +576,7 @@ instance Show1 InterfaceDeclaration where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable InterfaceDeclaration
 
 newtype InterfaceBaseClause a = InterfaceBaseClause [a]
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 InterfaceBaseClause
 
@@ -589,7 +586,7 @@ instance Show1 InterfaceBaseClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable InterfaceBaseClause
 
 newtype Echo a = Echo a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Echo
 
@@ -599,7 +596,7 @@ instance Show1 Echo where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Echo
 
 newtype Unset a = Unset a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Unset
 
@@ -609,7 +606,7 @@ instance Show1 Unset where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Unset
 
 data Declare a = Declare a a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 Declare
 
@@ -619,7 +616,7 @@ instance Show1 Declare where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Declare
 
 newtype DeclareDirective a = DeclareDirective a
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 DeclareDirective
 
@@ -629,7 +626,7 @@ instance Show1 DeclareDirective where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable DeclareDirective
 
 newtype LabeledStatement a = LabeledStatement { _labeledStatementIdentifier :: a }
-  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
+  deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, Generic1, Hashable1, Mergeable, Ord, Show, Traversable)
 
 instance ToJSONFields1 LabeledStatement
 

src/Language/Python/Assignment.hs

@@ -8,7 +8,7 @@ module Language.Python.Assignment
 ) where
 
 import Assigning.Assignment hiding (Assignment, Error)
-import Data.Abstract.FreeVariables (name)
+import Data.Abstract.Name (name)
 import Data.Record
 import Data.Syntax (contextualize, emptyTerm, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1, parseError, postContextualize)
 import GHC.Stack

src/Language/Python/Syntax.hs

@@ -3,9 +3,7 @@ module Language.Python.Syntax where
 
 import           Data.Abstract.Environment as Env
 import           Data.Abstract.Evaluatable
-import qualified Data.Abstract.FreeVariables as FV
 import           Data.Abstract.Module
-import           Data.Align.Generic
 import qualified Data.ByteString.Char8 as BC
 import           Data.Functor.Classes.Generic
 import           Data.JSON.Fields
@@ -53,13 +51,13 @@ relativeQualifiedName prefix paths = RelativeQualifiedName (BC.unpack prefix) (J
 -- Subsequent imports of `parent.two` or `parent.three` will execute
 --     `parent/two/__init__.py` and
 --     `parent/three/__init__.py` respectively.
-resolvePythonModules :: Members '[ Modules location value
-                                 , Reader ModuleInfo
-                                 , Resumable ResolutionError
-                                 , Trace
-                                 ] effects
+resolvePythonModules :: ( Member (Modules address value) effects
+                        , Member (Reader ModuleInfo) effects
+                        , Member (Resumable ResolutionError) effects
+                        , Member Trace effects
+                        )
                      => QualifiedName
-                     -> Evaluator location value effects (NonEmpty ModulePath)
+                     -> Evaluator address value effects (NonEmpty ModulePath)
 resolvePythonModules q = do
   relRootDir <- rootDir q <$> currentModule
   for (moduleNames q) $ \name -> do
@@ -90,7 +88,7 @@ resolvePythonModules q = do
 --
 -- If the list of symbols is empty copy everything to the calling environment.
 data Import a = Import { importFrom :: QualifiedName, importSymbols :: ![(Name, Name)] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Import
 
@@ -119,8 +117,8 @@ instance Evaluatable Import where
     -- Last module path is the one we want to import
     let path = NonEmpty.last modulePaths
     importedEnv <- maybe emptyEnv fst <$> isolate (require path)
-    modifyEnv (mergeEnvs (select importedEnv))
-    Rval <$> unit
+    bindAll (select importedEnv)
+    pure (Rval unit)
     where
       select importedEnv
         | Prologue.null xs = importedEnv
@@ -128,26 +126,24 @@ instance Evaluatable Import where
 
 
 -- Evaluate a qualified import
-evalQualifiedImport :: ( AbstractValue location value effects
-                       , Members '[ Allocator location value
-                                  , Modules location value
-                                  , Reader (Environment location value)
-                                  , State (Environment location value)
-                                  , State (Exports location value)
-                                  , State (Heap location (Cell location) value)
-                                  ] effects
-                       , Ord location
-                       , Reducer.Reducer value (Cell location value)
+evalQualifiedImport :: ( AbstractValue address value effects
+                       , Member (Allocator address value) effects
+                       , Member (Modules address value) effects
+                       , Member (Reader (Environment address)) effects
+                       , Member (State (Environment address)) effects
+                       , Member (State (Exports address)) effects
+                       , Member (State (Heap address (Cell address) value)) effects
+                       , Ord address
+                       , Reducer.Reducer value (Cell address value)
                        )
-                    => Name -> ModulePath -> Evaluator location value effects value
+                    => Name -> ModulePath -> Evaluator address value effects value
 evalQualifiedImport name path = letrec' name $ \addr -> do
   importedEnv <- maybe emptyEnv fst <$> isolate (require path)
-  modifyEnv (mergeEnvs importedEnv)
-  void $ makeNamespace name addr Nothing
-  unit
+  bindAll importedEnv
+  unit <$ makeNamespace name addr Nothing
 
 newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: QualifiedName }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 QualifiedImport
 
@@ -158,9 +154,9 @@ instance Show1 QualifiedImport where liftShowsPrec = genericLiftShowsPrec
 -- import a.b.c
 instance Evaluatable QualifiedImport where
   eval (QualifiedImport (RelativeQualifiedName _ _))        = raiseEff (fail "technically this is not allowed in python")
-  eval (QualifiedImport name@(QualifiedName qualifiedName)) = do
-    modulePaths <- resolvePythonModules name
-    Rval <$> go (NonEmpty.zip (FV.name . BC.pack <$> qualifiedName) modulePaths)
+  eval (QualifiedImport qname@(QualifiedName qualifiedName)) = do
+    modulePaths <- resolvePythonModules qname
+    Rval <$> go (NonEmpty.zip (name . BC.pack <$> qualifiedName) modulePaths)
     where
       -- Evaluate and import the last module, updating the environment
       go ((name, path) :| []) = evalQualifiedImport name path
@@ -171,7 +167,7 @@ instance Evaluatable QualifiedImport where
         makeNamespace name addr Nothing
 
 data QualifiedAliasedImport a = QualifiedAliasedImport { qualifiedAliasedImportFrom :: QualifiedName, qualifiedAliasedImportAlias :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 QualifiedAliasedImport
 
@@ -192,13 +188,12 @@ instance Evaluatable QualifiedAliasedImport where
     Rval <$> letrec' alias (\addr -> do
       let path = NonEmpty.last modulePaths
       importedEnv <- maybe emptyEnv fst <$> isolate (require path)
-      modifyEnv (mergeEnvs importedEnv)
-      void $ makeNamespace alias addr Nothing
-      unit)
+      bindAll importedEnv
+      unit <$ makeNamespace alias addr Nothing)
 
 -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)
 data Ellipsis a = Ellipsis
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Ellipsis where liftEq = genericLiftEq
 instance Ord1 Ellipsis where liftCompare = genericLiftCompare
@@ -211,7 +206,7 @@ instance Evaluatable Ellipsis
 
 
 data Redirect a = Redirect !a !a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Redirect where liftEq = genericLiftEq
 instance Ord1 Redirect where liftCompare = genericLiftCompare

src/Language/Ruby/Assignment.hs

@@ -7,11 +7,11 @@ module Language.Ruby.Assignment
 ) where
 
 import Assigning.Assignment hiding (Assignment, Error)
+import Data.Abstract.Name (name)
 import Data.List (elem)
 import Data.Record
 import Data.Syntax (contextualize, postContextualize, emptyTerm, parseError, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1)
 import Language.Ruby.Grammar as Grammar
-import Data.Abstract.FreeVariables (name)
 import qualified Assigning.Assignment as Assignment
 import Data.Sum
 import qualified Data.Syntax as Syntax

src/Language/Ruby/Syntax.hs

@@ -17,11 +17,11 @@ import           System.FilePath.Posix
 -- TODO: Fully sort out ruby require/load mechanics
 --
 -- require "json"
-resolveRubyName :: Members '[ Modules location value
-                            , Resumable ResolutionError
-                            ] effects
+resolveRubyName :: ( Member (Modules address value) effects
+                   , Member (Resumable ResolutionError) effects
+                   )
                 => ByteString
-                -> Evaluator location value effects M.ModulePath
+                -> Evaluator address value effects M.ModulePath
 resolveRubyName name = do
   let name' = cleanNameOrPath name
   let paths = [name' <.> "rb"]
@@ -29,11 +29,11 @@ resolveRubyName name = do
   maybe (throwResumable $ NotFoundError name' paths Language.Ruby) pure modulePath
 
 -- load "/root/src/file.rb"
-resolveRubyPath :: Members '[ Modules location value
-                            , Resumable ResolutionError
-                            ] effects
+resolveRubyPath :: ( Member (Modules address value) effects
+                   , Member (Resumable ResolutionError) effects
+                   )
                 => ByteString
-                -> Evaluator location value effects M.ModulePath
+                -> Evaluator address value effects M.ModulePath
 resolveRubyPath path = do
   let name' = cleanNameOrPath path
   modulePath <- resolve [name']
@@ -43,7 +43,7 @@ cleanNameOrPath :: ByteString -> String
 cleanNameOrPath = BC.unpack . dropRelativePrefix . stripQuotes
 
 data Send a = Send { sendReceiver :: Maybe a, sendSelector :: Maybe a, sendArgs :: [a], sendBlock :: Maybe a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Send where liftEq = genericLiftEq
 instance Ord1 Send where liftCompare = genericLiftCompare
@@ -60,7 +60,7 @@ instance Evaluatable Send where
     Rval <$> call func (map subtermValue sendArgs) -- TODO pass through sendBlock
 
 data Require a = Require { requireRelative :: Bool, requirePath :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Require where liftEq = genericLiftEq
 instance Ord1 Require where liftCompare = genericLiftCompare
@@ -74,23 +74,23 @@ instance Evaluatable Require where
     path <- resolveRubyName name
     traceResolve name path
     (importedEnv, v) <- isolate (doRequire path)
-    modifyEnv (`mergeNewer` importedEnv)
+    bindAll importedEnv
     pure (Rval v) -- Returns True if the file was loaded, False if it was already loaded. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-require
 
-doRequire :: ( AbstractValue location value effects
-             , Member (Modules location value) effects
+doRequire :: ( AbstractValue address value effects
+             , Member (Modules address value) effects
              )
           => M.ModulePath
-          -> Evaluator location value effects (Environment location value, value)
+          -> Evaluator address value effects (Environment address, value)
 doRequire path = do
   result <- join <$> lookupModule path
   case result of
-    Nothing       -> (,) . maybe emptyEnv fst <$> load path <*> boolean True
-    Just (env, _) -> (,) env                  <$>               boolean False
+    Nothing       -> (,) . maybe emptyEnv fst <$> load path <*> pure (boolean True)
+    Just (env, _) -> pure (env, boolean False)
 
 
 newtype Load a = Load { loadArgs :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Load where liftEq = genericLiftEq
 instance Ord1 Load where liftCompare = genericLiftCompare
@@ -108,28 +108,27 @@ instance Evaluatable Load where
     Rval <$> doLoad path shouldWrap
   eval (Load _) = raiseEff (fail "invalid argument supplied to load, path is required")
 
-doLoad :: ( AbstractValue location value effects
-          , Members '[ Modules location value
-                     , Resumable ResolutionError
-                     , State (Environment location value)
-                     , State (Exports location value)
-                     , Trace
-                     ] effects
+doLoad :: ( AbstractValue address value effects
+          , Member (Modules address value) effects
+          , Member (Resumable ResolutionError) effects
+          , Member (State (Environment address)) effects
+          , Member (State (Exports address)) effects
+          , Member Trace effects
           )
        => ByteString
        -> Bool
-       -> Evaluator location value effects value
+       -> Evaluator address value effects value
 doLoad path shouldWrap = do
   path' <- resolveRubyPath path
   traceResolve path path'
   importedEnv <- maybe emptyEnv fst <$> isolate (load path')
-  unless shouldWrap $ modifyEnv (mergeEnvs importedEnv)
-  boolean Prelude.True -- load always returns true. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-load
+  unless shouldWrap $ bindAll importedEnv
+  pure (boolean Prelude.True) -- load always returns true. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-load
 
 -- TODO: autoload
 
 data Class a = Class { classIdentifier :: !a, classSuperClass :: !(Maybe a), classBody :: !a }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Class
 
@@ -148,7 +147,7 @@ instance Evaluatable Class where
       subtermValue classBody <* makeNamespace name addr super)
 
 data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Module where liftEq = genericLiftEq
 instance Ord1 Module where liftCompare = genericLiftCompare
@@ -165,7 +164,7 @@ instance Evaluatable Module where
 data LowPrecedenceBoolean a
   = LowAnd !a !a
   | LowOr !a !a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 LowPrecedenceBoolean
 

src/Language/TypeScript/Assignment.hs

@@ -7,7 +7,7 @@ module Language.TypeScript.Assignment
 ) where
 
 import Assigning.Assignment hiding (Assignment, Error)
-import Data.Abstract.FreeVariables (name)
+import Data.Abstract.Name (name)
 import qualified Assigning.Assignment as Assignment
 import Data.Record
 import Data.Sum

src/Language/TypeScript/Syntax.hs

@@ -3,7 +3,6 @@ module Language.TypeScript.Syntax where
 
 import qualified Data.Abstract.Environment as Env
 import           Data.Abstract.Evaluatable
-import qualified Data.Abstract.FreeVariables as FV
 import qualified Data.Abstract.Module as M
 import           Data.Abstract.Package
 import           Data.Abstract.Path
@@ -32,21 +31,21 @@ importPath str = let path = stripQuotes str in ImportPath (BC.unpack path) (path
                 | otherwise = NonRelative
 
 toName :: ImportPath -> Name
-toName = FV.name . BC.pack . unPath
+toName = name . BC.pack . unPath
 
 -- Node.js resolution algorithm: https://nodejs.org/api/modules.html#modules_all_together
 --
 -- NB: TypeScript has a couple of different strategies, but the main one (and the
 -- only one we support) mimics Node.js.
-resolveWithNodejsStrategy :: Members '[ Modules location value
-                                      , Reader M.ModuleInfo
-                                      , Reader PackageInfo
-                                      , Resumable ResolutionError
-                                      , Trace
-                                      ] effects
+resolveWithNodejsStrategy :: ( Member (Modules address value) effects
+                             , Member (Reader M.ModuleInfo) effects
+                             , Member (Reader PackageInfo) effects
+                             , Member (Resumable ResolutionError) effects
+                             , Member Trace effects
+                             )
                           => ImportPath
                           -> [String]
-                          -> Evaluator location value effects M.ModulePath
+                          -> Evaluator address value effects M.ModulePath
 resolveWithNodejsStrategy (ImportPath path Relative)    exts = resolveRelativePath path exts
 resolveWithNodejsStrategy (ImportPath path NonRelative) exts = resolveNonRelativePath path exts
 
@@ -57,15 +56,15 @@ resolveWithNodejsStrategy (ImportPath path NonRelative) exts = resolveNonRelativ
 -- /root/src/moduleB.ts
 -- /root/src/moduleB/package.json (if it specifies a "types" property)
 -- /root/src/moduleB/index.ts
-resolveRelativePath :: Members '[ Modules location value
-                                , Reader M.ModuleInfo
-                                , Reader PackageInfo
-                                , Resumable ResolutionError
-                                , Trace
-                                ] effects
+resolveRelativePath :: ( Member (Modules address value) effects
+                       , Member (Reader M.ModuleInfo) effects
+                       , Member (Reader PackageInfo) effects
+                       , Member (Resumable ResolutionError) effects
+                       , Member Trace effects
+                       )
                     => FilePath
                     -> [String]
-                    -> Evaluator location value effects M.ModulePath
+                    -> Evaluator address value effects M.ModulePath
 resolveRelativePath relImportPath exts = do
   M.ModuleInfo{..} <- currentModule
   let relRootDir = takeDirectory modulePath
@@ -85,15 +84,15 @@ resolveRelativePath relImportPath exts = do
 --
 -- /root/node_modules/moduleB.ts, etc
 -- /node_modules/moduleB.ts, etc
-resolveNonRelativePath :: Members '[ Modules location value
-                                   , Reader M.ModuleInfo
-                                   , Reader PackageInfo
-                                   , Resumable ResolutionError
-                                   , Trace
-                                   ] effects
+resolveNonRelativePath :: ( Member (Modules address value) effects
+                          , Member (Reader M.ModuleInfo) effects
+                          , Member (Reader PackageInfo) effects
+                          , Member (Resumable ResolutionError) effects
+                          , Member Trace effects
+                          )
                        => FilePath
                        -> [String]
-                       -> Evaluator location value effects M.ModulePath
+                       -> Evaluator address value effects M.ModulePath
 resolveNonRelativePath name exts = do
   M.ModuleInfo{..} <- currentModule
   go "." modulePath mempty
@@ -110,13 +109,13 @@ resolveNonRelativePath name exts = do
     notFound xs = throwResumable $ NotFoundError name xs Language.TypeScript
 
 -- | Resolve a module name to a ModulePath.
-resolveModule :: Members '[ Modules location value
-                          , Reader PackageInfo
-                          , Trace
-                          ] effects
+resolveModule :: ( Member (Modules address value) effects
+                 , Member (Reader PackageInfo) effects
+                 , Member Trace effects
+                 )
               => FilePath -- ^ Module path used as directory to search in
               -> [String] -- ^ File extensions to look for
-                -> Evaluator location value effects (Either [FilePath] M.ModulePath)
+              -> Evaluator address value effects (Either [FilePath] M.ModulePath)
 resolveModule path' exts = do
   let path = makeRelative "." path'
   PackageInfo{..} <- currentPackage
@@ -133,29 +132,26 @@ typescriptExtensions = ["ts", "tsx", "d.ts"]
 javascriptExtensions :: [String]
 javascriptExtensions = ["js"]
 
-evalRequire :: ( AbstractValue location value effects
-               , Members '[ Allocator location value
-                          , Modules location value
-                          , Reader (Environment location value)
-                          , State (Environment location value)
-                          , State (Exports location value)
-                          , State (Heap location (Cell location) value)
-                          , Trace
-                          ] effects
-               , Ord location
-               , Reducer value (Cell location value)
+evalRequire :: ( AbstractValue address value effects
+               , Member (Allocator address value) effects
+               , Member (Modules address value) effects
+               , Member (Reader (Environment address)) effects
+               , Member (State (Environment address)) effects
+               , Member (State (Exports address)) effects
+               , Member (State (Heap address (Cell address) value)) effects
+               , Ord address
+               , Reducer value (Cell address value)
                )
             => M.ModulePath
             -> Name
-            -> Evaluator location value effects value
+            -> Evaluator address value effects value
 evalRequire modulePath alias = letrec' alias $ \addr -> do
   importedEnv <- maybe emptyEnv fst <$> isolate (require modulePath)
-  modifyEnv (mergeEnvs importedEnv)
-  void $ makeNamespace alias addr Nothing
-  unit
+  bindAll importedEnv
+  unit <$ makeNamespace alias addr Nothing
 
 data Import a = Import { importSymbols :: ![(Name, Name)], importFrom :: ImportPath }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Import
 
@@ -168,14 +164,14 @@ instance Evaluatable Import where
   eval (Import symbols importPath) = do
     modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
     importedEnv <- maybe emptyEnv fst <$> isolate (require modulePath)
-    modifyEnv (mergeEnvs (renamed importedEnv)) *> (Rval <$> unit)
+    bindAll (renamed importedEnv) $> Rval unit
     where
       renamed importedEnv
         | Prologue.null symbols = importedEnv
         | otherwise = Env.overwrite symbols importedEnv
 
 data JavaScriptRequire a = JavaScriptRequire { javascriptRequireIden :: !a, javascriptRequireFrom :: ImportPath }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 JavaScriptRequire where liftEq = genericLiftEq
 instance Ord1 JavaScriptRequire where liftCompare = genericLiftCompare
@@ -191,7 +187,7 @@ instance Evaluatable JavaScriptRequire where
 
 
 data QualifiedAliasedImport a = QualifiedAliasedImport { qualifiedAliasedImportAlias :: !a, qualifiedAliasedImportFrom :: ImportPath }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 QualifiedAliasedImport where liftEq = genericLiftEq
 instance Ord1 QualifiedAliasedImport where liftCompare = genericLiftCompare
@@ -206,7 +202,7 @@ instance Evaluatable QualifiedAliasedImport where
     Rval <$> evalRequire modulePath alias
 
 newtype SideEffectImport a = SideEffectImport { sideEffectImportFrom :: ImportPath }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 SideEffectImport where liftEq = genericLiftEq
 instance Ord1 SideEffectImport where liftCompare = genericLiftCompare
@@ -218,12 +214,12 @@ instance Evaluatable SideEffectImport where
   eval (SideEffectImport importPath) = do
     modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
     void $ isolate (require modulePath)
-    Rval <$> unit
+    pure (Rval unit)
 
 
 -- | Qualified Export declarations
 newtype QualifiedExport a = QualifiedExport { qualifiedExportSymbols :: [(Name, Name)] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 QualifiedExport where liftEq = genericLiftEq
 instance Ord1 QualifiedExport where liftCompare = genericLiftCompare
@@ -236,12 +232,12 @@ instance Evaluatable QualifiedExport where
     -- Insert the aliases with no addresses.
     for_ exportSymbols $ \(name, alias) ->
       addExport name alias Nothing
-    Rval <$> unit
+    pure (Rval unit)
 
 
 -- | Qualified Export declarations that export from another module.
 data QualifiedExportFrom a = QualifiedExportFrom { qualifiedExportFrom :: ImportPath, qualifiedExportFromSymbols :: ![(Name, Name)]}
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 QualifiedExportFrom where liftEq = genericLiftEq
 instance Ord1 QualifiedExportFrom where liftCompare = genericLiftCompare
@@ -257,10 +253,10 @@ instance Evaluatable QualifiedExportFrom where
     for_ exportSymbols $ \(name, alias) -> do
       let address = Env.lookup name importedEnv
       maybe (throwEvalError $ ExportError modulePath name) (addExport name alias . Just) address
-    Rval <$> unit
+    pure (Rval unit)
 
 newtype DefaultExport a = DefaultExport { defaultExport :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 DefaultExport
 
@@ -276,14 +272,14 @@ instance Evaluatable DefaultExport where
         addr <- lookupOrAlloc name
         assign addr v
         addExport name name Nothing
-        void $ modifyEnv (Env.insert name addr)
+        void $ bind name addr
       Nothing -> throwEvalError DefaultExportError
-    Rval <$> unit
+    pure (Rval unit)
 
 
 -- | Lookup type for a type-level key in a typescript map.
 data LookupType a = LookupType { lookupTypeIdentifier :: a, lookupTypeKey :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 LookupType
 
@@ -294,7 +290,7 @@ instance Evaluatable LookupType
 
 -- | ShorthandPropertyIdentifier used in object patterns such as var baz = { foo } to mean var baz = { foo: foo }
 newtype ShorthandPropertyIdentifier a = ShorthandPropertyIdentifier ByteString
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ShorthandPropertyIdentifier
 
@@ -304,7 +300,7 @@ instance Show1 ShorthandPropertyIdentifier where liftShowsPrec = genericLiftShow
 instance Evaluatable ShorthandPropertyIdentifier
 
 data Union a = Union { _unionLeft :: !a, _unionRight :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Language.TypeScript.Syntax.Union
 
@@ -314,7 +310,7 @@ instance Show1 Language.TypeScript.Syntax.Union where liftShowsPrec = genericLif
 instance Evaluatable Language.TypeScript.Syntax.Union
 
 data Intersection a = Intersection { _intersectionLeft :: !a, _intersectionRight :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Intersection
 
@@ -324,7 +320,7 @@ instance Show1 Intersection where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Intersection
 
 data FunctionType a = FunctionType { _functionTypeParameters :: !a, _functionFormalParameters :: ![a], _functionType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 FunctionType
 
@@ -334,7 +330,7 @@ instance Show1 FunctionType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable FunctionType
 
 data AmbientFunction a = AmbientFunction { _ambientFunctionContext :: ![a], _ambientFunctionIdentifier :: !a, _ambientFunctionParameters :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 AmbientFunction
 
@@ -344,7 +340,7 @@ instance Show1 AmbientFunction where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable AmbientFunction
 
 data ImportRequireClause a = ImportRequireClause { _importRequireIdentifier :: !a, _importRequireSubject :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ImportRequireClause
 
@@ -354,7 +350,7 @@ instance Show1 ImportRequireClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ImportRequireClause
 
 newtype ImportClause a = ImportClause { _importClauseElements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ImportClause
 
@@ -364,7 +360,7 @@ instance Show1 ImportClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ImportClause
 
 newtype Tuple a = Tuple { _tupleElements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Tuple
 
@@ -376,7 +372,7 @@ instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Tuple
 
 data Constructor a = Constructor { _constructorTypeParameters :: !a, _constructorFormalParameters :: ![a], _constructorType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Language.TypeScript.Syntax.Constructor
 
@@ -386,7 +382,7 @@ instance Show1 Language.TypeScript.Syntax.Constructor where liftShowsPrec = gene
 instance Evaluatable Language.TypeScript.Syntax.Constructor
 
 data TypeParameter a = TypeParameter { _typeParameter :: !a, _typeParameterConstraint :: !a, _typeParameterDefaultType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 TypeParameter
 
@@ -396,7 +392,7 @@ instance Show1 TypeParameter where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypeParameter
 
 data TypeAssertion a = TypeAssertion { _typeAssertionParameters :: !a, _typeAssertionExpression :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 TypeAssertion
 
@@ -406,7 +402,7 @@ instance Show1 TypeAssertion where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypeAssertion
 
 newtype Annotation a = Annotation { _annotationType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Annotation
 
@@ -416,7 +412,7 @@ instance Show1 Annotation where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Annotation
 
 newtype Decorator a = Decorator { _decoratorTerm :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Decorator
 
@@ -426,7 +422,7 @@ instance Show1 Decorator where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Decorator
 
 newtype ComputedPropertyName a = ComputedPropertyName a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ComputedPropertyName
 
@@ -436,7 +432,7 @@ instance Show1 ComputedPropertyName where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ComputedPropertyName
 
 newtype Constraint a = Constraint { _constraintType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Constraint
 
@@ -446,7 +442,7 @@ instance Show1 Constraint where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Constraint
 
 newtype DefaultType a = DefaultType { _defaultType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 DefaultType
 
@@ -456,7 +452,7 @@ instance Show1 DefaultType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable DefaultType
 
 newtype ParenthesizedType a = ParenthesizedType { _parenthesizedType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ParenthesizedType
 
@@ -466,7 +462,7 @@ instance Show1 ParenthesizedType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ParenthesizedType
 
 newtype PredefinedType a = PredefinedType { _predefinedType :: ByteString }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 PredefinedType
 
@@ -476,7 +472,7 @@ instance Show1 PredefinedType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable PredefinedType
 
 newtype TypeIdentifier a = TypeIdentifier ByteString
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 TypeIdentifier
 
@@ -486,7 +482,7 @@ instance Show1 TypeIdentifier where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypeIdentifier
 
 data NestedIdentifier a = NestedIdentifier !a !a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 NestedIdentifier
 
@@ -496,7 +492,7 @@ instance Show1 NestedIdentifier where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable NestedIdentifier
 
 data NestedTypeIdentifier a = NestedTypeIdentifier !a !a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 NestedTypeIdentifier
 
@@ -506,7 +502,7 @@ instance Show1 NestedTypeIdentifier where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable NestedTypeIdentifier
 
 data GenericType a = GenericType { _genericTypeIdentifier :: !a, _genericTypeArguments :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 GenericType
 
@@ -516,7 +512,7 @@ instance Show1 GenericType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable GenericType
 
 data TypePredicate a = TypePredicate { _typePredicateIdentifier :: !a, _typePredicateType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 TypePredicate
 
@@ -526,7 +522,7 @@ instance Show1 TypePredicate where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypePredicate
 
 newtype ObjectType a = ObjectType { _objectTypeElements :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ObjectType
 
@@ -536,7 +532,7 @@ instance Show1 ObjectType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ObjectType
 
 data With a = With { _withExpression :: !a, _withBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 With
 
@@ -546,7 +542,7 @@ instance Show1 With where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable With
 
 newtype AmbientDeclaration a = AmbientDeclaration { _ambientDeclarationBody :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 AmbientDeclaration
 
@@ -558,7 +554,7 @@ instance Evaluatable AmbientDeclaration where
   eval (AmbientDeclaration body) = subtermRef body
 
 data EnumDeclaration a = EnumDeclaration { enumDeclarationIdentifier :: !a, _enumDeclarationBody :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 EnumDeclaration
 
@@ -571,7 +567,7 @@ instance Declarations a => Declarations (EnumDeclaration a) where
   declaredName EnumDeclaration{..} = declaredName enumDeclarationIdentifier
 
 newtype ExtendsClause a = ExtendsClause { _extendsClauses :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ExtendsClause
 
@@ -581,7 +577,7 @@ instance Show1 ExtendsClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ExtendsClause
 
 newtype ArrayType a = ArrayType { _arrayType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ArrayType
 
@@ -591,7 +587,7 @@ instance Show1 ArrayType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ArrayType
 
 newtype FlowMaybeType a = FlowMaybeType { _flowMaybeType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 FlowMaybeType
 
@@ -601,7 +597,7 @@ instance Show1 FlowMaybeType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable FlowMaybeType
 
 newtype TypeQuery a = TypeQuery { _typeQuerySubject :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 TypeQuery
 
@@ -611,7 +607,7 @@ instance Show1 TypeQuery where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypeQuery
 
 newtype IndexTypeQuery a = IndexTypeQuery { _indexTypeQuerySubject :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 IndexTypeQuery
 
@@ -621,7 +617,7 @@ instance Show1 IndexTypeQuery where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable IndexTypeQuery
 
 newtype TypeArguments a = TypeArguments { _typeArguments :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 TypeArguments
 
@@ -631,7 +627,7 @@ instance Show1 TypeArguments where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable TypeArguments
 
 newtype ThisType a = ThisType ByteString
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ThisType
 
@@ -641,7 +637,7 @@ instance Show1 ThisType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ThisType
 
 newtype ExistentialType a = ExistentialType ByteString
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ExistentialType
 
@@ -651,7 +647,7 @@ instance Show1 ExistentialType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ExistentialType
 
 newtype LiteralType a = LiteralType { _literalTypeSubject :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 LiteralType
 
@@ -661,7 +657,7 @@ instance Show1 LiteralType where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable LiteralType
 
 data PropertySignature a = PropertySignature { _modifiers :: ![a], _propertySignaturePropertyName :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 PropertySignature
 
@@ -671,7 +667,7 @@ instance Show1 PropertySignature where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable PropertySignature
 
 data CallSignature a = CallSignature { _callSignatureTypeParameters :: !a, _callSignatureParameters :: ![a], _callSignatureType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 CallSignature
 
@@ -682,7 +678,7 @@ instance Evaluatable CallSignature
 
 -- | Todo: Move type params and type to context
 data ConstructSignature a = ConstructSignature { _constructSignatureTypeParameters :: !a, _constructSignatureParameters :: ![a], _constructSignatureType :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ConstructSignature
 
@@ -692,7 +688,7 @@ instance Show1 ConstructSignature where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ConstructSignature
 
 data IndexSignature a = IndexSignature { _indexSignatureSubject :: a, _indexSignatureType :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 IndexSignature
 
@@ -702,7 +698,7 @@ instance Show1 IndexSignature where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable IndexSignature
 
 data AbstractMethodSignature a = AbstractMethodSignature { _abstractMethodSignatureContext :: ![a], _abstractMethodSignatureName :: !a, _abstractMethodSignatureParameters :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 AbstractMethodSignature
 
@@ -712,7 +708,7 @@ instance Show1 AbstractMethodSignature where liftShowsPrec = genericLiftShowsPre
 instance Evaluatable AbstractMethodSignature
 
 data Debugger a = Debugger
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Debugger
 
@@ -722,7 +718,7 @@ instance Show1 Debugger where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Debugger
 
 data ForOf a = ForOf { _forOfBinding :: !a, _forOfSubject :: !a, _forOfBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ForOf
 
@@ -732,7 +728,7 @@ instance Show1 ForOf where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ForOf
 
 data This a = This
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 This
 
@@ -742,7 +738,7 @@ instance Show1 This where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable This
 
 data LabeledStatement a = LabeledStatement { _labeledStatementIdentifier :: !a, _labeledStatementSubject :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 LabeledStatement
 
@@ -752,7 +748,7 @@ instance Show1 LabeledStatement where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable LabeledStatement
 
 newtype Update a = Update { _updateSubject :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Update
 
@@ -762,7 +758,7 @@ instance Show1 Update where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Update
 
 data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 Module where liftEq = genericLiftEq
 instance Ord1 Module where liftCompare = genericLiftCompare
@@ -779,7 +775,7 @@ instance Evaluatable Module where
 
 
 data InternalModule a = InternalModule { internalModuleIdentifier :: !a, internalModuleStatements :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 InternalModule where liftEq = genericLiftEq
 instance Ord1 InternalModule where liftCompare = genericLiftCompare
@@ -798,7 +794,7 @@ instance Declarations a => Declarations (InternalModule a) where
 
 
 data ImportAlias a = ImportAlias { _importAliasSubject :: !a, _importAlias :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ImportAlias
 
@@ -808,7 +804,7 @@ instance Show1 ImportAlias where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ImportAlias
 
 data Super a = Super
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Super
 
@@ -818,7 +814,7 @@ instance Show1 Super where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Super
 
 data Undefined a = Undefined
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 Undefined
 
@@ -828,7 +824,7 @@ instance Show1 Undefined where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Undefined
 
 data ClassHeritage a = ClassHeritage { _classHeritageExtendsClause :: !a, _implementsClause :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ClassHeritage
 
@@ -838,7 +834,7 @@ instance Show1 ClassHeritage where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ClassHeritage
 
 data AbstractClass a = AbstractClass { abstractClassIdentifier :: !a,  _abstractClassTypeParameters :: !a, classHeritage :: ![a], classBody :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Eq1 AbstractClass where liftEq = genericLiftEq
 instance Ord1 AbstractClass where liftCompare = genericLiftCompare
@@ -856,11 +852,11 @@ instance Evaluatable AbstractClass where
       void $ subtermValue classBody
       classEnv <- Env.head <$> getEnv
       klass name supers classEnv
-    Rval <$> (v <$ modifyEnv (Env.insert name addr))
+    Rval v <$ bind name addr
 
 
 data JsxElement a = JsxElement { _jsxOpeningElement :: !a,  _jsxElements :: ![a], _jsxClosingElement :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 JsxElement
 
@@ -870,7 +866,7 @@ instance Show1 JsxElement where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxElement
 
 newtype JsxText a = JsxText ByteString
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 JsxText
 
@@ -880,7 +876,7 @@ instance Show1 JsxText where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxText
 
 newtype JsxExpression a = JsxExpression { _jsxExpression :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 JsxExpression
 
@@ -890,7 +886,7 @@ instance Show1 JsxExpression where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxExpression
 
 data JsxOpeningElement a = JsxOpeningElement { _jsxOpeningElementIdentifier :: !a,  _jsxAttributes :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 JsxOpeningElement
 
@@ -900,7 +896,7 @@ instance Show1 JsxOpeningElement where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxOpeningElement
 
 newtype JsxClosingElement a = JsxClosingElement { _jsxClosingElementIdentifier :: a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 JsxClosingElement
 
@@ -910,7 +906,7 @@ instance Show1 JsxClosingElement where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxClosingElement
 
 data JsxSelfClosingElement a = JsxSelfClosingElement { _jsxSelfClosingElementIdentifier :: !a, _jsxSelfClosingElementAttributes :: ![a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 JsxSelfClosingElement
 
@@ -920,7 +916,7 @@ instance Show1 JsxSelfClosingElement where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxSelfClosingElement
 
 data JsxAttribute a = JsxAttribute { _jsxAttributeTarget :: !a, _jsxAttributeValue :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 JsxAttribute
 
@@ -930,7 +926,7 @@ instance Show1 JsxAttribute where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxAttribute
 
 newtype ImplementsClause a = ImplementsClause { _implementsClauseTypes :: [a] }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 ImplementsClause
 
@@ -940,7 +936,7 @@ instance Show1 ImplementsClause where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable ImplementsClause
 
 data OptionalParameter a = OptionalParameter { _optionalParameterContext :: ![a], _optionalParameterSubject :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 OptionalParameter
 
@@ -950,7 +946,7 @@ instance Show1 OptionalParameter where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable OptionalParameter
 
 data RequiredParameter a = RequiredParameter { _requiredParameterContext :: ![a], _requiredParameterSubject :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 RequiredParameter
 
@@ -960,7 +956,7 @@ instance Show1 RequiredParameter where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable RequiredParameter
 
 data RestParameter a = RestParameter { _restParameterContext :: ![a], _restParameterSubject :: !a }
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 RestParameter
 
@@ -970,7 +966,7 @@ instance Show1 RestParameter where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable RestParameter
 
 newtype JsxFragment a = JsxFragment [a]
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 JsxFragment
 
@@ -980,7 +976,7 @@ instance Show1 JsxFragment where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JsxFragment
 
 data JsxNamespaceName a = JsxNamespaceName a a
-  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
+  deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance ToJSONFields1 JsxNamespaceName
 

src/Parsing/TreeSitter.hs

@@ -7,7 +7,10 @@ module Parsing.TreeSitter
 import Prologue
 
 import Control.Concurrent.Async
-import Control.Monad
+import Control.Exception (throwIO)
+import Control.Monad.Effect
+import Control.Monad.Effect.Trace
+import Control.Monad.IO.Class
 import Data.AST (AST, Node (Node))
 import Data.Blob
 import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
@@ -18,6 +21,7 @@ import Data.Term
 import Foreign
 import Foreign.C.Types (CBool (..))
 import Foreign.Marshal.Array (allocaArray)
+import Semantic.IO hiding (Source)
 import System.Timeout
 
 import qualified TreeSitter.Language as TS
@@ -27,50 +31,65 @@ import qualified TreeSitter.Tree as TS
 
 newtype Timeout = Milliseconds Int
 
--- Change this to putStrLn if you want to debug the locking/cancellation code.
--- TODO: Someday we should run this all in Eff so that we can 'trace'.
-dbg :: String -> IO ()
-dbg = const (pure ())
+data Result grammar
+  = Failed
+  | Succeeded (AST [] grammar)
 
-runParser :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Maybe (AST [] grammar))
-runParser parser blobSource  = unsafeUseAsCStringLen (sourceBytes blobSource) $ \ (source, len) ->
+runParser :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Result grammar)
+runParser parser blobSource  = unsafeUseAsCStringLen (sourceBytes blobSource) $ \ (source, len) -> do
     alloca (\ rootPtr -> do
       let acquire = do
-            dbg "Starting parse"
             -- Change this to TS.ts_parser_loop_until_cancelled if you want to test out cancellation
             TS.ts_parser_parse_string parser nullPtr source len
 
       let release t
-            | t == nullPtr = dbg "Parse failed"
-            | otherwise = dbg "Parse completed" *> TS.ts_tree_delete t
+            | t == nullPtr = pure ()
+            | otherwise = TS.ts_tree_delete t
 
       let go treePtr = do
             if treePtr == nullPtr
-              then pure Nothing
+              then pure Failed
               else do
                 TS.ts_tree_root_node_p treePtr rootPtr
-                fmap Just (peek rootPtr >>= anaM toAST)
+                ptr <- peek rootPtr
+                Succeeded <$> anaM toAST ptr
       bracket acquire release go)
 
+-- | The semantics of @bracket before after handler@ are as follows:
+-- * Exceptions in @before@ and @after@ are thrown in IO.
+-- * @after@ is called on IO exceptions in @handler@, and then rethrown in IO.
+-- * If @handler@ completes successfully, @after@ is called
+-- Call 'catchException' at the call site if you want to recover.
+bracket' :: (Member IO r) => IO a -> (a -> IO b) -> (a -> Eff r c) -> Eff r c
+bracket' before after action = do
+  a <- liftIO before
+  let cleanup = liftIO (after a)
+  res <- action a `catchException` (\(e :: SomeException) -> cleanup >> liftIO (throwIO e))
+  res <$ cleanup
+
 -- | Parse 'Source' with the given 'TS.Language' and return its AST.
 -- Returns Nothing if the operation timed out.
-parseToAST :: (Bounded grammar, Enum grammar) => Timeout -> Ptr TS.Language -> Blob -> IO (Maybe (AST [] grammar))
-parseToAST (Milliseconds s) language Blob{..} = bracket TS.ts_parser_new TS.ts_parser_delete $ \ parser -> do
+parseToAST :: (Bounded grammar, Enum grammar, Member IO effects, Member Trace effects) => Timeout -> Ptr TS.Language -> Blob -> Eff effects (Maybe (AST [] grammar))
+parseToAST (Milliseconds s) language Blob{..} = bracket' TS.ts_parser_new TS.ts_parser_delete $ \ parser -> do
   let parserTimeout = s * 1000
 
+  liftIO $ do
     TS.ts_parser_halt_on_error parser (CBool 1)
     TS.ts_parser_set_language parser language
 
-  parsing <- async (runParser parser blobSource)
+  trace "tree-sitter: beginning parsing"
+
+  parsing <- liftIO . async $ runParser parser blobSource
 
   -- Kick the parser off asynchronously and wait according to the provided timeout.
-  res <- timeout parserTimeout (wait parsing)
+  res <- liftIO . timeout parserTimeout $ wait parsing
 
-  -- If we get a Nothing back, then we failed, so we need to disable the parser, which
-  -- will let the call to runParser terminate, cleaning up appropriately
-  when (isNothing res) (TS.ts_parser_set_enabled parser (CBool 0))
-
-  pure (join res)
+  case res of
+    Just Failed          -> Nothing  <$ trace "tree-sitter: parsing failed"
+    Just (Succeeded ast) -> Just ast <$ trace "tree-sitter: parsing succeeded"
+    Nothing -> do
+      trace "tree-sitter: parsing timed out"
+      Nothing <$ liftIO (TS.ts_parser_set_enabled parser (CBool 0))
 
 
 toAST :: forall grammar . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node)

src/Prologue.hs

@@ -35,7 +35,6 @@ import Control.Monad as X hiding (fail, return, unless, when)
 import Control.Monad.Except as X (MonadError (..))
 import Control.Monad.Fail as X (MonadFail (..))
 import Data.Algebra as X
-import Data.Align.Generic as X (GAlign)
 import Data.Bifoldable as X
 import Data.Bifunctor as X (Bifunctor (..))
 import Data.Bitraversable as X

src/Rendering/Graph.hs

@@ -28,7 +28,7 @@ runGraph :: Eff '[Fresh, Reader (Graph vertex)] (Graph vertex) -> Graph vertex
 runGraph = run . runReader mempty . runFresh 0
 
 
-termAlgebra :: (ConstructorName syntax, Foldable syntax, Members '[Fresh, Reader (Graph (Vertex tag))] effs)
+termAlgebra :: (ConstructorName syntax, Foldable syntax, Member Fresh effs, Member (Reader (Graph (Vertex tag))) effs)
             => tag
             -> TermF syntax ann (Eff effs (Graph (Vertex tag)))
             -> Eff effs (Graph (Vertex tag))
@@ -63,7 +63,7 @@ data DiffTag = Deleted | Inserted | Merged
 
 
 class ToTreeGraph vertex t | t -> vertex where
-  toTreeGraph :: Members '[Fresh, Reader (Graph vertex)] effs => t (Eff effs (Graph vertex)) -> Eff effs (Graph vertex)
+  toTreeGraph :: (Member Fresh effs, Member (Reader (Graph vertex)) effs) => t (Eff effs (Graph vertex)) -> Eff effs (Graph vertex)
 
 instance (ConstructorName syntax, Foldable syntax) => ToTreeGraph (Vertex ()) (TermF syntax ann) where
   toTreeGraph = termAlgebra ()

src/Semantic/AST.hs

@@ -16,7 +16,7 @@ data SomeAST where
 withSomeAST :: (forall grammar . Show grammar => AST [] grammar -> a) -> SomeAST -> a
 withSomeAST f (SomeAST ast) = f ast
 
-astParseBlob :: Members '[Task, Exc SomeException] effs => Blob -> Eff effs SomeAST
+astParseBlob :: (Member (Exc SomeException) effs, Member Task effs) => Blob -> Eff effs SomeAST
 astParseBlob blob@Blob{..}
   | Just (SomeASTParser parser) <- someASTParser <$> blobLanguage
   = SomeAST <$> parse parser blob
@@ -26,7 +26,7 @@ astParseBlob blob@Blob{..}
 data ASTFormat = SExpression | JSON | Show
   deriving (Show)
 
-runASTParse :: Members '[Distribute WrappedTask, Task, Exc SomeException] effects => ASTFormat -> [Blob] -> Eff effects F.Builder
+runASTParse :: (Member (Distribute WrappedTask) effects, Member Task effects) => ASTFormat -> [Blob] -> Eff effects F.Builder
 runASTParse SExpression = distributeFoldMap (WrapTask . (astParseBlob >=> withSomeAST (serialize (F.SExpression F.ByShow))))
 runASTParse Show        = distributeFoldMap (WrapTask . (astParseBlob >=> withSomeAST (serialize F.Show)))
 runASTParse JSON        = distributeFoldMap (\ blob -> WrapTask (astParseBlob blob >>= withSomeAST (render (renderJSONAST blob)))) >=> serialize F.JSON

src/Semantic/CLI.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fforce-recomp #-} -- So that gitHash is correct.
 {-# LANGUAGE ApplicativeDo, RankNTypes, TemplateHaskell #-}
 module Semantic.CLI
 ( main

src/Semantic/Diff.hs

@@ -20,7 +20,7 @@ import Semantic.Stat as Stat
 import Semantic.Task as Task
 import Serializing.Format
 
-runDiff :: Members '[Distribute WrappedTask, Task, Telemetry, Exc SomeException, IO] effs => DiffRenderer output -> [BlobPair] -> Eff effs Builder
+runDiff :: (Member (Distribute WrappedTask) effs, Member Task effs) => DiffRenderer output -> [BlobPair] -> Eff effs Builder
 runDiff ToCDiffRenderer         = withParsedBlobPairs (decorate . declarationAlgebra) (render . renderToCDiff) >=> serialize JSON
 runDiff JSONDiffRenderer        = withParsedBlobPairs (const (decorate constructorLabel >=> decorate identifierLabel)) (render . renderJSONDiff) >=> serialize JSON
 runDiff SExpressionDiffRenderer = withParsedBlobPairs (const pure) (const (serialize (SExpression ByConstructorName)))
@@ -33,28 +33,28 @@ data SomeTermPair typeclasses ann where
 withSomeTermPair :: (forall syntax . ApplyAll typeclasses syntax => Join These (Term syntax ann) -> a) -> SomeTermPair typeclasses ann -> a
 withSomeTermPair with (SomeTermPair terms) = with terms
 
-diffBlobTOCPairs :: Members '[Distribute WrappedTask, Task, Telemetry, Exc SomeException, IO] effs => [BlobPair] -> Eff effs ([TOCSummary], [TOCSummary])
+diffBlobTOCPairs :: Member (Distribute WrappedTask) effs => [BlobPair] -> Eff effs ([TOCSummary], [TOCSummary])
 diffBlobTOCPairs = withParsedBlobPairs (decorate . declarationAlgebra) (render . renderRPCToCDiff)
 
-type CanDiff syntax = (ConstructorName syntax, Diffable syntax, Eq1 syntax, GAlign syntax, HasDeclaration syntax, IdentifierName syntax, Hashable1 syntax, Show1 syntax, ToJSONFields1 syntax, Traversable syntax)
+type CanDiff syntax = (ConstructorName syntax, Diffable syntax, Eq1 syntax, HasDeclaration syntax, IdentifierName syntax, Hashable1 syntax, Show1 syntax, ToJSONFields1 syntax, Traversable syntax)
 
-withParsedBlobPairs :: (Members '[Distribute WrappedTask, Exc SomeException, IO, Task, Telemetry] effs, Monoid output)
+withParsedBlobPairs :: (Member (Distribute WrappedTask) effs, Monoid output)
                     => (forall syntax . CanDiff syntax => Blob -> Term syntax (Record Location) -> TaskEff (Term syntax (Record fields)))
                     -> (forall syntax . CanDiff syntax => BlobPair -> Diff syntax (Record fields) (Record fields) -> TaskEff output)
                     -> [BlobPair]
                     -> Eff effs output
 withParsedBlobPairs decorate render = distributeFoldMap (\ blobs -> WrapTask (withParsedBlobPair decorate blobs >>= withSomeTermPair (diffTerms blobs >=> render blobs)))
-  where diffTerms :: (Diffable syntax, Eq1 syntax, GAlign syntax, Hashable1 syntax, Traversable syntax, Members '[IO, Task, Telemetry] effs) => BlobPair -> Join These (Term syntax (Record fields)) -> Eff effs (Diff syntax (Record fields) (Record fields))
+  where diffTerms :: (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax, Member IO effs, Member Task effs, Member Telemetry effs) => BlobPair -> Join These (Term syntax (Record fields)) -> Eff effs (Diff syntax (Record fields) (Record fields))
         diffTerms blobs terms = time "diff" languageTag $ do
           diff <- diff (runJoin terms)
           diff <$ writeStat (Stat.count "diff.nodes" (bilength diff) languageTag)
           where languageTag = languageTagForBlobPair blobs
 
-withParsedBlobPair :: Members '[Distribute WrappedTask, Exc SomeException, Task] effs
+withParsedBlobPair :: (Member (Distribute WrappedTask) effs, Member (Exc SomeException) effs)
                    => (forall syntax . (CanDiff syntax) => Blob -> Term syntax (Record Location) -> TaskEff (Term syntax (Record fields)))
                    -> BlobPair
-                   -> Eff effs (SomeTermPair '[ConstructorName, Diffable, Eq1, GAlign, HasDeclaration, Hashable1, IdentifierName, Show1, ToJSONFields1, Traversable] (Record fields))
+                   -> Eff effs (SomeTermPair '[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, IdentifierName, Show1, ToJSONFields1, Traversable] (Record fields))
 withParsedBlobPair decorate blobs
-  | Just (SomeParser parser) <- someParser @'[ConstructorName, Diffable, Eq1, GAlign, HasDeclaration, Hashable1, IdentifierName, Show1, ToJSONFields1, Traversable] <$> languageForBlobPair blobs
+  | Just (SomeParser parser) <- someParser @'[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, IdentifierName, Show1, ToJSONFields1, Traversable] <$> languageForBlobPair blobs
   = SomeTermPair <$> distributeFor blobs (\ blob -> WrapTask (parse parser blob >>= decorate blob))
   | otherwise = noLanguageForBlob (pathForBlobPair blobs)

src/Semantic/Distribute.hs

@@ -39,6 +39,6 @@ data Distribute task output where
 
 
 -- | Evaluate a 'Distribute' effect concurrently.
-runDistribute :: Members '[Exc SomeException, IO] effs => (forall output . task output -> IO (Either SomeException output)) -> Eff (Distribute task ': effs) a -> Eff effs a
+runDistribute :: (Member (Exc SomeException) effs, Member IO effs) => (forall output . task output -> IO (Either SomeException output)) -> Eff (Distribute task ': effs) a -> Eff effs a
 runDistribute action = interpret (\ (Distribute tasks) ->
   liftIO (Async.mapConcurrently action tasks) >>= either throwError pure . sequenceA . withStrategy (parTraversable (parTraversable rseq)))

src/Semantic/Graph.hs

@@ -39,7 +39,7 @@ import           Semantic.Task as Task
 
 data GraphType = ImportGraph | CallGraph
 
-runGraph :: Members '[Distribute WrappedTask, Files, Resolution, Task, Exc SomeException, Telemetry, Trace] effs
+runGraph :: ( Member (Distribute WrappedTask) effs, Member (Exc SomeException) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
          => GraphType
          -> Bool
          -> Project
@@ -62,16 +62,16 @@ runGraph graphType includePackages project
             . runIgnoringTrace
             . resumingLoadError
             . resumingUnspecialized
-            . resumingValueError
             . resumingEnvironmentError
             . resumingEvalError
             . resumingResolutionError
             . resumingAddressError
+            . resumingValueError
+            . runTermEvaluator @_ @_ @(Value (Hole (Located Precise)) (Eff _))
             . graphing
-            . runTermEvaluator @_ @_ @(Value (Located Precise))
 
 -- | Parse a list of files into a 'Package'.
-parsePackage :: Members '[Distribute WrappedTask, Files, Resolution, Task, Trace] effs
+parsePackage :: (Member (Distribute WrappedTask) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
              => Parser term -- ^ A parser.
              -> Maybe File  -- ^ Prelude (optional).
              -> Project     -- ^ Project to parse into a package.
@@ -87,11 +87,11 @@ parsePackage parser preludeFile project@Project{..} = do
     n = name (projectName project)
 
     -- | Parse all files in a project into 'Module's.
-    parseModules :: Members '[Distribute WrappedTask, Files, Task] effs => Parser term -> Project -> Eff effs [Module term]
+    parseModules :: Member (Distribute WrappedTask) effs => Parser term -> Project -> Eff effs [Module term]
     parseModules parser Project{..} = distributeFor (projectEntryPoints <> projectFiles) (WrapTask . parseModule parser (Just projectRootDir))
 
 -- | Parse a file into a 'Module'.
-parseModule :: Members '[Files, Task] effs => Parser term -> Maybe FilePath -> File -> Eff effs (Module term)
+parseModule :: (Member Files effs, Member Task effs) => Parser term -> Maybe FilePath -> File -> Eff effs (Module term)
 parseModule parser rootDir file = do
   blob <- readBlob file
   moduleForBlob rootDir blob <$> parse parser blob
@@ -100,8 +100,8 @@ parseModule parser rootDir file = do
 withTermSpans :: ( HasField fields Span
                  , Member (Reader Span) effects
                  )
-              => SubtermAlgebra (TermF syntax (Record fields)) term (TermEvaluator term location value effects a)
-              -> SubtermAlgebra (TermF syntax (Record fields)) term (TermEvaluator term location value effects a)
+              => SubtermAlgebra (TermF syntax (Record fields)) term (TermEvaluator term address value effects a)
+              -> SubtermAlgebra (TermF syntax (Record fields)) term (TermEvaluator term address value effects a)
 withTermSpans recur term = withCurrentSpan (getField (termFAnnotation term)) (recur term)
 
 resumingResolutionError :: (Applicative (m effects), Effectful m, Member Trace effects) => m (Resumable ResolutionError ': effects) a -> m effects a
@@ -109,12 +109,11 @@ resumingResolutionError = runResolutionErrorWith (\ err -> trace ("ResolutionErr
   NotFoundError nameToResolve _ _ -> pure  nameToResolve
   GoImportError pathToResolve     -> pure [pathToResolve])
 
-resumingLoadError :: Member Trace effects => Evaluator location value (Resumable (LoadError location value) ': effects) a -> Evaluator location value effects a
+resumingLoadError :: Member Trace effects => Evaluator address value (Resumable (LoadError address value) ': effects) a -> Evaluator address value effects a
 resumingLoadError = runLoadErrorWith (\ (ModuleNotFound path) -> trace ("LoadError: " <> path) $> Nothing)
 
-resumingEvalError :: (AbstractHole value, Member Trace effects, Show value) => Evaluator location value (Resumable (EvalError value) ': effects) a -> Evaluator location value effects a
+resumingEvalError :: Member Trace effects => Evaluator address value (Resumable EvalError ': effects) a -> Evaluator address value effects a
 resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError" <> show err) *> case err of
-  EnvironmentLookupError{} -> pure hole
   DefaultExportError{}     -> pure ()
   ExportError{}            -> pure ()
   IntegerFormatError{}     -> pure 0
@@ -122,15 +121,15 @@ resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError" <> show err) *
   RationalFormatError{}    -> pure 0
   FreeVariablesError names -> pure (fromMaybeLast "unknown" names))
 
-resumingUnspecialized :: (Member Trace effects, AbstractHole value) => Evaluator location value (Resumable (Unspecialized value) ': effects) a -> Evaluator location value effects a
+resumingUnspecialized :: (Member Trace effects, AbstractHole value) => Evaluator address value (Resumable (Unspecialized value) ': effects) a -> Evaluator address value effects a
 resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ("Unspecialized:" <> show err) $> Rval hole)
 
-resumingAddressError :: (AbstractHole value, Lower (Cell location value), Member Trace effects, Show location) => Evaluator location value (Resumable (AddressError location value) ': effects) a -> Evaluator location value effects a
+resumingAddressError :: (AbstractHole value, Lower (Cell address value), Member Trace effects, Show address) => Evaluator address value (Resumable (AddressError address value) ': effects) a -> Evaluator address value effects a
 resumingAddressError = runAddressErrorWith (\ err -> trace ("AddressError:" <> show err) *> case err of
   UnallocatedAddress _   -> pure lowerBound
   UninitializedAddress _ -> pure hole)
 
-resumingValueError :: (Members '[State (Environment location (Value location)), Trace] effects, Show location) => Evaluator location (Value location) (Resumable (ValueError location) ': effects) a -> Evaluator location (Value location) effects a
+resumingValueError :: (Member (State (Environment address)) effects, Member Trace effects, Show address) => Evaluator address (Value address body) (Resumable (ValueError address body) ': effects) a -> Evaluator address (Value address body) effects a
 resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err) *> case err of
   CallError val     -> pure val
   StringError val   -> pure (pack (show val))
@@ -146,7 +145,7 @@ resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err
   KeyValueError{}   -> pure (hole, hole)
   ArithmeticError{} -> pure hole)
 
-resumingEnvironmentError :: AbstractHole value => Evaluator location value (Resumable (EnvironmentError value) ': effects) a -> Evaluator location value effects (a, [Name])
+resumingEnvironmentError :: AbstractHole address => Evaluator address value (Resumable (EnvironmentError address) ': effects) a -> Evaluator address value effects (a, [Name])
 resumingEnvironmentError
   = runState []
   . reinterpret (\ (Resumable (FreeVariable name)) -> modify' (name :) $> hole)

src/Semantic/IO.hs

@@ -1,34 +1,35 @@
 {-# LANGUAGE DeriveAnyClass, DeriveDataTypeable, DuplicateRecordFields, GADTs, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
 module Semantic.IO
-( readFile
-, readFilePair
-, isDirectory
-, readBlobPairsFromHandle
-, readBlobsFromHandle
-, readProjectFromPaths
-, readBlobsFromDir
-, findFiles
-, languageForFilePath
-, NoLanguageForBlob(..)
-, noLanguageForBlob
-, readBlob
-, readBlobs
-, readBlobPairs
-, readProject
-, findFilesInDir
-, write
+( Destination(..)
+, Files
 , Handle(..)
-, getHandle
 , IO.IOMode(..)
+, NoLanguageForBlob(..)
+, Source(..)
+, catchException
+, findFiles
+, findFilesInDir
+, getHandle
+, isDirectory
+, languageForFilePath
+, noLanguageForBlob
+, openFileForReading
+, readBlob
+, readBlobPairs
+, readBlobPairsFromHandle
+, readBlobs
+, readBlobsFromDir
+, readBlobsFromHandle
+, readFile
+, readFilePair
+, readProject
+, readProjectFromPaths
+, rethrowing
+, runFiles
+, stderr
 , stdin
 , stdout
-, stderr
-, openFileForReading
-, Source(..)
-, Destination(..)
-, Files
-, runFiles
-, rethrowing
+, write
 ) where
 
 import qualified Control.Exception as Exc
@@ -251,7 +252,7 @@ data Files out where
   Write       :: Destination -> B.Builder -> Files ()
 
 -- | Run a 'Files' effect in 'IO'.
-runFiles :: Members '[Exc SomeException, IO] effs => Eff (Files ': effs) a -> Eff effs a
+runFiles :: (Member (Exc SomeException) effs, Member IO effs) => Eff (Files ': effs) a -> Eff effs a
 runFiles = interpret $ \ files -> case files of
   Read (FromPath path)         -> rethrowing (readBlobFromPath path)
   Read (FromHandle handle)     -> rethrowing (readBlobsFromHandle handle)

src/Semantic/Parse.hs

@@ -18,7 +18,7 @@ import Semantic.IO (noLanguageForBlob)
 import Semantic.Task
 import Serializing.Format
 
-runParse :: Members '[Distribute WrappedTask, Task, Exc SomeException] effs => TermRenderer output -> [Blob] -> Eff effs Builder
+runParse :: (Member (Distribute WrappedTask) effs, Member Task effs) => TermRenderer output -> [Blob] -> Eff effs Builder
 runParse JSONTermRenderer             = withParsedBlobs (\ blob -> decorate constructorLabel >=> decorate identifierLabel >=> render (renderJSONTerm blob)) >=> serialize JSON
 runParse SExpressionTermRenderer      = withParsedBlobs (const (serialize (SExpression ByConstructorName)))
 runParse ShowTermRenderer             = withParsedBlobs (const (serialize Show))
@@ -27,8 +27,8 @@ runParse ImportsTermRenderer          = withParsedBlobs (\ blob -> decorate (dec
 runParse (SymbolsTermRenderer fields) = withParsedBlobs (\ blob -> decorate (declarationAlgebra blob) >=> render (renderSymbolTerms . renderToSymbols fields blob)) >=> serialize JSON
 runParse DOTTermRenderer              = withParsedBlobs (const (render renderTreeGraph)) >=> serialize (DOT (termStyle "terms"))
 
-withParsedBlobs :: (Members '[Distribute WrappedTask, Task, Exc SomeException] effs, Monoid output) => (forall syntax . (ConstructorName syntax, Foldable syntax, Functor syntax, HasDeclaration syntax, HasPackageDef syntax, IdentifierName syntax, Show1 syntax, ToJSONFields1 syntax) => Blob -> Term syntax (Record Location) -> TaskEff output) -> [Blob] -> Eff effs output
+withParsedBlobs :: (Member (Distribute WrappedTask) effs, Monoid output) => (forall syntax . (ConstructorName syntax, Foldable syntax, Functor syntax, HasDeclaration syntax, HasPackageDef syntax, IdentifierName syntax, Show1 syntax, ToJSONFields1 syntax) => Blob -> Term syntax (Record Location) -> TaskEff output) -> [Blob] -> Eff effs output
 withParsedBlobs render = distributeFoldMap (\ blob -> WrapTask (parseSomeBlob blob >>= withSomeTerm (render blob)))
 
-parseSomeBlob :: Members '[Task, Exc SomeException] effs => Blob -> Eff effs (SomeTerm '[ConstructorName, Foldable, Functor, HasDeclaration, HasPackageDef, IdentifierName, Show1, ToJSONFields1] (Record Location))
+parseSomeBlob :: (Member (Exc SomeException) effs, Member Task effs) => Blob -> Eff effs (SomeTerm '[ConstructorName, Foldable, Functor, HasDeclaration, HasPackageDef, IdentifierName, Show1, ToJSONFields1] (Record Location))
 parseSomeBlob blob@Blob{..} = maybe (noLanguageForBlob blobPath) (flip parse blob . someParser) blobLanguage

src/Semantic/Resolution.hs

@@ -39,7 +39,7 @@ data Resolution output where
   NodeJSResolution :: FilePath -> Text -> [FilePath] -> Resolution (Map FilePath FilePath)
   NoResolution :: Resolution (Map FilePath FilePath)
 
-runResolution :: Members '[Files] effs => Eff (Resolution ': effs) a -> Eff effs a
+runResolution :: Member Files effs => Eff (Resolution ': effs) a -> Eff effs a
 runResolution = interpret $ \ res -> case res of
   NodeJSResolution dir prop excludeDirs -> nodeJSResolutionMap dir prop excludeDirs
   NoResolution -> pure Map.empty

src/Semantic/Task.hs

@@ -104,7 +104,7 @@ parse :: Member Task effs => Parser term -> Blob -> Eff effs term
 parse parser = send . Parse parser
 
 -- | A task running some 'Analysis.TermEvaluator' to completion.
-analyze :: Member Task effs => (Analysis.TermEvaluator term location value effects a -> result) -> Analysis.TermEvaluator term location value effects a -> Eff effs result
+analyze :: Member Task effs => (Analysis.TermEvaluator term address value effects a -> result) -> Analysis.TermEvaluator term address value effects a -> Eff effs result
 analyze interpret analysis = send (Analyze interpret analysis)
 
 -- | A task which decorates a 'Term' with values computed using the supplied 'RAlgebra' function.
@@ -112,7 +112,7 @@ decorate :: (Functor f, Member Task effs) => RAlgebra (TermF f (Record fields))
 decorate algebra = send . Decorate algebra
 
 -- | A task which diffs a pair of terms using the supplied 'Differ' function.
-diff :: (Diffable syntax, Eq1 syntax, GAlign syntax, Hashable1 syntax, Traversable syntax, Member Task effs) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Eff effs (Diff syntax (Record fields1) (Record fields2))
+diff :: (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax, Member Task effs) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Eff effs (Diff syntax (Record fields1) (Record fields2))
 diff terms = send (Semantic.Task.Diff terms)
 
 -- | A task which renders some input using the supplied 'Renderer' function.
@@ -160,14 +160,14 @@ runTraceInTelemetry = interpret (\ (Trace str) -> writeLog Debug str [])
 -- | An effect describing high-level tasks to be performed.
 data Task output where
   Parse     :: Parser term -> Blob -> Task term
-  Analyze  :: (Analysis.TermEvaluator term location value effects a -> result) -> Analysis.TermEvaluator term location value effects a -> Task result
+  Analyze   :: (Analysis.TermEvaluator term address value effects a -> result) -> Analysis.TermEvaluator term address value effects a -> Task result
   Decorate  :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fields)) field -> Term f (Record fields) -> Task (Term f (Record (field ': fields)))
-  Diff      :: (Diffable syntax, Eq1 syntax, GAlign syntax, Hashable1 syntax, Traversable syntax) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Task (Diff syntax (Record fields1) (Record fields2))
+  Diff      :: (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Task (Diff syntax (Record fields1) (Record fields2))
   Render    :: Renderer input output -> input -> Task output
   Serialize :: Format input -> input -> Task Builder
 
 -- | Run a 'Task' effect by performing the actions in 'IO'.
-runTaskF :: Members '[Reader Options, Telemetry, Exc SomeException, Trace, IO] effs => Eff (Task ': effs) a -> Eff effs a
+runTaskF :: (Member (Exc SomeException) effs, Member IO effs, Member (Reader Options) effs, Member Telemetry effs, Member Trace effs) => Eff (Task ': effs) a -> Eff effs a
 runTaskF = interpret $ \ task -> case task of
   Parse parser blob -> runParser blob parser
   Analyze interpret analysis -> pure (interpret analysis)
@@ -191,11 +191,11 @@ defaultTimeout :: Timeout
 defaultTimeout = Milliseconds 5000
 
 -- | Parse a 'Blob' in 'IO'.
-runParser :: Members '[Reader Options, Telemetry, Exc SomeException, IO, Trace] effs => Blob -> Parser term -> Eff effs term
+runParser :: (Member (Exc SomeException) effs, Member IO effs, Member (Reader Options) effs, Member Telemetry effs, Member Trace effs) => Blob -> Parser term -> Eff effs term
 runParser blob@Blob{..} parser = case parser of
   ASTParser language ->
     time "parse.tree_sitter_ast_parse" languageTag $
-      IO.rethrowing (parseToAST defaultTimeout language blob)
+      parseToAST defaultTimeout language blob
         >>= maybeM (throwError (SomeException ParserTimedOut))
 
   AssignmentParser parser assignment -> do

src/Semantic/Telemetry.hs

@@ -23,7 +23,7 @@ writeStat :: Member Telemetry effs => Stat -> Eff effs ()
 writeStat stat = send (WriteStat stat)
 
 -- | A task which measures and stats the timing of another task.
-time :: Members '[Telemetry, IO] effs => String -> [(String, String)] -> Eff effs output -> Eff effs output
+time :: (Member IO effs, Member Telemetry effs) => String -> [(String, String)] -> Eff effs output -> Eff effs output
 time statName tags task = do
   (a, stat) <- withTiming statName tags task
   a <$ writeStat stat

src/Semantic/Util.hs

@@ -4,9 +4,8 @@ module Semantic.Util where
 
 import           Analysis.Abstract.Caching
 import           Analysis.Abstract.Collecting
-import           Analysis.Abstract.Evaluating as X
-import           Control.Abstract.Evaluator
-import           Control.Abstract.TermEvaluator
+import           Analysis.Abstract.Evaluating
+import           Control.Abstract
 import           Control.Monad.Effect.Trace (runPrintingTrace)
 import           Data.Abstract.Address
 import           Data.Abstract.Evaluatable
@@ -28,7 +27,7 @@ import           Semantic.Graph
 import           Semantic.IO as IO
 import           Semantic.Task
 import           Text.Show (showListWith)
-import           Text.Show.Pretty
+import           Text.Show.Pretty (ppShow)
 
 import qualified Language.Python.Assignment as Python
 import qualified Language.Ruby.Assignment as Ruby
@@ -40,26 +39,13 @@ justEvaluating
   . evaluating
   . runPrintingTrace
   . runLoadError
-  . runValueError
   . runUnspecialized
   . runResolutionError
   . runEnvironmentError
   . runEvalError
   . runAddressError
-  . runTermEvaluator @_ @Precise
-
-evaluatingWithHoles
-  = runM
-  . evaluating
-  . runPrintingTrace
-  . resumingLoadError
-  . resumingUnspecialized
-  . resumingValueError
-  . resumingEnvironmentError
-  . resumingEvalError
-  . resumingResolutionError
-  . resumingAddressError
-  . runTermEvaluator @_ @Precise
+  . runTermEvaluator @_ @Precise @(Value Precise (Eff _))
+  . runValueError
 
 checking
   = runM @_ @IO
@@ -81,7 +67,6 @@ evalRubyProject path = justEvaluating =<< evaluateProject rubyParser Language.Ru
 evalPHPProject path = justEvaluating =<< evaluateProject phpParser Language.PHP Nothing path
 evalPythonProject path = justEvaluating =<< evaluateProject pythonParser Language.Python pythonPrelude path
 evalJavaScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.JavaScript javaScriptPrelude path
-evalTypeScriptProjectQuietly path = evaluatingWithHoles =<< evaluateProject typescriptParser Language.TypeScript Nothing path
 evalTypeScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.TypeScript Nothing path
 
 typecheckGoFile path = checking =<< evaluateProjectWithCaching goParser Language.Go Nothing path

test/Analysis/Go/Spec.hs

@@ -1,11 +1,9 @@
-{-# LANGUAGE OverloadedLists #-}
 module Analysis.Go.Spec (spec) where
 
 import Data.Abstract.Environment as Env
 import Data.Abstract.Evaluatable (EvalError(..))
-import qualified Language.Go.Assignment as Go
 import qualified Data.Language as Language
-
+import qualified Language.Go.Assignment as Go
 import SpecHelpers
 
 

test/Analysis/PHP/Spec.hs

@@ -1,11 +1,10 @@
-{-# LANGUAGE OverloadedLists #-}
 module Analysis.PHP.Spec (spec) where
 
+import Control.Abstract
 import Data.Abstract.Environment as Env
 import Data.Abstract.Evaluatable (EvalError(..))
-import qualified Language.PHP.Assignment as PHP
 import qualified Data.Language as Language
-
+import qualified Language.PHP.Assignment as PHP
 import SpecHelpers
 
 
@@ -13,12 +12,14 @@ spec :: Spec
 spec = parallel $ do
   describe "PHP" $ do
     it "evaluates include and require" $ do
-      env <- environment . snd . fst <$> evaluate "main.php"
-      Env.names env `shouldBe` [ "bar", "foo" ]
+      ((res, state), _) <- evaluate "main.php"
+      res `shouldBe` Right [unit]
+      Env.names (environment state) `shouldBe` [ "bar", "foo" ]
 
     it "evaluates include_once and require_once" $ do
-      env <- environment . snd . fst <$> evaluate "main_once.php"
-      Env.names env `shouldBe` [ "bar", "foo" ]
+      ((res, state), _) <- evaluate "main_once.php"
+      res `shouldBe` Right [unit]
+      Env.names (environment state) `shouldBe` [ "bar", "foo" ]
 
     it "evaluates namespaces" $ do
       ((_, state), _) <- evaluate "namespaces.php"

test/Analysis/Python/Spec.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE OverloadedLists, OverloadedStrings #-}
 module Analysis.Python.Spec (spec) where
 
 import Data.Abstract.Environment as Env
@@ -37,15 +36,14 @@ spec = parallel $ do
 
     it "subclasses" $ do
       ((res, _), _) <- evaluate "subclass.py"
-      res `shouldBe` Right [injValue (String "\"bar\"")]
+      res `shouldBe` Right [String "\"bar\""]
 
     it "handles multiple inheritance left-to-right" $ do
       ((res, _), _) <- evaluate "multiple_inheritance.py"
-      res `shouldBe` Right [injValue (String "\"foo!\"")]
+      res `shouldBe` Right [String "\"foo!\""]
 
   where
-    ns n = Just . Latest . Last . Just . injValue . Namespace n
-    addr = Address . Precise
+    ns n = Just . Latest . Last . Just . Namespace n
     fixtures = "test/fixtures/python/analysis/"
     evaluate entry = evalPythonProject (fixtures <> entry)
     evalPythonProject path = testEvaluating <$> evaluateProject pythonParser Language.Python pythonPrelude path

test/Analysis/Ruby/Spec.hs

@@ -1,11 +1,10 @@
-{-# LANGUAGE OverloadedLists #-}
-
 module Analysis.Ruby.Spec (spec) where
 
 import Data.Abstract.Environment as Env
 import Data.Abstract.Evaluatable
 import Data.Abstract.Value as Value
 import Data.Abstract.Number as Number
+import Data.AST
 import Control.Monad.Effect (SomeExc(..))
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Map
@@ -22,7 +21,7 @@ spec = parallel $ do
   describe "Ruby" $ do
     it "evaluates require_relative" $ do
       ((res, state), _) <- evaluate "main.rb"
-      res `shouldBe` Right [injValue (Value.Integer (Number.Integer 1))]
+      res `shouldBe` Right [Value.Integer (Number.Integer 1)]
       Env.names (environment state) `shouldContain` ["foo"]
 
     it "evaluates load" $ do
@@ -31,53 +30,52 @@ spec = parallel $ do
 
     it "evaluates load with wrapper" $ do
       ((res, state), _) <- evaluate "load-wrap.rb"
-      res `shouldBe` Left (SomeExc (inject @(EnvironmentError (Value Precise)) (FreeVariable "foo")))
+      res `shouldBe` Left (SomeExc (inject @(EnvironmentError Precise) (FreeVariable "foo")))
       Env.names (environment state) `shouldContain` [ "Object" ]
 
     it "evaluates subclass" $ do
       ((res, state), _) <- evaluate "subclass.rb"
-      res `shouldBe` Right [injValue (String "\"<bar>\"")]
+      res `shouldBe` Right [String "\"<bar>\""]
       Env.names (environment state) `shouldContain` [ "Bar", "Foo" ]
 
       (derefQName (heap state) ("Bar" :| []) (environment state) >>= deNamespace) `shouldBe` Just ("Bar",  ["baz", "foo", "inspect"])
 
     it "evaluates modules" $ do
       ((res, state), _) <- evaluate "modules.rb"
-      res `shouldBe` Right [injValue (String "\"<hello>\"")]
+      res `shouldBe` Right [String "\"<hello>\""]
       Env.names (environment state) `shouldContain` [ "Bar" ]
 
     it "handles break correctly" $ do
       ((res, _), _) <- evaluate "break.rb"
-      res `shouldBe` Right [injValue (Value.Integer (Number.Integer 3))]
+      res `shouldBe` Right [Value.Integer (Number.Integer 3)]
 
     it "handles break correctly" $ do
       ((res, _), _) <- evaluate "next.rb"
-      res `shouldBe` Right [injValue (Value.Integer (Number.Integer 8))]
+      res `shouldBe` Right [Value.Integer (Number.Integer 8)]
 
     it "calls functions with arguments" $ do
       ((res, _), _) <- evaluate "call.rb"
-      res `shouldBe` Right [injValue (Value.Integer (Number.Integer 579))]
+      res `shouldBe` Right [Value.Integer (Number.Integer 579)]
 
     it "evaluates early return statements" $ do
       ((res, _), _) <- evaluate "early-return.rb"
-      res `shouldBe` Right [injValue (Value.Integer (Number.Integer 123))]
+      res `shouldBe` Right [Value.Integer (Number.Integer 123)]
 
     it "has prelude" $ do
       ((res, _), _) <- evaluate "preluded.rb"
-      res `shouldBe` Right [injValue (String "\"<foo>\"")]
+      res `shouldBe` Right [String "\"<foo>\""]
 
     it "evaluates __LINE__" $ do
       ((res, _), _) <- evaluate "line.rb"
-      res `shouldBe` Right [injValue (Value.Integer (Number.Integer 4))]
+      res `shouldBe` Right [Value.Integer (Number.Integer 4)]
 
     it "resolves builtins used in the prelude" $ do
       ((res, _), traces) <- evaluate "puts.rb"
-      res `shouldBe` Right [injValue Unit]
+      res `shouldBe` Right [Unit]
       traces `shouldContain` [ "\"hello\"" ]
 
   where
-    ns n = Just . Latest . Last . Just . injValue . Namespace n
-    addr = Address . Precise
+    ns n = Just . Latest . Last . Just . Namespace n
     fixtures = "test/fixtures/ruby/analysis/"
     evaluate entry = evalRubyProject (fixtures <> entry)
     evalRubyProject path = testEvaluating <$> evaluateProject rubyParser Language.Ruby rubyPrelude path

test/Analysis/TypeScript/Spec.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE OverloadedLists #-}
 module Analysis.TypeScript.Spec (spec) where
 
 import Control.Arrow ((&&&))
@@ -32,11 +31,11 @@ spec = parallel $ do
 
     it "fails exporting symbols not defined in the module" $ do
       ((res, _), _) <- evaluate "bad-export.ts"
-      res `shouldBe` Left (SomeExc (inject @(EvalError (Value Precise)) (ExportError "foo.ts" (Name "pip"))))
+      res `shouldBe` Left (SomeExc (inject @EvalError (ExportError "foo.ts" (name "pip"))))
 
     it "evaluates early return statements" $ do
       ((res, _), _) <- evaluate "early-return.ts"
-      res `shouldBe` Right [injValue (Value.Float (Number.Decimal 123.0))]
+      res `shouldBe` Right [Value.Float (Number.Decimal 123.0)]
 
   where
     fixtures = "test/fixtures/typescript/analysis/"

test/Control/Abstract/Evaluator/Spec.hs

@@ -19,32 +19,27 @@ import SpecHelpers hiding (reassociate)
 spec :: Spec
 spec = parallel $ do
   it "constructs integers" $ do
-    (expected, _) <- evaluate (integer 123)
-    expected `shouldBe` Right (injValue (Value.Integer (Number.Integer 123)))
+    (expected, _) <- evaluate (pure (integer 123))
+    expected `shouldBe` Right (Value.Integer (Number.Integer 123))
 
   it "calls functions" $ do
     (expected, _) <- evaluate $ do
       identity <- closure [name "x"] lowerBound (variable (name "x"))
-      call identity [integer 123]
-    expected `shouldBe` Right (injValue (Value.Integer (Number.Integer 123)))
+      call identity [pure (integer 123)]
+    expected `shouldBe` Right (Value.Integer (Number.Integer 123))
 
 evaluate
   = runM
   . fmap (first reassociate)
-  . evaluating @Precise @(Value Precise)
+  . evaluating @Precise @(Value Precise (Eff _))
   . runReader (PackageInfo (name "test") Nothing mempty)
   . runReader (ModuleInfo "test/Control/Abstract/Evaluator/Spec.hs")
-  . Value.runValueError
+  . runValueError
   . runEnvironmentError
   . runAddressError
   . runAllocator
   . runReturn
   . runLoopControl
-  . fmap fst
-  . runState (Gotos lowerBound)
-  . runGoto Gotos getGotos
-
-newtype Gotos effects = Gotos { getGotos :: GotoTable (State (Gotos effects) ': effects) (Value Precise) }
 
 reassociate :: Either Prelude.String (Either (SomeExc exc1) (Either (SomeExc exc2) (Either (SomeExc exc3) result))) -> Either (SomeExc (Sum '[Const Prelude.String, exc1, exc2, exc3])) result
 reassociate (Left s) = Left (SomeExc (inject (Const s)))

test/Data/Functor/Listable.hs

@@ -47,7 +47,7 @@ import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Comment as Comment
 import qualified Data.Syntax.Declaration as Declaration
 import qualified Data.Syntax.Statement as Statement
-import qualified Data.Abstract.FreeVariables as FV
+import qualified Data.Abstract.Name as Name
 import Data.Term
 import Data.Text as T (Text, pack)
 import qualified Data.Text.Encoding as T
@@ -257,8 +257,8 @@ type ListableSyntax = Sum
    , []
    ]
 
-instance Listable FV.Name where
-  tiers = cons1 FV.name
+instance Listable Name.Name where
+  tiers = cons1 Name.name
 
 instance Listable1 Gram where
   liftTiers tiers = liftCons2 (liftTiers (liftTiers tiers)) (liftTiers (liftTiers tiers)) Gram

test/Data/Mergeable/Spec.hs

@@ -1,61 +0,0 @@
-{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
-module Data.Mergeable.Spec (spec) where
-
-import Control.Applicative (Alternative(..))
-import Data.Functor.Identity
-import Data.Functor.Listable
-import Data.Maybe (catMaybes)
-import Data.Mergeable
-import Test.Hspec
-import Test.Hspec.LeanCheck
-import Test.LeanCheck
-
-spec :: Spec
-spec = parallel $ do
-  describe "[]" $ do
-    withAlternativeInstances sequenceAltLaws (tiers :: [Tier String])
-    withAlternativeInstances mergeLaws (tiers :: [Tier String])
-  describe "Maybe" $ do
-    withAlternativeInstances sequenceAltLaws (tiers :: [Tier (Maybe Char)])
-    withAlternativeInstances mergeLaws (tiers :: [Tier (Maybe Char)])
-  describe "Identity" $ do
-    withAlternativeInstances sequenceAltLaws (Identity `mapT` tiers :: [Tier (Identity Char)])
-    withAlternativeInstances mergeLaws (Identity `mapT` tiers :: [Tier (Identity Char)])
-  describe "ListableSyntax" $ do
-    withAlternativeInstances sequenceAltLaws (tiers :: [Tier (ListableSyntax Char)])
-    withAlternativeInstances mergeLaws (tiers :: [Tier (ListableSyntax Char)])
-
-  prop "subsumes catMaybes/Just" $
-    \ a -> sequenceAlt a `shouldBe` pure (catMaybes (a :: [Maybe Char]))
-
-mergeLaws :: forall f g a. (Mergeable f, Alternative g, Eq (g (f a)), Show (f a), Show (g (f a))) => [Tier (f a)] -> [Tier (Blind (a -> g a))] -> Spec
-mergeLaws value function = describe "merge" $ do
-  prop "identity" . forAll value $
-    \ a -> merge pure a `shouldNotBe` (empty :: g (f a))
-
-  prop "relationship with sequenceAlt" . forAll (value >< function) $
-    \ (a, f) -> merge (getBlind f) a `shouldBe` sequenceAlt (fmap (getBlind f) a)
-
-sequenceAltLaws :: forall f g a. (Mergeable f, Alternative g, Eq (g (f a)), Show (f a), Show (g (f a))) => [Tier (f a)] -> [Tier (Blind (a -> g a))] -> Spec
-sequenceAltLaws value function = describe "sequenceAlt" $ do
-  prop "identity" . forAll value $
-    \ a -> sequenceAlt (pure <$> a) `shouldNotBe` (empty :: g (f a))
-
-  prop "relationship with merge" . forAll (productWith ((Blind .) . fmap . getBlind) function value :: [Tier (Blind (f (g a)))]) $
-    \ a -> sequenceAlt (getBlind a) `shouldBe` merge id (getBlind a)
-
-
-withAlternativeInstances :: forall f a. (Listable a, Eq (f a), Show (f a)) => (forall g. (Alternative g, Eq (g (f a)), Show (g (f a))) => [Tier (f a)] -> [Tier (Blind (a -> g a))] -> Spec) -> [Tier (f a)] -> Spec
-withAlternativeInstances laws gen = do
-  describe "[]" $ laws gen (fmap const `mapT` tiers :: [Tier (Blind (a -> [a]))])
-  describe "Maybe" $ laws gen (fmap const `mapT` tiers :: [Tier (Blind (a -> Maybe a))])
-
-
-newtype Blind a = Blind { getBlind :: a }
-  deriving Functor
-
-instance Listable a => Listable (Blind a) where
-  tiers = Blind `mapT` tiers
-
-instance Show (Blind a) where
-  showsPrec _ _ = showString "*"

test/Doctests.hs

@@ -5,7 +5,13 @@ module Main
 import System.Environment
 import Test.DocTest
 
-defaultFiles = ["src/Data/Abstract/Environment.hs", "src/Data/Range.hs", "src/Data/Semigroup/App.hs"]
+defaultFiles =
+  [ "src/Data/Abstract/Address.hs"
+  , "src/Data/Abstract/Environment.hs"
+  , "src/Data/Abstract/Name.hs"
+  , "src/Data/Range.hs"
+  , "src/Data/Semigroup/App.hs"
+  ]
 
 main :: IO ()
 main = do

test/Rendering/TOC/Spec.hs

@@ -3,7 +3,6 @@ module Rendering.TOC.Spec (spec) where
 
 import Analysis.Declaration
 import Data.Aeson
-import Data.Align.Generic
 import Data.Bifunctor
 import Data.Bifunctor.Join
 import Data.Diff
@@ -240,10 +239,10 @@ diffWithParser :: ( HasField fields Data.Span.Span
                   , Show1 syntax
                   , Traversable syntax
                   , Diffable syntax
-                  , GAlign syntax
                   , HasDeclaration syntax
                   , Hashable1 syntax
-                  , Members '[Distribute WrappedTask, Task] effs
+                  , Member (Distribute WrappedTask) effs
+                  , Member Task effs
                   )
                => Parser (Term syntax (Record fields))
                -> BlobPair

test/Spec.hs

@@ -10,7 +10,6 @@ import qualified Control.Abstract.Evaluator.Spec
 import qualified Data.Diff.Spec
 import qualified Data.Abstract.Path.Spec
 import qualified Data.Functor.Classes.Generic.Spec
-import qualified Data.Mergeable.Spec
 import qualified Data.Scientific.Spec
 import qualified Data.Source.Spec
 import qualified Data.Term.Spec
@@ -40,7 +39,6 @@ main = hspec $ do
     describe "Data.Diff" Data.Diff.Spec.spec
     describe "Data.Abstract.Path" Data.Abstract.Path.Spec.spec
     describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec
-    describe "Data.Mergeable" Data.Mergeable.Spec.spec
     describe "Data.Scientific" Data.Scientific.Spec.spec
     describe "Data.Source" Data.Source.Spec.spec
     describe "Data.Term" Data.Term.Spec.spec

test/SpecHelpers.hs

@@ -8,6 +8,7 @@ module SpecHelpers
 , deNamespace
 , derefQName
 , verbatim
+, TermEvaluator(..)
 , Verbatim(..)
 ) where
 
@@ -20,10 +21,11 @@ import Control.Monad ((>=>))
 import Data.Abstract.Address as X
 import Data.Abstract.Environment as Env
 import Data.Abstract.Evaluatable
-import Data.Abstract.FreeVariables as X hiding (dropExtension)
+import Data.Abstract.FreeVariables as X
 import Data.Abstract.Heap as X
 import Data.Abstract.ModuleTable as X hiding (lookup)
-import Data.Abstract.Value (Namespace(..), Value, ValueError, injValue, prjValue, runValueError)
+import Data.Abstract.Name as X
+import Data.Abstract.Value (Value(..), ValueError, runValueError)
 import Data.Bifunctor (first)
 import Data.Blob as X
 import Data.ByteString.Builder (toLazyByteString)
@@ -82,22 +84,27 @@ testEvaluating
   . fmap (first reassociate)
   . evaluating
   . runLoadError
-  . runValueError
   . runUnspecialized
   . runResolutionError
   . runEnvironmentError
   . runEvalError
   . runAddressError
-  . runTermEvaluator @_ @Precise
+  . runValueError
+  . runTermEvaluator @_ @_ @(Value Precise (Eff _))
 
-deNamespace :: Value Precise -> Maybe (Name, [Name])
-deNamespace = fmap (namespaceName &&& Env.names . namespaceScope) . prjValue @(Namespace Precise)
+deNamespace :: Value Precise term -> Maybe (Name, [Name])
+deNamespace (Namespace name scope) = Just (name, Env.names scope)
+deNamespace _                      = Nothing
 
-derefQName :: Heap Precise (Cell Precise) (Value Precise) -> NonEmpty Name -> Environment Precise (Value Precise) -> Maybe (Value Precise)
+namespaceScope :: Value Precise term -> Maybe (Environment Precise)
+namespaceScope (Namespace _ scope) = Just scope
+namespaceScope _                   = Nothing
+
+derefQName :: Heap Precise (Cell Precise) (Value Precise term) -> NonEmpty Name -> Environment Precise -> Maybe (Value Precise term)
 derefQName heap = go
   where go (n1 :| ns) env = Env.lookup n1 env >>= flip heapLookup heap >>= getLast . unLatest >>= case ns of
           []        -> Just
-          (n2 : ns) -> fmap namespaceScope . prjValue @(Namespace Precise) >=> go (n2 :| ns)
+          (n2 : ns) -> namespaceScope >=> go (n2 :| ns)
 
 newtype Verbatim = Verbatim ByteString
   deriving (Eq)

test/fixtures/haskell/corpus/blank.parseA.txt

@@ -0,0 +1,3 @@
+(Module
+  (Empty)
+  ([]))

test/fixtures/haskell/corpus/literals.A.hs

@@ -0,0 +1,37 @@
+module A where
+a = 0
+a = 1
+
+a = 0o00
+a = 0O77
+
+a = 0x00
+a = 0XFF
+
+a = 0.00
+a = 0.99
+
+a = 0.00e01
+a = 0.99E01
+a = 0.00e+01
+a = 0.99E-01
+a = 0.00e-01
+a = 0.99E+01
+
+a = 00e01
+a = 99E01
+a = 00e+01
+a = 99E-01
+a = 00e-01
+a = 99E+01
+
+a = undefined
+_a0 = undefined
+_A0 = undefined
+a0 = undefined
+a9 = undefined
+aA = undefined
+aZ' = undefined
+
+a = True
+a = False

test/fixtures/haskell/corpus/literals.B.hs

@@ -0,0 +1,37 @@
+module A where
+b = 0
+b = 1
+
+b = 0o00
+b = 0O77
+
+b = 0x00
+b = 0XFF
+
+b = 0.00
+b = 0.99
+
+b = 0.00e01
+b = 0.99E01
+b = 0.00e+01
+b = 0.99E-01
+b = 0.00e-01
+b = 0.99E+01
+
+b = 00e01
+b = 99E01
+b = 00e+01
+b = 99E-01
+b = 00e-01
+b = 99E+01
+
+b = undefined
+ba0 = undefined
+bA0 = undefined
+b0 = undefined
+b9 = undefined
+bA = undefined
+bZ' = undefined
+
+b = True
+b = False

test/fixtures/haskell/corpus/literals.diffA-B.txt

@@ -0,0 +1,232 @@
+(Module
+  (Identifier)
+  (
+    (Function
+    { (Identifier)
+    ->(Identifier) }
+      (
+        (Integer)))
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Integer)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Integer)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Integer)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Integer)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Integer)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Integer)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Integer)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Integer)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Integer)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Integer)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}))

test/fixtures/haskell/corpus/literals.diffB-A.txt

@@ -0,0 +1,230 @@
+(Module
+  (Identifier)
+  (
+    (Function
+    { (Identifier)
+    ->(Identifier) }
+      (
+        (Integer)))
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Integer)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Integer)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Integer)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Integer)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Integer)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Float)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+    (Function
+    { (Identifier)
+    ->(Identifier) }
+      (
+      {+(Identifier)+}
+      {-(Integer)-}))
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {+(Function
+    {+(Identifier)+}
+    {+(
+      {+(Identifier)+})+})+}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Integer)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Integer)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Integer)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Integer)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Float)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}
+  {-(Function
+    {-(Identifier)-}
+    {-(
+      {-(Identifier)-})-})-}))