Give fromScope a parameter to bind over the contents of the scope.

Author: robrix

semantic-core/src/Analysis/Eval.hs

@@ -38,7 +38,7 @@ eval Analysis{..} eval = \case
   Term c -> case c of
     Let n -> alloc n >>= bind n >> unit
     a :>> b -> eval a >> eval b
-    Lam (Ignored n) b -> abstract eval n (incr (const n) id <$> fromScope b)
+    Lam (Ignored n) b -> abstract eval n (fromScope (incr (const (pure n)) id) b)
     f :$ a -> do
       f' <- eval f
       a' <- eval a

semantic-core/src/Data/Core/Pretty.hs

@@ -106,7 +106,7 @@ prettyCore style = run . runReader @Prec 0 . go (pure . name)
 
             -- Annotations are not pretty-printed, as it lowers the signal/noise ratio too profoundly.
             Ann _ c -> go var c
-          where bind (Ignored x) f = let x' = name x in (,) x' <$> go (incr (const (pure x')) var) (fromScope f)
+          where bind (Ignored x) f = let x' = name x in (,) x' <$> go (incr (const (pure x')) var) (fromScope sequenceA f)
         lambda = case style of
           Unicode -> symbol "λ"
           Ascii   -> symbol "\\"

semantic-core/src/Data/Scope.hs

@@ -56,11 +56,11 @@ instance HFunctor (Scope a) where
   hmap f = Scope . f . fmap (fmap f) . unScope
 
 instance (Eq   a, Eq   b, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Scope a f b) where
-  (==) = (==) `on` fromScope
+  (==) = (==) `on` fromScope sequenceA
 
 instance (Ord  a, Ord  b, forall a . Eq   a => Eq   (f a)
                         , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Scope a f b) where
-  compare = compare `on` fromScope
+  compare = compare `on` fromScope sequenceA
 
 deriving instance (Show a, Show b, forall a . Show a => Show (f a)) => Show (Scope a f b)
 
@@ -78,8 +78,8 @@ instance RightModule (Scope a) where
   Scope m >>=* f = Scope (fmap (>>= f) <$> m)
 
 
-fromScope :: Monad f => Scope a f b -> f (Incr a b)
-fromScope = unScope >=> sequenceA
+fromScope :: Monad f => (Incr a (f b) -> f c) -> Scope a f b -> f c
+fromScope f = unScope >=> f
 
 toScope :: Applicative f => f (Incr a b) -> Scope a f b
 toScope = Scope . fmap (fmap pure)