Eliminate binary trees #286
Merged
Conversation
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This reverts commit 08b8dba.
robrix
changed the title
robrix
commented
Oct 23, 2019
| @@ -34,7 +33,7 @@ import Prelude hiding (head, tail) | |||
| runChoose :: (m b -> m b -> m b) -> (a -> m b) -> ChooseC m a -> m b | |||
| runChoose fork leaf (ChooseC runChooseC) = runChooseC fork leaf | |||
|
|
|||
| -- | Run a 'Choose' effect, passing results to the supplied function, and merging branches together using 'S.<>'. | |||
| -- | Run a 'Choose' effect, mapping results into a 'S.Semigroup'. | |||
There was a problem hiding this comment.
I’ve opted to standardize the wording around the run*M/run*S handlers a little.
| @@ -83,26 +82,5 @@ instance MonadTrans ChooseC where | |||
|
|
|||
| instance (Algebra sig m, Effect sig) => Algebra (Choose :+: sig) (ChooseC m) where | |||
| eff (L (Choose k)) = ChooseC $ \ fork leaf -> fork (runChoose fork leaf (k True)) (runChoose fork leaf (k False)) | |||
| eff (R other) = ChooseC $ \ fork leaf -> eff (handle (Leaf ()) (fmap join . traverse (runChoose (liftA2 Fork) (pure . Leaf))) other) >>= fold fork leaf | |||
| eff (R other) = ChooseC $ \ fork leaf -> eff (handle (pure ()) (runChoose (liftA2 (<|>)) (runChoose (liftA2 (<|>)) (pure . pure))) other) >>= runChoose fork leaf | |||
There was a problem hiding this comment.
As per #292, this uses ChooseC m as its own initial state functor.
Comment on lines
-90
to
-108
| data BinaryTree a = Leaf a | Fork (BinaryTree a) (BinaryTree a) | ||
| deriving (Eq, Foldable, Functor, Ord, Show, Traversable) | ||
|
|
||
| instance Applicative BinaryTree where | ||
| pure = Leaf | ||
| {-# INLINE pure #-} | ||
| f <*> a = fold Fork (<$> a) f | ||
| {-# INLINE (<*>) #-} | ||
|
|
||
| instance Monad BinaryTree where | ||
| a >>= f = fold Fork f a | ||
| {-# INLINE (>>=) #-} | ||
|
|
||
|
|
||
| fold :: (b -> b -> b) -> (a -> b) -> BinaryTree a -> b | ||
| fold fork leaf = go where | ||
| go (Leaf a) = leaf a | ||
| go (Fork a b) = fork (go a) (go b) | ||
| {-# INLINE fold #-} |
There was a problem hiding this comment.
As a result of the above, we no longer need to encode binary trees as data!
| @@ -109,33 +108,5 @@ instance MonadTrans NonDetC where | |||
| instance (Algebra sig m, Effect sig) => Algebra (NonDet :+: sig) (NonDetC m) where | |||
| eff (L (L Empty)) = empty | |||
| eff (L (R (Choose k))) = k True <|> k False | |||
| eff (R other) = NonDetC $ \ fork leaf nil -> eff (handle (Leaf ()) (fmap join . traverse runNonDetA) other) >>= fold fork leaf nil | |||
| eff (R other) = NonDetC $ \ fork leaf nil -> eff (handle (pure ()) (runNonDet (liftA2 (<|>)) runNonDetA (pure empty)) other) >>= runNonDet fork leaf nil | |||
There was a problem hiding this comment.
It turns out there are (at least) two wrong ways and two right ways to do this.
Wrong:
- using
pure . joinas the handler - using
fmap join . runNonDetAas the handler
These are both wrong in that they screw up higher-order effects like Catch in NonDetC (ErrorC e PureC)—but not ErrorC e (NonDetC PureC), curiously enough.
Right:
- using
NonDetC PureC - this, which is significantly less code than
NonDetC PureCentailed
Comment on lines
+13
to
+16
| [ testCase "cutfail operates through higher-order effects" $ | ||
| (runCutA @[] (local (id @()) cutfail <|> pure 'a')) () | ||
| @?= | ||
| (runCutA @[] (cutfail <|> pure 'a')) () |
There was a problem hiding this comment.
I added this as a regression test.
patrickt
requested changes
Oct 23, 2019
patrickt
approved these changes
Oct 23, 2019
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
This PR: