github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 10:15:55 +03:00
Code Issues Projects Releases Wiki Activity

🔥 foldScope.

Browse Source
This commit is contained in:
Rob Rix 2019-07-17 11:14:46 -04:00
parent 7684e4c4cc
commit 7f828469c3
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
2 changed files with 2 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
semantic-core/src/Data/Core.hs
View File

@ -44,6 +44,7 @@ import Data.Maybe
import Data.Name
import Data.Scope
import Data.Stack
import Data.Term (Syntax (..))
import Data.Text (Text)
import GHC.Generics (Generic1)
import GHC.Stack
@ -220,7 +221,7 @@ foldCoreF :: (forall a . Incr () (n a) -> m (Incr () (n a)))
foldCoreF k go h = \case
Let a -> Let a
a :>> b -> go h a :>> go h b
Lam u b -> Lam u (foldScope k go h b)
Lam u b -> Lam u (foldSyntax go k h b)
a :$ b -> go h a :$ go h b
Unit -> Unit
Bool b -> Bool b

9
semantic-core/src/Data/Scope.hs
View File

@ -3,7 +3,6 @@ module Data.Scope
( Incr(..)
, incr
, Scope(..)
, foldScope
, fromScope
, toScope
, bind1
@ -74,14 +73,6 @@ instance RightModule (Scope a) where
Scope m >>=* f = Scope (fmap (>>= f) <$> m)
foldScope :: (forall a . Incr z (n a) -> m (Incr z (n a)))
-> (forall x y . (x -> m y) -> f x -> n y)
-> (a -> m b)
-> Scope z f a
-> Scope z n b
foldScope k go h = Scope . go (k . fmap (go h)) . unScope
fromScope :: Monad f => Scope a f b -> f (Incr a b)
fromScope = unScope >=> sequenceA