polysemy-research/polysemy
1
1
Fork 0
mirror of https://github.com/polysemy-research/polysemy.git synced 2024-12-04 07:46:37 +03:00
Code Issues Projects Releases Wiki Activity

loopbreak nondet

Browse Source
This commit is contained in:
Sandy Maguire 2019-03-21 01:24:20 -04:00
parent df7c9be46d
commit 9dd70fa096
1 changed files with 11 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Polysemy/NonDet.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
module Polysemy.NonDet
( NonDet (..)
@ -47,12 +48,14 @@ instance Monad (NonDetC m) where
{-# INLINE (>>=) #-}
runNonDet :: Alternative f => Semantic (NonDet ': r) a -> Semantic r (f a)
runNonDet (Semantic m) = Semantic $ \k -> runNonDetC $ m $ \u ->
case decomp u of
Left x -> NonDetC $ \cons nil -> do
z <- k $ weave [()] (fmap concat . traverse runNonDet) x
foldr cons nil z
Right Empty -> empty
Right (Choose ek) -> pure (ek True) <|> pure (ek False)
inlineRecursiveCalls [d|
runNonDet :: Alternative f => Semantic (NonDet ': r) a -> Semantic r (f a)
runNonDet (Semantic m) = Semantic $ \k -> runNonDetC $ m $ \u ->
case decomp u of
Left x -> NonDetC $ \cons nil -> do
z <- k $ weave [()] (fmap concat . traverse runNonDet) x
foldr cons nil z
Right Empty -> empty
Right (Choose ek) -> pure (ek True) <|> pure (ek False)
|]