github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00
Code Issues Projects Releases Wiki Activity

Move unseq & unseqs up under >>>.

Browse Source
This commit is contained in:
Rob Rix 2019-07-19 15:19:34 -04:00
parent e809a2935b
commit 38efb33327
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 10 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -132,6 +132,16 @@ newtype Block m a = Block { getBlock :: m a }
instance (Carrier sig m, Member Core sig) => Semigroup (Block m a) where
Block a <> Block b = Block (a >>> b)
unseq :: (Alternative m, Member Core sig) => Term sig a -> m (Term sig a, Term sig a)
unseq (Term sig) | Just (a :>> b) <- prj sig = pure (a, b)
unseq _ = empty
unseqs :: Member Core sig => Term sig a -> NonEmpty (Term sig a)
unseqs = go
where go t = case unseq t of
Just (l, r) -> go l <> go r
Nothing -> t :| []
(>>>=) :: (Eq a, Carrier sig m, Member Core sig) => (Named a :<- m a) -> m a -> m a
Named u n :<- a >>>= b = send (Named u a :>>= bind1 n b)
@ -157,16 +167,6 @@ unlam :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a ->
unlam n (Term sig) | Just (Lam b) <- prj sig = pure (n <$ b, instantiate1 (pure n) (namedValue b))
unlam _ _ = empty
unseq :: (Alternative m, Member Core sig) => Term sig a -> m (Term sig a, Term sig a)
unseq (Term sig) | Just (a :>> b) <- prj sig = pure (a, b)
unseq _ = empty
unseqs :: Member Core sig => Term sig a -> NonEmpty (Term sig a)
unseqs = go
where go t = case unseq t of
Just (l, r) -> go l <> go r
Nothing -> t :| []
($$) :: (Carrier sig m, Member Core sig) => m a -> m a -> m a
f $$ a = send (f :$ a)