From 6050b9594db0fab65211672f1b1e09902108648d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 23 Jul 2019 11:18:21 -0400 Subject: [PATCH] Define an eliminator for statements. --- semantic-core/src/Data/Core.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs index 855e79ca8..da5226f1f 100644 --- a/semantic-core/src/Data/Core.hs +++ b/semantic-core/src/Data/Core.hs @@ -9,6 +9,7 @@ module Data.Core , unseqs , (>>>=) , unbind +, unstatement , do' , (:<-)(..) , lam @@ -137,6 +138,9 @@ unbind :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a - unbind n (Term sig) | Just (Named u a :>>= b) <- prj sig = pure (Named u n :<- a, instantiate1 (pure n) b) unbind _ _ = empty +unstatement :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a -> m (Maybe (Named a) :<- Term sig a, Term sig a) +unstatement n t = first (first Just) <$> unbind n t <|> first (Nothing :<-) <$> unseq t + do' :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Maybe (Named a) :<- m a) -> m a do' bindings = fromMaybe unit (foldr bind Nothing bindings) where bind (n :<- a) v = maybe (a >>>) ((>>>=) . (:<- a)) n <$> v <|> Just a