{-# LANGUAGE BangPatterns #-}
data Tree a
= Nil
| Branch a (Tree a) (Tree a)
notEach tree
= go
id tree
[] where go cont Nil rest = rest
go cont (Branch x left right) rest =
-- This made a 0.2s difference because without it, ghc couldn't move the
-- case out of the application to the Branch constructor
-- (because it might not get evaluated depending on what cont does)
-- With the ! it is able to compile it to a direct join point
cont (Branch flipped left right) :
go (rebuildLeft cont x right) left (go (rebuildRight cont x left) right rest)
rebuildLeft cont x right leftFlipped = cont (Branch x leftFlipped right)
rebuildRight cont x left rightFlipped = cont (Branch x left rightFlipped)
procreateL 0 = Nil
procreateL n
= Branch
(n `
rem`
2 == 0) (procreateL
(n
- 1)) (procreateL
(n `
div`
2))
procreateR 0 = Nil
procreateR n
= Branch
(n `
rem`
2 == 0) (procreateR
(n `
div`
2)) (procreateR
(n
- 1))
test = do
guard $ notEach (procreateL 3) == [Branch True (Branch True (Branch False Nil Nil) (Branch False Nil Nil)) (Branch False Nil Nil),Branch False (Branch False (Branch False Nil Nil) (Branch False Nil Nil)) (Branch False Nil Nil),Branch False (Branch True (Branch True Nil Nil) (Branch False Nil Nil)) (Branch False Nil Nil),Branch False (Branch True (Branch False Nil Nil) (Branch True Nil Nil)) (Branch False Nil Nil),Branch False (Branch True (Branch False Nil Nil) (Branch False Nil Nil)) (Branch True Nil Nil)]
guard $ notEach (procreateR 3) == [Branch True (Branch False Nil Nil) (Branch True (Branch False Nil Nil) (Branch False Nil Nil)),Branch False (Branch True Nil Nil) (Branch True (Branch False Nil Nil) (Branch False Nil Nil)),Branch False (Branch False Nil Nil) (Branch False (Branch False Nil Nil) (Branch False Nil Nil)),Branch False (Branch False Nil Nil) (Branch True (Branch True Nil Nil) (Branch False Nil Nil)),Branch False (Branch False Nil Nil) (Branch True (Branch False Nil Nil) (Branch True Nil Nil))]
guard
$ length (notEach
$ procreateL
150) == 1564307 guard
$ length (notEach
$ procreateR
150) == 1564307
main = test
ey0jIExBTkdVQUdFIEJhbmdQYXR0ZXJucyAjLX0KaW1wb3J0IENvbnRyb2wuTW9uYWQKCmRhdGEgVHJlZSBhCiAgICA9IE5pbAogICAgfCBCcmFuY2ggYSAoVHJlZSBhKSAoVHJlZSBhKQogICAgZGVyaXZpbmcgKFNob3csIEVxKQoKbm90RWFjaCA6OiBUcmVlIEJvb2wgLT4gW1RyZWUgQm9vbF0Kbm90RWFjaCB0cmVlID0gZ28gaWQgdHJlZSBbXSB3aGVyZQogICAgZ28gOjogKFRyZWUgQm9vbCAtPiBUcmVlIEJvb2wpIC0+IFRyZWUgQm9vbCAtPiBbVHJlZSBCb29sXSAtPiBbVHJlZSBCb29sXQogICAgZ28gY29udCBOaWwgcmVzdCA9IHJlc3QKICAgIGdvIGNvbnQgKEJyYW5jaCB4IGxlZnQgcmlnaHQpIHJlc3QgPQogICAgCS0tIFRoaXMgbWFkZSBhIDAuMnMgZGlmZmVyZW5jZSBiZWNhdXNlIHdpdGhvdXQgaXQsIGdoYyBjb3VsZG4ndCBtb3ZlIHRoZQogICAgCS0tIGNhc2Ugb3V0IG9mIHRoZSBhcHBsaWNhdGlvbiB0byB0aGUgQnJhbmNoIGNvbnN0cnVjdG9yCiAgICAJLS0gKGJlY2F1c2UgaXQgbWlnaHQgbm90IGdldCBldmFsdWF0ZWQgZGVwZW5kaW5nIG9uIHdoYXQgY29udCBkb2VzKQogICAgCS0tIFdpdGggdGhlICEgaXQgaXMgYWJsZSB0byBjb21waWxlIGl0IHRvIGEgZGlyZWN0IGpvaW4gcG9pbnQKICAgIAlsZXQgIWZsaXBwZWQgPSBub3QgeCBpbgogICAgICAgIGNvbnQgKEJyYW5jaCBmbGlwcGVkIGxlZnQgcmlnaHQpIDoKICAgICAgICBnbyAocmVidWlsZExlZnQgY29udCB4IHJpZ2h0KSBsZWZ0IChnbyAocmVidWlsZFJpZ2h0IGNvbnQgeCBsZWZ0KSByaWdodCByZXN0KQoKCnJlYnVpbGRMZWZ0IDo6IChUcmVlIEJvb2wgLT4gVHJlZSBCb29sKSAtPiBCb29sIC0+IFRyZWUgQm9vbCAtPiBUcmVlIEJvb2wgLT4gVHJlZSBCb29sCnJlYnVpbGRMZWZ0IGNvbnQgeCByaWdodCBsZWZ0RmxpcHBlZCA9IGNvbnQgKEJyYW5jaCB4IGxlZnRGbGlwcGVkIHJpZ2h0KQoKcmVidWlsZFJpZ2h0IDo6IChUcmVlIEJvb2wgLT4gVHJlZSBCb29sKSAtPiBCb29sIC0+IFRyZWUgQm9vbCAtPiBUcmVlIEJvb2wgLT4gVHJlZSBCb29sCnJlYnVpbGRSaWdodCBjb250IHggbGVmdCByaWdodEZsaXBwZWQgPSBjb250IChCcmFuY2ggeCBsZWZ0IHJpZ2h0RmxpcHBlZCkKCnByb2NyZWF0ZUwgOjogSW50IC0+IFRyZWUgQm9vbApwcm9jcmVhdGVMIDAgPSBOaWwKcHJvY3JlYXRlTCBuID0gQnJhbmNoIChuIGByZW1gIDIgPT0gMCkgKHByb2NyZWF0ZUwgKG4gLSAxKSkgKHByb2NyZWF0ZUwgKG4gYGRpdmAgMikpCgpwcm9jcmVhdGVSIDo6IEludCAtPiBUcmVlIEJvb2wKcHJvY3JlYXRlUiAwID0gTmlsCnByb2NyZWF0ZVIgbiA9IEJyYW5jaCAobiBgcmVtYCAyID09IDApIChwcm9jcmVhdGVSIChuIGBkaXZgIDIpKSAocHJvY3JlYXRlUiAobiAtIDEpKQoKdGVzdCA6OiBJTyAoKQp0ZXN0ID0gZG8KICAgIGd1YXJkICQgbm90RWFjaCAocHJvY3JlYXRlTCAzKSA9PSBbQnJhbmNoIFRydWUgKEJyYW5jaCBUcnVlIChCcmFuY2ggRmFsc2UgTmlsIE5pbCkgKEJyYW5jaCBGYWxzZSBOaWwgTmlsKSkgKEJyYW5jaCBGYWxzZSBOaWwgTmlsKSxCcmFuY2ggRmFsc2UgKEJyYW5jaCBGYWxzZSAoQnJhbmNoIEZhbHNlIE5pbCBOaWwpIChCcmFuY2ggRmFsc2UgTmlsIE5pbCkpIChCcmFuY2ggRmFsc2UgTmlsIE5pbCksQnJhbmNoIEZhbHNlIChCcmFuY2ggVHJ1ZSAoQnJhbmNoIFRydWUgTmlsIE5pbCkgKEJyYW5jaCBGYWxzZSBOaWwgTmlsKSkgKEJyYW5jaCBGYWxzZSBOaWwgTmlsKSxCcmFuY2ggRmFsc2UgKEJyYW5jaCBUcnVlIChCcmFuY2ggRmFsc2UgTmlsIE5pbCkgKEJyYW5jaCBUcnVlIE5pbCBOaWwpKSAoQnJhbmNoIEZhbHNlIE5pbCBOaWwpLEJyYW5jaCBGYWxzZSAoQnJhbmNoIFRydWUgKEJyYW5jaCBGYWxzZSBOaWwgTmlsKSAoQnJhbmNoIEZhbHNlIE5pbCBOaWwpKSAoQnJhbmNoIFRydWUgTmlsIE5pbCldCiAgICBndWFyZCAkIG5vdEVhY2ggKHByb2NyZWF0ZVIgMykgPT0gW0JyYW5jaCBUcnVlIChCcmFuY2ggRmFsc2UgTmlsIE5pbCkgKEJyYW5jaCBUcnVlIChCcmFuY2ggRmFsc2UgTmlsIE5pbCkgKEJyYW5jaCBGYWxzZSBOaWwgTmlsKSksQnJhbmNoIEZhbHNlIChCcmFuY2ggVHJ1ZSBOaWwgTmlsKSAoQnJhbmNoIFRydWUgKEJyYW5jaCBGYWxzZSBOaWwgTmlsKSAoQnJhbmNoIEZhbHNlIE5pbCBOaWwpKSxCcmFuY2ggRmFsc2UgKEJyYW5jaCBGYWxzZSBOaWwgTmlsKSAoQnJhbmNoIEZhbHNlIChCcmFuY2ggRmFsc2UgTmlsIE5pbCkgKEJyYW5jaCBGYWxzZSBOaWwgTmlsKSksQnJhbmNoIEZhbHNlIChCcmFuY2ggRmFsc2UgTmlsIE5pbCkgKEJyYW5jaCBUcnVlIChCcmFuY2ggVHJ1ZSBOaWwgTmlsKSAoQnJhbmNoIEZhbHNlIE5pbCBOaWwpKSxCcmFuY2ggRmFsc2UgKEJyYW5jaCBGYWxzZSBOaWwgTmlsKSAoQnJhbmNoIFRydWUgKEJyYW5jaCBGYWxzZSBOaWwgTmlsKSAoQnJhbmNoIFRydWUgTmlsIE5pbCkpXQogICAgZ3VhcmQgJCBsZW5ndGggKG5vdEVhY2ggJCBwcm9jcmVhdGVMIDE1MCkgPT0gMTU2NDMwNwogICAgZ3VhcmQgJCBsZW5ndGggKG5vdEVhY2ggJCBwcm9jcmVhdGVSIDE1MCkgPT0gMTU2NDMwNwogICAgCm1haW4gPSB0ZXN0