TreeTest.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE ExplicitForAll, ConstraintKinds, FlexibleContexts #-}  -- For :< experiment
{-# LANGUAGE ScopedTypeVariables, TypeOperators #-}
{-# LANGUAGE ViewPatterns, PatternGuards #-}
{-# LANGUAGE DataKinds, GADTs #-}  -- for TU
{-# LANGUAGE LambdaCase, TupleSections #-}

{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fcontext-stack=30 #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- TEMP
{-# OPTIONS_GHC -fno-warn-unused-binds   #-} -- TEMP

----------------------------------------------------------------------
-- |
-- Module      :  TreeTest
-- Copyright   :  (c) 2014 Tabula, Inc.
-- 
-- Maintainer  :  conal@tabula.com
-- Stability   :  experimental
-- 
-- Tests with length-typed treetors. To run:
-- 
--   hermit TreeTest.hs -v0 -opt=LambdaCCC.Monomorphize DoTree.hss resume && ./TreeTest
--   
-- Remove the 'resume' to see intermediate Core.
----------------------------------------------------------------------

-- module TreeTest where

-- TODO: explicit exports

import Prelude hiding ({- id,(.), -}foldl,foldr,sum,product,zipWith,reverse,and,or,scanl,minimum,maximum)

import Data.Monoid (Monoid(..),(<>),Sum(..),Product(..))
import Data.Functor ((<$>))
import Control.Applicative -- (Applicative(..),liftA2,liftA3)
import Data.Foldable (Foldable(..),sum,product,and,or,toList,minimum,maximum)
import Data.Traversable (Traversable(..))
-- import Control.Category (id,(.))
import Control.Arrow (Arrow(..))
import qualified Control.Arrow as Arrow
import Data.Tuple (swap)
import Data.Maybe (fromMaybe,maybe)
import Text.Printf (printf)

import Test.QuickCheck (arbitrary,Gen,generate,vectorOf)

-- transformers
import Data.Functor.Identity

import TypeUnary.TyNat
import TypeUnary.Nat (IsNat,natToZ)
import TypeUnary.Vec hiding (transpose,iota)
import qualified TypeUnary.Vec as V
import Control.Compose ((:.)(..),unO)

import LambdaCCC.Misc
  (xor,boolToInt,dup,Unop,Binop,Ternop,transpose,(:*),loop,delay,Reversible(..))
import LambdaCCC.Adder
import LambdaCCC.CRC -- hiding (crcS,sizeA)
import LambdaCCC.Bitonic
import LambdaCCC.Counters
import qualified LambdaCCC.RadixSort as RS

-- import Circat.Misc (Reversible(..))
import Circat.Rep (bottom)
import Circat.Pair (Pair(..),sortP)
import qualified Circat.Pair as P
import qualified Circat.RTree as RT
import qualified Circat.LTree as LT
import qualified Circat.RaggedTree as Ra
import Circat.RaggedTree (TU(..), R1, R2, R3, R4, R5, R8, R11, R13)
import Circat.Shift
import Circat.Scan
import Circat.FFT
import Circat.Mealy hiding (ArrowCircuit(..))
import qualified Circat.Mealy as Mealy
import Circat.Circuit (GenBuses(..), GS, Attr, systemSuccess)
import Circat.Complex

-- Strange -- why needed? EP won't resolve otherwise. Bug?
import qualified LambdaCCC.Lambda
import Circat.Classes (IfT)
import LambdaCCC.Lambda (EP,reifyEP)

import LambdaCCC.Run

-- Experiment for Typeable resolution in reification
import qualified Data.Typeable

-- -- To support Dave's FFT stuff, below.
-- -- import Data.Complex (cis)
-- import Data.Newtypes.PrettyDouble

{--------------------------------------------------------------------
    Misc
--------------------------------------------------------------------}

liftA4 :: Applicative f =>
          (a -> b -> c -> a -> d) -> f a -> f b -> f c -> f a -> f d
liftA4 f as bs cs ds = liftA3 f as bs cs <*> ds

{--------------------------------------------------------------------
    Examples
--------------------------------------------------------------------}

type RTree = RT.Tree
type LTree = LT.Tree
type Ragged = Ra.Tree

t0 :: RTree N0 Bool
t0 = pure True

p1 :: Unop (Pair Bool)
p1 (a :# b) = b :# a

psum :: Num a => Pair a -> a
psum (a :# b) = a + b

-- tsum :: Num a => RTree n a -> a
-- tsum = foldT id (+)

-- dot :: (IsNat n, Num a) => RTree n a -> RTree n a -> a
-- dot as bs = tsum (prod as bs)

prod :: (Functor f, Num a) => f (a,a) -> f a
prod = fmap (uncurry (*))

prodA :: (Applicative f, Num a) => Binop (f a)
prodA = liftA2 (*)

-- dot :: Num a => RTree n (a,a) -> a
-- dot = tsum . prod

dot :: (Functor f, Foldable f, Num a) => f (a,a) -> a
dot = sum . prod

square :: Num a => a -> a
square a = a * a

sumSquare :: (Functor f, Foldable f, Num a) => f a -> a
sumSquare = sum . fmap square

squares :: (Functor f, Num a) => f a -> f a
squares = fmap square

squares' :: (Functor f, Num a) => f a -> f a
squares' = fmap (^ (2 :: Int))

{--------------------------------------------------------------------
    Dot products
--------------------------------------------------------------------}

dot' :: (Applicative f, Foldable f, Num a) => f a -> f a -> a
dot' as bs = sum (prodA as bs)

dot'' :: (Foldable g, Functor g, Foldable f, Num a) => g (f a) -> a
dot'' = sum . fmap product

dot''' :: (Traversable g, Foldable f, Applicative f, Num a) => g (f a) -> a
dot''' = dot'' . transpose

dotap :: (Foldable t, Num (t a), Num a) => t a -> t a -> a
as `dotap` bs = sum (as * bs)

dotsp :: (Foldable g, Foldable f, Num (f a), Num a) => g (f a) -> a
dotsp = sum . product

-- Infix binary dot product
infixl 7 <.>
(<.>) :: (Foldable f, Applicative f, Num a) => f a -> f a -> a
u <.> v = sum (liftA2 (*) u v)

-- | Monoid under lifted multiplication.
newtype ProductA f a = ProductA { getProductA :: f a }

instance (Applicative f, Num a) => Monoid (ProductA f a) where
  mempty = ProductA (pure 1)
  ProductA u `mappend` ProductA v = ProductA (liftA2 (*) u v)

productA :: (Foldable g, Applicative f, Num a) => g (f a) -> f a
productA = getProductA . foldMap ProductA

dota :: (Foldable g, Foldable f, Applicative f, Num a) => g (f a) -> a
dota = sum . productA

{--------------------------------------------------------------------
    Generalized matrices
--------------------------------------------------------------------}

type Matrix  m n a = Vec    n (Vec    m a)
type MatrixT m n a = RTree  n (RTree  m a)
type MatrixG p q a = Ragged q (Ragged p a)

infixr 1 $@
-- infixl 9 .@

-- | Apply a linear transformation represented as a matrix
-- ($@) :: (IsNat m, Num a) => Matrix m n a -> Vec m a -> Vec n a
($@) :: (Foldable m, Applicative m, Functor n, Num a) =>
        n (m a) -> m a -> n a
mat $@ vec = (`dot'` vec) <$> mat

-- -- | Compose linear transformations represented as matrices
-- (.@) :: (IsNat m, IsNat n, IsNat o, Num a) =>
--         Matrix n o a -> Matrix m n a -> Matrix m o a
(.@) :: ( Applicative o, Traversable n, Applicative n
        , Traversable m, Applicative m, Num a ) =>
        o (n a) -> n (m a) -> o (m a)
-- no .@ mn = (\ n -> (n <.>) <$> transpose mn) <$> no
no .@ mn = transpose ((no $@) <$> transpose mn)

{--------------------------------------------------------------------
    Permutations
--------------------------------------------------------------------}

invertR :: IsNat n => RTree n a -> LTree n a
invertR = invertR' nat

invertR' :: Nat n -> RTree n a -> LTree n a
invertR' Zero     = \ (RT.L a ) -> LT.L a
invertR' (Succ m) = \ (RT.B ts) -> LT.B (invertR' m (transpose ts))
-- invertR' (Succ m) = \ (RT.B ts) -> LT.B (transpose (invertR' m <$> ts))

#if 0
RT.unB    :: RTree (S n)   a  -> Pair (RTree n a)
transpose :: Pair (RTree n a) -> RTree n (Pair a)
invertR   :: RTree n (Pair a) -> LTree n (Pair a)
LT.B      :: LTree n (Pair a) -> LTree (S n)   a

RT.unB       :: RTree (S n)   a  -> Pair (RTree n a)
fmap invertR :: Pair (RTree n a) -> Pair (LTree n a)
transpose    :: Pair (LTree n a) -> LTree n (Pair a)
LT.B         :: LTree n (Pair a) -> LTree (S n)   a
#endif

-- We needed the IsNat n for Applicative on RTree n.
-- The reverse transformation is easier, since we know Pair is Applicative.

invertL :: LTree n a -> RTree n a
invertL (LT.L a ) = RT.L a
invertL (LT.B ts) = RT.B (transpose (invertL ts))
-- invertL (LT.B ts) = RT.B (invertL <$> transpose ts)

-- invertR' (Succ m) = \ (RT.B ts) -> LT.B (transpose (invertR' m <$> ts))

#if 0
LT.unB    :: LTree (S n)   a  -> LTree n (Pair a)
invertL   :: LTree n (Pair a) -> RTree n (Pair a)
transpose :: RTree n (Pair a) -> Pair (RTree n a)
RT.B      :: Pair (RTree n a) -> RTree (S n)   a

LT.unB       :: LTree (S n)   a  -> LTree n (Pair a)
transpose    :: LTree n (Pair a) -> Pair (LTree n a)
fmap invertL :: Pair (LTree n a) -> Pair (RTree n a)
RT.B         :: Pair (RTree n a) -> RTree (S n)   a
#endif

{--------------------------------------------------------------------
    Run it
--------------------------------------------------------------------}

inTest :: String -> IO ()
inTest cmd = systemSuccess ("cd ../test; " ++ cmd) -- (I run ghci in ../src)

mk :: String -> IO ()
mk s = inTest ("make " ++ s)

doit :: IO ()
doit = mk "doit"

reify :: IO ()
reify = mk "reify"

reifyDone :: IO ()
reifyDone = mk "reify-done"

noReify :: IO ()
noReify = mk "no-reify"

noReifyDone :: IO ()
noReifyDone = mk "no-reify-done"

compile :: IO ()
compile = mk "compile"

dateFigureSvg :: String -> String -> IO ()
dateFigureSvg date fig = systemSuccess (printf "cd ../test; ./date-figure-svg %s \"%s\"" date fig)

figureSvg :: String -> IO ()
figureSvg str = systemSuccess ("cd ../test; ./figure-svg " ++ str)

dateLatestSvg :: String -> IO ()
dateLatestSvg date = systemSuccess (printf "cd ../test; ./date-latest-svg \"%s\"" date)

latestSvg :: IO ()
latestSvg = systemSuccess "cd ../test; ./latest-svg"

do1 :: IO ()
do1 = inTest "hermit TreeTest.hs -v0 -opt=LambdaCCC.Monomorphize DoTreeNoReify.hss"

do2 :: IO ()
do2 = inTest "hermit TreeTest.hs -v0 -opt=LambdaCCC.Monomorphize DoTree.hss"

-- Only works when compiled with HERMIT
main :: IO ()

---- FFT

type C = Complex Double

-- main = go "foo" ()

-- main = go "fft-p" (fft :: Unop (Pair C))

-- main = go "fft-lt1" (fft :: LTree N1 C -> RTree N1 C)

-- main = go "fft-rt1" (fft :: RTree N1 C -> LTree N1 C)

-- twiddles :: forall g f a. (AFS g, AFS f, RealFloat a) => g (f (Complex a))

-- main = go "twiddles-lt1p" (twiddles :: LTree N1 (Pair C))

-- main = go "foo" (omega (size (undefined :: (LTree N1 :. Pair) ())))

-- twiddles :: forall g f a. (AFS g, AFS f, RealFloat a) => g (f (Complex a))
-- twiddles = powers <$> powers (omega (tySize(g :. f)))

main = go "foo" (powers :: Int -> LTree N1 Int)

-- zoop :: Int
-- zoop = 3

-- main = go "foo" zoop

-- main = go "foo" (size (undefined :: RTree N3 ()))

-- main = go "foo" (size (undefined :: (LTree N3 :. Pair) ()))

-- main = go "foo" (size (undefined :: Pair ()))

-- main = go "foo" (negate :: Unop Double)

-- omega n = cis (- 2 * pi / fromIntegral n)

-- main = go "omega-1" (omega (1 :: Int))

-- main = go "omega-2" (omega (2 :: Int))

-- -- Okay
-- main = go "foo" (\ x -> cis (-2 * pi / x) :: C)

-- -- Trips over fromInteger . toInteger
-- main = go "foo" (\ (n :: Int) -> cis (-2 * pi / fromIntegral n) :: C)

-- -- Trips over fromInteger . toInteger (the definition of fromIntegral)
-- main = go "foo" (fromIntegral :: Int -> Double)

-- main = go "foo" (pure (3 :+ 4) :: RTree N2 C)

-- main = go "foo" (size (undefined :: RTree N5 ()))

-- main = go "foo" (exp :: C -> C)

-- main = go "foo" (exp :: Double -> Double)

---- End FFT

-- main = go "map-not-v5" (fmap not :: Vec N5 Bool -> Vec N5 Bool)

-- main = go "map-square-v5" (fmap square :: Vec N5 Int -> Vec N5 Int)

-- main = go "map-rt3" (fmap not :: Unop (RTree N3 Bool))

-- main = go "tdott-2" (dot''' :: Pair (RTree N2 Int) -> Int)

-- main = go "dotsp-v3t2" (dotsp :: Vec N3 (RTree N2 Int) -> Int)

-- main = go "dotsp-t2t2" (dotsp :: RTree N2 (RTree N2 Int) -> Int)

-- main = go "dotsp-pt3" (dotsp :: Pair (RTree N3 Int) -> Int)

-- main = go "dotsp-pv5" (dotsp :: Pair (Vec N5 Int) -> Int)

-- main = go "dotsp-plt3" (dotsp :: Pair (LTree N3 Int) -> Int)

-- main = go "dotap-2" (dotap :: RTree N2 Int -> RTree N2 Int -> Int)

-- main = go "tdot-2" (dot'' :: RTree N2 (Pair Int) -> Int)

-- main = go "test" (dot'' :: RTree N4 (Pair Int) -> Int)

-- main = go "plusInt" ((+) :: Int -> Int -> Int)
-- main = go "or" ((||) :: Bool -> Bool -> Bool)

-- main = goSep "pure-rt3" 1 (\ () -> (pure False :: RTree N3 Bool))

-- main = go "foo" (\ (_ :: RTree N3 Bool) -> False)

-- main = go "sum-p" (sum :: Pair Int -> Int)

-- main = go "sumSquare-p" (sumSquare :: Pair Int -> Int)

-- main = goSep "sumSquare-rt2" 0.75 (sumSquare :: RTree N2 Int -> Int)

-- main = go "sum-v8" (sum :: Vec N8 Int -> Int)

-- main = go "and-v5" (and :: Vec N5 Bool -> Bool)

-- main = go "sum-t3" (sum :: RTree N3 Int -> Int)

-- main = go "sum-lt3" (sum :: LTree N3 Int -> Int)

-- main = go "sum-foldl-v5" (foldl (+) 0 :: Vec N5 Int -> Int)

-- main = go "sum-foldr-v5" (foldr (+) 0 :: Vec N5 Int -> Int)

-- main = go "sum-foldl-t3" (foldl (+) 0 :: RTree N3 Int -> Int)

-- main = go "sum-foldr-t3" (foldr (+) 0 :: RTree N3 Int -> Int)

-- main = do go "squares3" (squares :: RTree N3 Int -> RTree N3 Int)
--           go "sum4"     (sum     :: RTree N4 Int -> Int)
--           go "dot4"     (dot     :: RTree N4 (Int,Int) -> Int)

-- main = go "test" (dot :: RTree N4 (Int,Int) -> Int)

-- -- Ranksep: rt1=0.5, rt2=1, rt3=2, rt4=4,rt5=8
-- main = goSep "transpose-prt4" 4 (transpose :: Pair (RTree N4 Bool) -> RTree N4 (Pair Bool))

-- -- Ranksep: rt1=0.5, rt2=1, rt3=2, rt4=4,rt5=8
-- main = goSep "transpose-rt2p" 1 (transpose :: RTree N2 (Pair Bool) -> Pair (RTree N2 Bool))

-- -- Ranksep: rt1=1, rt2=2, rt3=4, rt4=8, rt5=16
-- main = goSep "transpose-v3t5" 16 (transpose :: Vec N3 (RTree N5 Bool) -> RTree N5 (Vec N3 Bool))

-- -- Ranksep: rt1=2, rt2=4, rt3=8, rt4=16, rt5=32
-- main = goSep "transpose-v5t3" 8 (transpose :: Vec N5 (RTree N3 Bool) -> RTree N3 (Vec N5 Bool))

-- -- Ranksep: rt1=0.5, rt2=1, rt3=2, rt4=4, rt5=8
-- main = goSep "invertR-5" 8 (invertR :: RTree N5 Bool -> LTree N5 Bool)

-- main = go "vtranspose-34" (transpose :: Matrix N3 N4 Int -> Matrix N4 N3 Int)

-- main = go "vtranspose-34" (transpose :: Vec N3 (Vec N4 Int) -> Vec N4 (Vec N3 Int))

-- main = go "ttranspose-23" (transpose :: MatrixT N2 N3 Int -> MatrixT N3 N2 Int)

-- main = go "swap" (swap :: Int :* Bool -> Bool :* Int)

-- main = go "add" (\ (a,b) -> a+b :: Int)

-- main = go "rot31" (\ (a,b,c) -> (b,c,a) :: (Bool,Bool,Bool))

-- main = go "rot41" (\ (a,b,c,d) -> (b,c,d,a) :: (Bool,Bool,Bool,Bool))

-- main = go "rev4" (\ (a,b,c,d) -> (d,c,b,a) :: (Bool,Bool,Bool,Bool))

-- main = go "sum-2" (\ (a,b) -> a+b :: Int)

-- main = go "sum-3" (\ (a,b,c) -> a+b+c :: Int)

-- main = go "sum-4a" ((\ (a,b,c,d) -> a+b+c+d) :: (Int,Int,Int,Int) -> Int)

-- main = go "sum-4b" ((\ (a,b,c,d) -> (a+b)+(c+d)) :: (Int,Int,Int,Int) -> Int)

-- main = go "dot-22" ((\ ((a,b),(c,d)) -> a*c + b*d) :: ((Int,Int),(Int,Int)) -> Int)

-- main = go "tdot-4" (dot :: RTree N4 (Int,Int) -> Int)

-- main = go "tpdot-4" (dot'' :: RTree N4 (Pair Int) -> Int)

-- -- Doesn't wedge.
-- main = go "dotp" ((psum . prod) :: Pair (Int,Int) -> Int)

-- main = go "prod1" (prod :: RTree N1 (Int,Int) -> RTree N1 Int)

-- main = go "dot5" (dot :: RTree N5 (Int,Int) -> Int)

-- main = go "squares2" (squares :: Unop (RTree N2 Int))

-- main = go "psum" (psum :: Pair Int -> Int)

-- main = go "tsum1" (tsum :: RTree N1 Int -> Int)

-- -- Not working yet: the (^) is problematic.
-- main = go "squaresp-rt0" (squares' :: Unop (RTree N0 Int))

-- main = goSep "applyLin-v23" 1 (($@) :: Matrix N2 N3 Int -> Vec N2 Int -> Vec N3 Int)

-- main = goSep "applyLin-v42" 1 (($@) :: Matrix N4 N2 Int -> Vec N4 Int -> Vec N2 Int)

-- main = goSep "applyLin-v45" 1 (($@) :: Matrix N4 N5 Int -> Vec N4 Int -> Vec N5 Int)

-- main = goSep [ranksep 2] -t21 (($@) :: MatrixT N2 N1 Int -> RTree N2 Int -> RTree N1 Int)

-- main = go "applyLin-t22" (($@) :: MatrixT N2 N2 Int -> RTree N2 Int -> RTree N2 Int)

-- main = go "applyLin-t23" (($@) :: MatrixT N2 N3 Int -> RTree N2 Int -> RTree N3 Int)

-- main = go "applyLin-t32" (($@) :: MatrixT N3 N2 Int -> RTree N3 Int -> RTree N2 Int)

-- main = go "applyLin-t34" (($@) :: MatrixT N3 N4 Int -> RTree N3 Int -> RTree N4 Int)

-- main = go "applyLin-t45" (($@) :: MatrixT N4 N5 Int -> RTree N4 Int -> RTree N5 Int)

-- main = go "applyLin-v3t2" (($@) :: RTree N2 (Vec N3 Int) -> Vec N3 Int -> RTree N2 Int)

-- main = go "applyLin-t2v3" (($@) :: Vec N3 (RTree N2 Int) -> RTree N2 Int -> Vec N3 Int)

-- main = go "composeLin-v234" ((.@) :: Matrix N3 N4 Int -> Matrix N2 N3 Int -> Matrix N2 N4 Int)

-- main = go "composeLin-t234" ((.@) :: MatrixT N3 N4 Int -> MatrixT N2 N3 Int -> MatrixT N2 N4 Int)

-- -- Takes a very long time. I haven't seen it through yet.

-- main = go "composeLin-t324" ((.@) :: MatrixT N2 N4 Int -> MatrixT N3 N2 Int -> MatrixT N3 N4 Int)

-- main = go "composeLin-t222" ((.@) :: MatrixT N2 N2 Int -> MatrixT N2 N2 Int -> MatrixT N2 N2 Int)

-- main = go "composeLin-t232" ((.@) :: MatrixT N3 N2 Int -> MatrixT N2 N3 Int -> MatrixT N2 N2 Int)

-- -- Shift examples are identities on bit representations
-- main = go "shiftR-v3" (shiftR :: Vec N3 Bool :* Bool -> Bool :* Vec N3 Bool)

-- -- Shift examples are identities on bit representations
-- main = go "shiftR-swap-v3" (shiftR . swap :: Unop (Bool :* Vec N3 Bool))

-- main = go "shiftR-rt2" (shiftR :: RTree N2 Bool :* Bool -> Bool :* RTree N2 Bool)

-- main = go "shiftL-rt1" (shiftL :: Bool :* RTree N1 Bool -> RTree N1 Bool :* Bool)

-- main = go "shiftRF-v3v2" (shiftRF :: Vec N3 Bool :* Vec N2 Bool -> Vec N2 Bool :* Vec N3 Bool)

-- main = go "shiftRF-v2v3" (shiftRF :: Vec N2 Bool :* Vec N3 Bool -> Vec N3 Bool :* Vec N2 Bool)

-- -- Shift in two zeros from the right
-- main = go "shiftRF-v3v2F" (flip (curry shift) (pure False))
--  where
--    shift :: Vec N3 Bool :* Vec N2 Bool -> Vec N2 Bool :* Vec N3 Bool
--    shift = shiftRF

-- -- Shift in two zeros from the left
-- main = go "shiftLF-v2v3F" (curry shift (pure False))
--  where
--    shift :: Vec N2 Bool :* Vec N3 Bool -> Vec N3 Bool :* Vec N2 Bool
--    shift = shiftRF

-- -- Shift five zeros into a tree from the left
-- main = go "shiftLF-v5rt4F" (curry shift (pure False))
--  where
--    shift :: Vec N5 Bool :* RTree N4 Bool -> RTree N4 Bool :* Vec N5 Bool
--    shift = shiftRF

-- main = go "lsumsp-rt2" (lsums' :: Unop (RTree N2 Int))

-- main = go "lsumsp-rt2" (lsums' :: Unop (RTree N2 Int))

-- main = go "lsumsp-lt3" (lsums' :: Unop (LTree N3 Int))

-- main = go "lsums-v5" (lsums :: Vec N5 Int -> (Vec N5 Int, Int))

-- main = go "lsums-rt2" (lsums :: RTree N2 Int -> (RTree N2 Int, Int))

-- main = go "lsums-lt3" (lsums :: LTree N3 Int -> (LTree N3 Int, Int))

-- -- 2:1; 3:1.5; 4:2; 5:2.5
-- main = goSep "lParities-rt5" (5/2) (lParities :: RTree N5 Bool -> (RTree N5 Bool, Bool))

-- -- 2:1; 3:1.5; 4:2; 5:2.5
-- main = goSep "lParities-lt4" (4/2) (lParities :: LTree N4 Bool -> (LTree N4 Bool, Bool))

-- -- 2:1; 3:1.5; 4:2; 5:2.5
-- main = goSep "lParities-ex-rt3" (3/2) (fst . lParities :: Unop (RTree N3 Bool))

-- -- 2:1; 3:1.5; 4:2; 5:2.5
-- main = goSep "lParities-ex-lt3" (3/2) (fst . lParities :: Unop (LTree N3 Bool))

-- main = go "foo" (\ a -> not a)

-- main = go "not" not

-- main = go "not-pair" (\ a -> (not a, not a))

-- main = go "and-curried" ((&&) :: Bool -> Bool -> Bool)

-- main = go "test-add-with-constant-fold" foo
--  where
--    foo :: Int -> Int
--    foo x = f x + g x
--    f _ = 3
--    g _ = 4

-- -- True
-- main = go "foo" (\ a -> not a || True)

-- -- not a
-- main = go "foo" (\ a -> a `xor` True)

-- -- a
-- main = go "foo" (\ a -> a `xor` False)

-- main = go "fmap-gt5" (fmap not :: Unop (Ragged R5 Bool))

-- main = go "sum-gt5" (sum :: Ragged R5 Int -> Int)

-- main = go "sum-gt13p" (sum :: Ragged R13' Int -> Int)

-- main = go "dotsp-gt8" (dotsp :: Pair (Ragged R8 Int) -> Int)

-- main = go "applyLin-gt45" (($@) :: MatrixG R4 R5 Int -> Ragged R4 Int -> Ragged R5 Int)

-- main = go "composeLin-gt234" ((.@) :: MatrixG R3 R4 Int -> MatrixG R2 R3 Int -> MatrixG R2 R4 Int)

-- -- Linear map composition mixing ragged trees, top-down perfect trees, and vectors.
-- main = go "composeLin-gt3rt2v2"
--           ((.@) :: Vec N2 (RTree N2 Int) -> RTree N2 (Ragged R3 Int) -> Vec N2 (Ragged R3 Int))

-- main = go "composeLin-gt1rt0v1"
--           ((.@) :: Vec N1 (RTree N0 Int) -> RTree N0 (Ragged R1 Int) -> Vec N1 (Ragged R1 Int))

-- Note: some of the scan examples redundantly compute some additions.
-- I suspect that they're only the same *after* the zero simplifications.
-- These zero additions are now removed in the circuit generation back-end.

-- ranksep: 8=1.5, 11=2.5
-- main = goSep "lsumsp-gt3" =1.5 (lsums' :: Unop (Ragged Ra.R3 Int))

-- main = go "add3" (\ (x :: Int) -> x + 3)

-- main = go "foo" (not . not)

-- main = go "foo" (\ (a,b :: Int) -> if a then b else b)

-- -- Equivalently: a `xor` not b
-- main = go "foo" (\ (a,b) -> if a then b else not b)

-- main = go "foo" (\ a  (b :: Int :* Int) -> (if a then id else swap) b)

-- main = goSep "foo" 2.5 (\ (a, b::Int, c::Int, d::Int) -> if a then (b,c,d) else (c,d,b))

-- main = go "foo" (\ a b -> ( if a then b else False --     a && b
--                           , if a then True  else b --     a || b
--                           , if a then False else b -- not a && b
--                           , if a then b else True  -- not a || b
--                           ))

-- -- Equivalently, (&& not a) <$> b
-- main = goSep "foo" 2 (\ a (b :: Vec N4 Bool) -> if a then pure False else b)

-- -- Equivalently, (|| a) <$> b
-- main = goSep "foo" 2 (\ a (b :: Vec N4 Bool) -> if a then pure True  else b)

-- -- Equivalently, (&& not a) <$> b
-- main = goSep "foo" 2 (\ a (b :: RTree N3 Bool) -> if a then pure False else b)

-- -- Equivalently, (a `xor`) <$> b
-- main = go "foo" (\ a (b :: Vec N3 Bool) -> (if a then not else id) <$> b)

-- main = goSep "foo" 2 (\ a (b :: RTree N2 Bool) -> (if a then reverse else id) b)

-- -- Equivalent to \ a -> (a,not a)
-- main = go "foo" (\ a -> if a then (True,False) else (False,True))

-- crcStep :: (Traversable poly, Applicative poly) =>
--            poly Bool -> poly Bool :* Bool -> poly Bool

-- main = goSep "crcStep-v1" 1
--         (crcStep :: Vec N1 Bool -> Vec N1 Bool :* Bool -> Vec N1 Bool)

-- -- ranksep: rt2=1, rt3=2, rt4=4.5
-- main = goSep "crcStep-rt3" 2 (crcStep :: RTree N3 Bool -> RTree N3 Bool :* Bool -> RTree N3 Bool)

-- main = go "crcStepK-rt2" (crcStep (polyD :: RTree N2 Bool))

-- main = goSep "crcStepK-g5" 1
--         (crcStep (ra5 True False False True False))

-- crc :: (Traversable poly, Applicative poly, Traversable msg) =>
--        poly Bool -> msg Bool :* poly Bool -> poly Bool

-- main = go "crc-v3v5" (crc :: Vec N3 Bool -> Vec N5 Bool :* Vec N3 Bool -> Vec N3 Bool)

-- main = go "crcK-v3v5" (crc polyD :: Vec N5 Bool :* Vec N3 Bool -> Vec N3 Bool)

-- main = go "crc-v4rt3" (crc :: Vec N4 Bool -> RTree N3 Bool :* Vec N4 Bool -> Vec N4 Bool)

-- main = go "crc-rt3rt5" (crc :: RTree N3 Bool -> RTree N5 Bool :* RTree N3 Bool -> RTree N3 Bool)

-- main = go "crcK-rt2rt4" (crc polyD :: RTree N4 Bool :* RTree N2 Bool -> RTree N2 Bool)

-- main = go "crcK-v5rt4" (crc polyD :: RTree N4 Bool :* Vec N5 Bool -> Vec N5 Bool)

-- main = go "crc-encode-v3v5" (crcEncode :: Vec N3 Bool -> Vec N5 Bool -> Vec N3 Bool)

-- main = go "crc-encode-v3rt2" (crcEncode :: Vec N3 Bool -> RTree N2 Bool -> Vec N3 Bool)

-- main = go "crc-encode-rt2rt4" (crcEncode :: RTree N2 Bool -> RTree N4 Bool -> RTree N2 Bool)

-- Simple carry-propagate adder

-- main = go "halfAdd" halfAdd

-- main = go "add1" add1

-- main = go "add1-0" (carryIn False add1)

-- main = go "add1p" add1'

-- main = go "adder-state-v3" (adderState :: Adder' (Vec N3))

-- main = go "adder-state-rt2" (adderState :: Adder' (RTree N2))

-- main = go "adder-state-0-v1" (carryIn False adderState :: Adder (Vec N1))

-- main = go "adder-state-0-rt0" (carryIn False adderState :: Adder (RTree N0))

-- -- GHC panic: "tcTyVarDetails b{tv ah8Z} [tv]"
-- main = go "adder-state-trie-v2" (adderStateTrie :: Adder' (Vec N2))

-- main = go "adder-accuml-v8" (adderAccumL :: Adder' (Vec N8))

-- main = go "adder-accuml-rt5" (adderAccumL :: Adder' (RTree N5))

-- Monoidal scan adders

-- main = go "gpCarry" gpCarry

-- main = go "mappend-gpr" (mappend :: Binop GenProp)

ifF :: Bool -> Binop a
ifF c a b = if c then a else b

-- main = go "if-gpr" (ifF :: Bool -> Binop GenProp)

-- main = go "gprs-pair" (fmap genProp :: Pair (Pair Bool) -> Pair GenProp)

-- main = go "scan-gpr-pair" (scanGPs :: Pair (Pair Bool) -> Pair GenProp :* GenProp)

-- main = go "adder-scan-pair" (scanAdd :: Adder Pair)

-- main = go "adder-scanp-pair" (scanAdd' :: Adder' Pair)

-- main = go "adder-scanpp-pair" (scanAdd'' :: Adder Pair)

-- -- Ranksep: rt1=0.5, rt2=0.5, rt3=0.75, rt4=1.5,rt5=2
-- main = goSep "adder-scan-noinline-rt2" 0.5 (scanAdd :: Adder (RTree N2))

-- -- Ranksep: rt1=0.5, rt2=0.5, rt3=0.75, rt4=1.5,rt5=2
-- main = goSep "adder-scan-rt5" 2 (scanAdd :: Adder (RTree N5))

-- -- Ranksep: rt2=0.5, rt3=0.75, rt4=1.5,rt5=2
-- main = goSep "adder-scan-unopt-rt0" 0.5 (scanAdd :: Adder (RTree N0))

-- -- Ranksep: rt2=0.5, rt3=1, rt4=2, rt5=3
-- main = goSep "adder-scanp-rt3" 1 (scanAdd' :: Adder' (RTree N3))

-- -- Ranksep: rt2=0.5, rt3=0.75, rt4=1.5,rt5=2
-- main = goSep "adder-scanpp-rt1" 0.5 (scanAdd'' :: Adder (RTree N1))

-- main = go "foo" (\ ((gx,px),(gy,py)) -> (gx || gy && px, px && py))

-- main = go "case-just" (\ case Just b  -> not b
--                               Nothing -> True)

-- -- Demos automatic commutation
-- main = go "foo" (\ (b,a) -> a || b)

-- main = go "or-with-swap" (\ (a,b) -> (a || b, b || a))

-- -- not (a && b)
-- main = go "foo" (\ b a -> not a || not b)

-- main = go "foo" (\ (a::Int,x::Bool) -> if x then (square a,True) else (bottom,False))

-- main = go "foo" (\ x -> if x then True else bottom)

-- main = go "foo" (bottom :: Bool)

-- main = go "foo" (bottom::Int,False)

-- main = go "foo" (bottom::Bool, bottom::Int, bottom::Bool)

-- main = go "foo" (\ x -> if x then bottom else bottom :: Bool)

-- main = goSep "if-maybe" 0.75 (\ a (b :: Maybe Bool) c -> if a then b else c)

-- main = go "fmap-maybe-square" (fmap square :: Unop (Maybe Int))

-- main = go "fmap-maybe-not" (fmap not :: Unop (Maybe Bool))

-- main = go "foo" (\ a b -> if b then (not a,True) else (bottom,False))

-- main = go "fromMaybe-bool" (fromMaybe :: Bool -> Maybe Bool -> Bool)

-- main = goSep "fromMaybe-v3" 1.5 (fromMaybe :: Vec N3 Bool -> Maybe (Vec N3 Bool) -> Vec N3 Bool)

-- main = goSep "liftA2-maybe" 0.8 (liftA2 (*) :: Binop (Maybe Int))

-- main = goSep "liftA3-maybe" 0.8 (liftA3 f :: Ternop (Maybe Int))
--  where
--    f x y z = x * (y + z)

-- main = goSep "liftA4-maybe" 0.8 (\ (a,b,c,d) -> liftA4 f a b c d :: Maybe Int)
--  where
--    f w x y z = (w + x) * (y + z)

-- main = go "lift-maybe-1-1a" h
--  where
--    h a = pure square <*> a :: Maybe Int

-- main = go "lift-maybe-1-1b" h
--  where
--    h a = liftA2 (*) a a :: Maybe Int

-- main = go "lift-maybe-1-1c-no-idem" h
--  where
--    h a = fmap square b :: Maybe Int
--     where
--       b = liftA2 (+) a a

-- main = go "lift-maybe-1-2" h
--  where
--    h a = liftA2 (*) a b :: Maybe Int
--     where
--       b = liftA2 (+) a a

-- main = goSep "lift-maybe-1-3" 1 h
--  where
--    h a = liftA3 f a b c :: Maybe Int
--     where
--       b = liftA2 (*) a a
--       c = liftA2 (+) b a
--       f w x y = (w + x) * y

-- main = goSep "lift-maybe-1-4" 0.8 h
--  where
--    h a = liftA4 f a b c d :: Maybe Int
--     where
--       b = liftA2 (*) a a
--       c = liftA2 (+) b a
--       d = liftA2 (*) c b
--       f w x y z = (w + x) * (y + z)

-- main = go "liftA2-justs" (\ (a,b) -> liftA2 (*) (Just a) (Just b) :: Maybe Int)

-- Sums

-- main = go "fmap-either-square" (fmap square :: Unop (Either Bool Int))

-- main = go "case-of-either" 
--          (\ case Left  x -> if x then 3 else 5 :: Int
--                  Right n -> n + 3)

-- -- ranksep 1.5 when unoptimized.
-- main = goSep "if-to-either" 1.5 
--         (\ a -> if a then Left 2 else Right (3,5) :: Either Int (Int,Int))

-- main = goSep "case-if-either" 1
--         (\ a -> let e :: Either Int (Int,Int)
--                     e = if a then Left 2 else Right (3,5)
--                 in
--                   case e of
--                     Left n      -> n + 5
--                     Right (p,q) -> p * q )

-- main = goSep "case-if-either-2" 1
--         (\ (a,b,c,d) -> let e :: Either Int (Int,Int)
--                             e = if a then Left b else Right (c,d)
--                 in
--                   case e of
--                     Left n      -> n + 5
--                     Right (p,q) -> p * q )

-- main = goSep "case-if-either-3" 1
--         (\ (a,b,c) -> let e :: Either Int (Int -> Int)
--                           e = if a then Left b else Right (b *)
--                 in
--                   case e of
--                     Left  n -> n + c
--                     Right f -> f c )

-- -- The conditionals vanish
-- main = goSep "case-if-either-3b" 0.7
--         (\ (a,b,c) -> let e :: Either Int (Int -> Int)
--                           e = if a then Left b else Right (b +)
--                 in
--                   case e of
--                     Left  n -> n + c
--                     Right f -> f c )

-- main = go "foo" (\ (a::Int,old) -> dup (old+a))

-- main = goM "foo" (Mealy (\ (a::Int,old) -> dup (old+a)) 0)

-- main = goM "mealy-sum-0" (Mealy (\ (a::Int,old) -> dup (old+a)) 0)

-- We can't yet handle examples built from the Arrow interface.

-- main = goM "mealy-sum-1" (m :: Mealy Int Int)
--  where
--    m :: Mealy Int Int
--    m = loop (arr (\ (a,tot) -> dup (tot+a)) . second (delay 0))

-- serialSum0 :: Mealy Int Int
-- serialSum0 = Mealy (\ (old,a) -> dup (old+a)) 0

-- serialSum1 :: Mealy Int Int
-- serialSum1 = loop (arr (\ (a,tot) -> dup (tot+a)) . second (delay 0))

-- main = goM "mealy-counter-exclusive" (Mealy (\ ((),n::Int) -> (n,n+1)) 0)

-- main = goM "mealy-counter-inclusive" (Mealy (\ ((),n::Int) -> dup (n+1)) 0)

-- main = goM "mealy-sum-exclusive" (Mealy (\ (a::Int,n) -> (n,n+a)) 0)

-- main = goM "mealy-sum-inclusive" (Mealy (\ (a::Int,n) -> dup (n+a)) 0)

-- -- Square of consecutive numbers, inclusive
-- main = goM "mealy-square-counter-inclusive"
--          (Mealy (\ ((),n::Int) -> let n' = n+1 in (square n',n')) 0)

-- -- Prefix sum of square of inputs
-- main = goM "mealy-square-sum-inclusive"
--          (Mealy (\ (a::Int,tot) -> dup (tot + square a)) 0)

-- Serial Fibonacci variants:

-- main = goM "serial-fibonacci-a" $
--          Mealy (\ ((),(a,b)) -> (a,(b,a+b))) (0::Int,1)

-- main = goM "serial-fibonacci-b" $
--          Mealy (\ ((),(a,b)) -> (b,(b,a+b))) (0::Int,1)

-- main = goM "serial-fibonacci-c" $
--          Mealy (\ ((),(a,b)) -> let c = a+b in (c,(b,c))) (0::Int,1)

-- main = goM "serial-fibonacci-a-11" $
--          Mealy (\ ((),(a,b)) -> (a,(b,a+b))) (1::Int,1)

-- main = go "foo" (sumSquare :: RTree N2 Int -> Int)

-- main = goM "sumSP-rt3" (Mealy (\ (as :: RTree N3 (Sum Int),tot) -> dup (fold as <> tot)) mempty)

-- main = goM "sumSP-rt4" (sumSP :: Mealy (RTree N4 Int) Int)

-- main = goM "foldSP-rt1" (foldSP :: Mealy (RTree N1 (Sum Int)) (Sum Int))

-- main = goM "sumSP-rt2" (sumSP :: Mealy (RTree N2 Int) Int)

-- -- Not yet.
-- main = goM "dotSP-rt2p" (dotSP :: Mealy (RTree N2 (Pair Int)) Int)

-- main = goM "dotSP-rt4p" (Mealy (\ (pas :: RTree N4 (Pair Int),tot) -> dup (dot'' pas + tot)) 0)

-- type GS a = (GenBuses a, Show a)

fullAdd :: Pair Bool :* Bool -> Bool :* Bool
fullAdd = add1' . swap
{-# INLINE fullAdd #-}

-- main = go "fullAdd" (add1' . swap) -- fullAdd -- fullAdd doesn't inline

adderS :: Bool -> Mealy (Pair Bool) Bool
adderS = Mealy (add1 . swap)

-- main = goM "adderS" (adderS False)

-- main = goMSep "sumS" 0.5 (sumS :: Mealy Int Int)

-- main = goMSep "sumS-rt3" 1.5 (sumS :: Mealy (RTree N3 Int) (RTree N3 Int))

-- main = goMSep "sumPS-rt1" 0.75 (sumPS :: Mealy (RTree N1 Int) Int)

-- main = goM "dotPS-rt3p" (m :: Mealy (RTree N3 (Pair Int)) Int)
--  where
--    m = Mealy (\ (ts,tot) -> let tot' = tot + fmap product ts in (sum tot',tot')) 0

-- main = goMSep "mac-p" 1 (mac :: Mealy (Pair Int) Int)

-- main = goMSep "mac-prt2" 1 (mac :: Mealy (Pair (RTree N2 Int)) (RTree N2 Int))

-- main = goM "sum-mac-prt1" (sumMac :: Mealy (Pair (RTree N1 Int)) Int)

matVecMultSA :: (Foldable f, Applicative f, Num a, GS (f a)) =>
                Mealy (f a) a
matVecMultSA =
  Mealy (\ (row,s@(started,vec)) ->
           if started then (row <.> vec, s) else (0, (True,row))) (False,pure 0)

matVecMultS :: (Foldable f, Applicative f, Num a, GS (f a)) =>
               Mealy (f a) a
matVecMultS =
  Mealy (\ (row,s@(started,vec)) ->
           (row <.> vec, if started then s else (True,row))) (False,pure 0)

-- main = goM "mat-vec-mult-rt1" (matVecMultS :: Mealy (RTree N1 Int) Int)

-- main = goM "mat-vec-mult-rt1" (m :: Mealy (RTree N1 Int) Int)
--  where
--    m = Mealy (\ (row,mbVec) -> case mbVec of
--                                  Nothing -> (0,Just row)
--                                  Just v  -> (row <.> v, mbVec)) Nothing

-- main = goMSep "mat-vec-mult-a-rt3" 1 (m :: Mealy (RTree N3 Int) Int)
--  where
--    m = Mealy (\ (row,s@(started,vec)) ->
--                 if started then (row <.> vec, s) else (0, (True,row))) (False,pure 0)

-- -- 3:1, 4:1.5, 5:2
-- main = goMSep "mat-vec-mult-b-rt2" 1 (m :: Mealy (RTree N2 Int) Int)
--  where
--   m = Mealy (\ (row,s@(started,vec)) ->
--                (row <.> vec, if started then s else (True,row))) (False,pure 0)

-- -- Type error with MealyAsFun in Run
-- -- Same result as -b
-- main = goMSep "mat-vec-mult-c-rt2" 1 (m :: Mealy (RTree N2 Int) Int)
--  where
--   m = Mealy (\ (row,s@(started,vec)) ->
--                (row <.> vec, if started then s else (not started,row))) (False,pure 0)

-- main = goSep "get-p" 1 (P.get :: Bool -> Pair Int -> Int)

type Bits n = Vec n Bool

-- -- 3:1, 4:2, 5:3
-- main = goSep "get-rt5" 3 (RT.get :: Bits N5 -> RTree N5 Int -> Int)

-- -- 3:1, 4:2, 5:3
-- main = goSep "get-ib-rt3" 1 (RT.get :: Bits N3 -> RTree N3 (Int,Bool) -> (Int,Bool))

-- -- 3:1, 4:2, 5:3
-- main = goSep "get-lt4" 2 (LT.get :: Bits N4 -> LTree N4 Int -> Int)

-- main = go "update-p" (flip P.update (+2) :: Bool -> Pair Int -> Pair Int)

-- main = go "update-plus2-p" (\ (b,p::Pair Int) -> P.update b (+2) p)

-- main = go "update-not-p" (\ (b,p) -> P.update b not p)

-- -- 1:0.75, 2:1.5, 3:3, 4:8
-- main = goSep "update-plus2-rt1" 0.75 (\ (v,t::RTree N1 Int) -> RT.update v (+2) t)

-- -- 2:1.5, 3:3, 4:4
-- main = goSep "update-not-rt2" 1.5 (\ (v,t::RTree N2 Bool) -> RT.update v not t)

histogramStep ::  Num a => RTree n a -> Bits n -> RTree n a
histogramStep t v = RT.update v (+1) t

-- -- 1:2, 2:2, 3:2
-- main = goSep "histogramStep-3" 2 (histogramStep :: RTree N3 Int -> Bits N3 -> RTree N3 Int)

-- Combinational histogram
histogramP :: (Foldable f, IsNat n) => f (Bits n) -> RTree n Int
histogramP = foldl histogramStep (pure 0)
-- histogramP = foldl (\ t v -> RT.update v (+1) t) (pure 0)

-- -- 2-3:1, 3-4:?
-- main = goSep "histogramP-2-rt3" 1 (histogramP :: RTree N3 (Bits N2) -> RTree N2 Int)

oneTree :: (IsNat n, Num a) => Bits n -> RTree n a
oneTree = histogramStep (pure 0)

-- -- 1:0.5, 2:0.75, 3:1.5
-- main = goSep "one-c-rt1" 0.5 (oneTree :: Bits N1 -> RTree N1 Int)

oneTree' :: IsNat n => Bits n -> RTree n Bool
oneTree' v = RT.update v (const True) (pure False)

-- -- 1:0.75, 2:1.5, 3:2
-- main = goSep "onep-rt3" 2 (oneTree' :: Bits N3 -> RTree N3 Bool)

oneTree'' :: IsNat n => Bits n -> RTree n Int
oneTree'' v = boolToInt <$> oneTree' v

-- -- 1:0.5, 2:0.75, 3:1.5
-- main = goSep "onepp-rt3" 1.5 (oneTree'' :: Bits N3 -> RTree N3 Int)

-- As I hoped, oneTree'' gives identical results to oneTree.

histogramFold :: (Foldable f, Functor f, IsNat n) => f (Bits n) -> RTree n Int
histogramFold = sum . fmap oneTree

-- main = goSep "histogramFold-1-v5" 1 (histogramFold :: Vec N5 (Bits N1) -> RTree N1 Int)

-- -- 1,2:0.75; 2,3:1.5
-- main = goSep "histogramFold-1-rt2" 0.75 (histogramFold :: RTree N2 (Bits N1) -> RTree N1 Int)

histogramFold'' :: (Foldable f, Functor f, IsNat n) => f (Bits n) -> RTree n Int
histogramFold'' = sum . fmap oneTree''

-- -- 1,2:1, 2,3:1.5
-- main = goSep "histogramFoldpp-1-rt2" 0.5 (histogramFold'' :: RTree N2 (Bits N1) -> RTree N1 Int)

-- Serial histogram
histogramS :: (IsNat n, GS (RTree n Int)) => Mealy (Bits n) (RTree n Int)
histogramS = scanl histogramStep (pure 0)
-- histogramS = scanl (\ t v -> RT.update v (+1) t) (pure 0)

-- -- 1:0.5, 2:1, 3:3
-- main = goMSep "histogramS-1" 0.75 (histogramS :: Mealy (Bits N1) (RTree N1 Int))

-- main = go "pure-sum-rt3" (\ a -> sum (pure a :: RTree N3 Int))

-- main = go "pure-1-sum-rt3" (sum (pure 1 :: RTree N3 Int))

-- main = go "foo" True

-- Step via oneTree''
histogramStepO ::  IsNat n => RTree n Int -> Bits n -> RTree n Int
histogramStepO t v = t + oneTree'' v

-- -- 1:0.5;2:0.75;3:1
-- main = goSep "histogramStepO-3" 1 (histogramStepO :: RTree N3 Int -> Bits N3 -> RTree N3 Int)

-- Serial histogram
histogramSO :: (IsNat n, GS (RTree n Int)) => Mealy (Bits n) (RTree n Int)
histogramSO = scanl histogramStepO (pure 0)

-- -- 1:0.5, 2:0.75, 3:1
-- main = goMSep "histogramSO-2" 0.5 (histogramSO :: Mealy (Bits N2) (RTree N2 Int))

-- More CRC

-- crcS :: (GS (poly Bool), Applicative poly, Traversable poly) =>
--         Mealy Bool (poly Bool, Int)

-- main = goM "crcS-rt0" (crcS :: Mealy Bool (RTree N0 Bool, Int))

-- main = goM "adderS" (adderS False)

-- main = goM "mealy-counter-exclusive" (Mealy (\ ((),n::Int) -> (n,n+1)) 0)

-- main = go "sumSquare-rt2" (sumSquare :: RTree N2 Int -> Int)

-- main = goMSep "sumPS-rt4" 1 (m :: Mealy (RTree N4 Int) Int)
--  where
--    m = Mealy (\ (t,tot) -> let tot' = tot+t in (sum tot',tot')) 0

-- Explicit delay and loop

-- main = goNew "delay-false" (delay False)

-- main = goNew "delay-01" (delay (0::Int,1::Int))

-- main = goNew "foo" (loop (\ (a::Int,s::Bool) -> (a,s)))

-- -- <<loop>
-- main = goNew "foo" (loop (\ ((),n::Int) -> dup (n+1)))

-- main = goNew "foo" (loop ((\ ((),(a,b)) -> (a,(b,a+b))) . second (delay (0::Int,1))))

-- main = goNew "fibS" fibS
--  where
--   fibS :: () -> Int
--   fibS = loop ((\ ((),(a,b)) -> (a,(b,a+b))) . second (delay (0,1)))

-- main = goNew "foo" (loop (\ ((),((),())) -> ((),((),()))))

-- fibS :: Num a => () -> a
-- fibS = loop ((\ ((),(a,b)) -> (a,(b,a+b))) . second (delay (0,1)))

-- main = goNew "foo" (Mealy.asFun (Mealy (\ ((),(a,b)) -> (a,(b,a+b))) (0::Int,1)))

fibM :: MStream Int
fibM = Mealy (\ ((),(a,b)) -> (a,(b,a+b))) (0::Int,1)

-- main = goM "foo" fibM

-- main = goNew "foo" (asFun fibM)

-- main = goM "foo" fibM

-- main = goM "fib-iteratep" (fst <$> iterateU' (\ (a,b) -> (b,a+b)) (0::Int,1))

-- main = go "comparisons"
--         (\ (x::Int,y::Int) -> (x==y || x/=y) && (x<y || x>=y) && (x>y || x<=y))

-- main = go "loop-id" (loop (\ (a::Bool,b::Int) -> (a,b)))

-- main = go "loop-const" (loop (\ (a::Bool,_b::Int) -> (a,3)))

-- main = go "loop-free-state-a" (loop (\ (a::Int,b::Int) -> (b > a,3)))

-- main = go "loop-free-state-b" (loop (\ (a::Int,b::Int) -> (b > a,a)))

-- -- "<<loop>"
-- main = go "loop-oops-a" (loop (\ (a::Int,b::Int) -> (b > a,b+1)))

-- main = goM "foo" (Mealy swap 0 :: Mealy (RTree N3 Int) (RTree N3 Int))

-- Like 'shiftR' but drop the value pushed out the left, and uncurry.
shiftR' :: Traversable t => t a -> a -> t a
shiftR' = curry (snd . shiftR)
-- shiftR' as a = snd (shiftR (as,a))

-- Serial
crcS' :: forall poly. (GS (poly Bool), Applicative poly, Traversable poly) =>
         Mealy Bool (poly Bool)
crcS' = Mealy h (pure False, pure False,0)
 where
   p = sizeA (undefined :: poly ())
   h :: MealyFun (poly Bool, poly Bool, Int) Bool (poly Bool)
   h (b,(poly,seg,i)) = (stepped,(poly',seg',i'))
    where
      stash q = shiftR' q b
      starting = i < 2*p
      i' = if starting then i+1 else i
      stepped = crcStep poly (seg,b)
      (poly',seg')
        | i < p     = (stash poly,seg)
        | starting  = (poly,stash seg)
        | otherwise = (poly,stepped)

-- Can I use step instead of stash for seg?

-- main = goM "crcS-rt1" (crcS :: Mealy Bool (RTree N1 Bool))

-- main = goM "crcSK-v1" (crcSK poly :: Mealy Bool (Vec N1 Bool))
--  where
--    poly = vec1 True

-- Serial with static polynomial
crcSKa :: forall poly. (GS (poly Bool), Applicative poly, Traversable poly) =>
          poly Bool -> Mealy Bool (poly Bool)
crcSKa poly = fst <$> scanl h (pure False,0)
 where
   p = sizeA (undefined :: poly ())
   h (seg,i) b | i < p     = (shiftR' seg b, i+1)
               | otherwise = (crcStep poly (seg,b), i)

-- main = goM "crcSKa-v1" (crcSKa polyD :: Mealy Bool (Vec N1 Bool))

-- main = goM "crcSKa-rt0" (crcSKa polyD :: Mealy Bool (RTree N0 Bool))

-- main = go "foo" (fmap not :: Unop (RTree N2 Bool))

shiftLS :: (Traversable f, GS (f a)) => f a -> Mealy a a
shiftLS = Mealy (swap . shiftL)

shiftRS :: (Traversable f, GS (f a)) => f a -> Mealy a a
shiftRS = Mealy (shiftR . swap)

-- Types:
-- 
--   shiftL :: (a, f a) -> (f a, a)
--   swap . shiftL :: (a, f a) -> (a, f a)
-- 
--   shiftR :: (f a, a) -> (a, f a)
--   shiftR . swap :: (a, f a) -> (a, f a)

-- main = goM "shiftL-v3"  (shiftLS (pure False :: Vec N3 Bool))

-- main = goM "shiftR-v3"  (shiftRS (pure False :: Vec N3 Bool))

-- main = goM "shiftL-iota-v3"  (shiftLS (V.iota :: Vec N3 Int))

-- main = goM "shiftR-iota-v3"  (shiftRS (V.iota :: Vec N3 Int))

-- main = goM "shiftL-iota-rt2"  (shiftLS (iota :: RTree N2 Int))

-- main = goM "shiftRS-rt3" (shiftRS (pure False :: RTree N3 Bool))

-- main = goM "shiftR-ib-v3"  (shiftRS (pure (0,False) :: Vec N3 (Int,Bool)))

-- To simplify the circuit, output stepped even when i<p.
-- We expect the user to ignore this initial output either way.
crcSKb :: forall poly. (GS (poly Bool), Applicative poly, Traversable poly) =>
          poly Bool -> Mealy Bool (poly Bool)
crcSKb poly = Mealy h (pure False,0)
 where
   p = sizeA (undefined :: poly ())
   h (b,(seg,i)) = (stepped,next)
    where
      stepped = crcStep poly (seg,b)
      next | i < p     = (shiftR' seg b, i+1)
           | otherwise = (stepped, i)

-- main = goM "crcSKb-rt2" (crcSKb polyD :: Mealy Bool (RTree N2 Bool))

-- In this version, advance i even when i>=p, to shorten critical path.
-- WARNING: don't use for messages of length >= 2^32.
crcSKc :: forall poly. (GS (poly Bool), Applicative poly, Traversable poly) =>
          poly Bool -> Mealy Bool (poly Bool)
crcSKc poly = Mealy h (pure False,0)
 where
   p = sizeA (undefined :: poly ())
   h (b,(seg,i)) = (stepped,(seg',i+1))
    where
      stepped = crcStep poly (seg,b)
      seg' | i < p     = shiftR' seg b
           | otherwise = stepped

-- main = goM "crcSKc-rt0" (crcSKc polyD :: Mealy Bool (RTree N0 Bool))

crcSKd :: forall poly. (GS (poly Bool), Applicative poly, Traversable poly) =>
          poly Bool -> Mealy Bool (poly Bool)
crcSKd poly = Mealy h (pure False)
 where
   h (b,seg) = dup stepped
    where
      stepped = crcStep poly (seg,b)

-- Rewrite via Mealy scanl

crcSKe :: forall poly. (GS (poly Bool), Applicative poly, Traversable poly) =>
          poly Bool -> Mealy Bool (poly Bool)
crcSKe poly = scanl (curry (crcStep poly)) (pure False)

-- main = goM "crcSKe-rt4" (crcSKe polyD :: Mealy Bool (RTree N4 Bool))

-- Local curried version of crcStep

crcSKf :: forall poly. (GS (poly Bool), Applicative poly, Traversable poly) =>
          poly Bool -> Mealy Bool (poly Bool)
crcSKf poly = scanl step (pure False)
 where
   step seg b0 = if b0' then liftA2 xor poly seg' else seg'
    where
      (b0',seg') = shiftR (seg,b0)

-- main = goM "crcSKf-rt2" (crcSKf polyD :: Mealy Bool (RTree N2 Bool))

boolToChar :: Bool -> Char
boolToChar False = '0'
boolToChar True  = '1'

writeFile' :: FilePath -> String -> IO ()
writeFile' fname str = writeFile fname str >> putStrLn ("Wrote " ++ fname)

crcFileName :: String -> Int -> Int -> String
crcFileName = printf "../test/out/crc-bits-%s-%d-%d.txt"

genCrcIn :: Nat d -> Int -> IO ()
genCrcIn nd n =
  do ins <- ( ++ replicate d False) <$>
            generate (vectorOf (n - d) (arbitrary :: Gen Bool))
     writeFile' (crcFileName "ina" d n) (show ins)
     writeFile' (crcFileName "inb" d n) (unlines $ (pure . boolToChar) <$> ins)
 where
   d = natToZ nd

genCrcOut :: forall d. (IsNat d, GenBuses (RTree d Bool), PolyD (RTree d)) =>
             Nat d -> Int -> IO ()
genCrcOut nd n =
  do ins <- read <$> readFile (crcFileName "ina" d n)
     let outs = reverse <$> runMealy (crcSKf (polyD :: RTree d Bool)) ins
     writeFile' (crcFileName "outa-f" d n) (show outs)
     writeFile' (crcFileName "outb-f" d n)
       (unlines $ (map boolToChar . toList) <$> outs)
 where
   d = natToZ nd

-- main = genCrcIn d n
--  where
--    d = nat :: Nat N5
--    n = 4096

-- main = genCrcOut d n
--  where
--    d = nat :: Nat N5
--    n = 4096

-- main = goM "foo" (foo :: MStream (RTree N0 Bool))

-- Sequential-of-parallel
crcSPK :: (GS (poly Bool), Applicative poly, Traversable poly, Foldable chunk) =>
          poly Bool -> Mealy (chunk Bool) (poly Bool)
crcSPK poly = scanl (foldl step) (pure False)
 where
   step seg b0 = if b0' then liftA2 xor poly seg' else seg'
    where
      (b0',seg') = shiftR (seg,b0)

-- main = goM "crcSPK-rt3-rt2" (crcSPK polyD :: Mealy (RTree N3 Bool) (RTree N2 Bool))

crcP :: (Applicative poly, Traversable poly, Foldable msg) =>
        poly Bool -> msg Bool -> poly Bool
crcP poly = foldl step (pure False)
 where
   step seg b0 = if b0' then liftA2 xor poly seg' else seg'
    where
      (b0',seg') = shiftR (seg,b0)

-- -- 1,2: 0.5; 2,2: 0.75; 3,2: 1;
-- main = goSep "crcPK-rt3-rt2" 1 (crcP polyD :: RTree N3 Bool -> RTree N2 Bool)

matMatMultS :: (GS (f a), Foldable f, Applicative f, Num a) => Mealy (Bool, f a) a
matMatMultS = Mealy h (pure 0)
 where
   h ((new,w),row) = (row <.> w, if new then w else row)

-- -- 2:0.75; 3:1.0; 4:1.5, 5:2.5
-- main = goMSep "matMatMultS-rt4" 1.5 (matMatMultS :: Mealy (Bool, RTree N4 Int) Int)

-- main = go "foo" (\ (a,b::Int,c::Int) -> if not a then b else c)

revRT :: (IsNat n, Ord a) => Unop (RT.Tree n a)
revRT = RT.butterfly reverse

-- -- Butterfly swap, i.e., reversal
-- -- 1:0.5,2:1,3:2
-- main = goSep "butterfly-swap-rt2" 1 (revRT :: Unop (RTree N2 Bool))

-- main = goSep "sortP" 0.75 (sortP :: Unop (Pair Int))

-- -- 2,3,4:0.75
-- main = goSep "bitonic-3" 0.75 (bsort :: Unop (RTree N3 Int))

-- mapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)

iotaT :: (Traversable t, Applicative t, Num a) => t a
iotaT = snd (mapAccumL (\ n () -> dup (n+1)) 0 (pure ()))

iotaT4 :: RTree N4 Int
iotaT4 = iotaT

-- main = go "foo" (True,3 :: Int)

-- main = go "foo" (True,iotaT :: RTree N1 Int)

-- -- Evokes unboxed Int, which the reifier can't handle.
-- main = go "foo" (min 3 :: Int -> Int)

-- main = go "foo" (||)

-- main = go "foo" (\ a b c -> a || b && c)

-- main = goM "foo" (scanl (\ b () -> not b) True)

-- main = goM "foo" (scanl (\ (a,b) () -> (b,a)) (True,False))

-- main = goM "iterate-not" (iterateU not False)

-- main = goM "foo" (iterateU swap (True,False))

-- main = goM "foo" (snd <$> iterateU swap (True,False))

-- Recursive.
-- main = goM "foo" (iterateU rotateR iotaT4)
-- main = goM "foo" (iterateU rotateR (vec1 True))
-- main = go "foo" (rotateR :: Unop (Vec N1 Bool))

-- main = goM "sumS" (sumS :: Mealy Int Int)

-- main = goM "double-sumS" (double (sumS :: Mealy Int Int))

-- main = goM "double-2-sumS" (double (double (sumS :: Mealy Int Int)))

-- main = goM "countS" (iterateU (+1) (0 :: Int))

-- main = go "foo" (RS.oneTree :: Bits N2 -> RTree N2 Int)

-- -- 1,2:0.75; 2,3:1.5; 1,4:0.75
-- main = goSep "histogramFold-1-4" 1.5 (RS.histogramFold :: RTree N4 (Bits N1) -> RTree N1 Int)

-- -- 1,2:0.75; 2,3:1.5; 1,4:1.5
-- main = goSep "histogramScan-1-4" 1.5 (RS.histogramScan :: RTree N4 (Bits N1) -> (RTree N4 (RTree N1 Int), RTree N1 Int))

-- -- 1,2:0.5; 2,3:2; 1,4:1.5
-- main = goSep "countSortPermutation-1-4" 1.5 (RS.positions :: RTree N4 (Bits N1) -> RTree N4 Int)

-- -- 1,2:0.5; 2,3:2; 1,4:1.5
-- main = goSep "countSortPermutationp-1-2" 0.5 (RS.positions :: RTree N2 (Bits N1) -> RTree N2 Int)


{--------------------------------------------------------------------
    Polynomial evaluation
--------------------------------------------------------------------}

powers :: (LScan f, Applicative f, Num a) => a -> f a
powers = fst . lproducts . pure

-- -- 1,2:0.5,3:1; 4:1.5; 5:2;
-- main = goSep "powers-rt4" 1.5 (powers :: Int -> RTree N4 Int)

-- -- 1,2:0.5,3:1; 4:1.5; 5:2;
-- main = goSep "powers-lt4" 1.5 (powers :: Int -> LTree N4 Int)

-- -- 2:1; 3:1.5; 4:2; 5:2.5
-- main = goSep "foo-rt3" (3/2) (fst . lproducts :: Unop (RTree N3 Int))

-- -- 2:1; 3:1.5; 4:2; 5:2.5
-- main = goSep "foo-lt3" (3/2) (fst . lproducts :: Unop (LTree N3 Int))

-- -- 2:1; 3:1.5; 4:2; 5:2.5
-- main = goSep "bar-rt3" (3/2) (fst . lproducts . pure :: Int -> RTree N3 Int)

-- -- 2:1; 3:1.5; 4:2; 5:2.5
-- main = goSep "bar-lt3" (3/2) (fst . lproducts . pure :: Int -> LTree N3 Int)


evalPoly :: (LScan f, Applicative f, Foldable f, Num a) => f a -> a -> a
evalPoly coeffs x = coeffs <.> powers x

-- -- -- 1,2:0.5,3:1; 4:2; 5:3;
-- main = goSep "evalPoly-rt4" 2 (evalPoly :: RTree N4 Int -> Int -> Int)

-- -- 1,2:0.5,3:1; 4:2; 5:3;

-- main = goSep "evalPoly-lt5" 3 (evalPoly :: LTree N5 Int -> Int -> Int)

-- Linear versions for comparison

#if 0
op :: b -> a -> b
e :: b
mapAccumL :: Traversable t => (b -> a -> (b, c)) -> b -> t a -> (b, t c)
(fmap.fmap) dup op :: b -> a -> (b,b)
mapAccumL ((fmap.fmap) dup op) e :: t a -> (b, t b)
swap . mapAccumL ((fmap.fmap) dup op) e :: t a -> (b, t b)
#endif

lproductsl :: (Traversable f, Num a) => f a -> (f a, a)
lproductsl = scanlT (*) 1

powersl :: (Traversable f, Applicative f, Num a) => a -> f a
powersl = fst . lproductsl . pure

-- main = go "powersl-rt3" (powersl :: Int -> RTree N3 Int)

evalPolyl :: (Traversable f, Applicative f, Foldable f, Num a) => f a -> a -> a
evalPolyl coeffs x = coeffs <.> powersl x

-- To do: switch `evalPolyl` to use a linear dot product, and retry.

-- main = go "evalPolyl-rt3" (evalPolyl :: RTree N3 Int -> Int -> Int)

-- Infix binary dot product, foldl version
infixl 7 `dotL`
dotL :: (Foldable f, Applicative f, Num a) => f a -> f a -> a
u `dotL` v = foldl (+) 0 (liftA2 (*) u v)

-- Infix binary dot product, foldr version
infixl 7 `dotR`
dotR :: (Foldable f, Applicative f, Num a) => f a -> f a -> a
u `dotR` v = foldr (+) 0 (liftA2 (*) u v)

-- main = go "dotl-rt3" (dotL :: RTree N3 Int -> RTree N3 Int -> Int)

-- main = go "dotr-rt3" (dotR :: RTree N3 Int -> RTree N3 Int -> Int)

evalPolyAddL :: (Traversable f, Applicative f, Foldable f, Num a) => f a -> a -> a
evalPolyAddL coeffs x = coeffs `dotL` powersl x

-- main = go "evalPolyAddL-rt3" (evalPolyAddL :: RTree N3 Int -> Int -> Int)

-- Serial version

-- First argument is a dummy, to allow inferring f.
-- Ignore the first p outputs, while the polynomial is loading.
evalPolyS :: forall f a. (GS (f a), LScan f, Traversable f, Applicative f, Num a) =>
             f () -> Mealy a a
evalPolyS _ = Mealy h (pure 0 :: f a,0)
 where
   p = sizeA (undefined :: f ())
   h (a,(poly,i)) = (evalPoly poly a,(poly',i+1))
    where
      poly' | i < p     = shiftR' poly a
            | otherwise = poly

-- main = goM "evalPolyS-rt5" (evalPolyS (undefined :: RTree N5 ()) :: Mealy Int Int)

-- Linear version
evalPolyAddLS :: forall f a. (GS (f a), LScan f, Traversable f, Applicative f, Num a) =>
               f () -> Mealy a a
evalPolyAddLS _ = Mealy h (pure 0 :: f a,0)
 where
   p = sizeA (undefined :: f ())
   h (a,(poly,i)) = (evalPolyAddL poly a,(poly',i+1))
    where
      poly' | i < p     = shiftR' poly a
            | otherwise = poly

-- main = goM "evalPolyAddLS-rt3" (evalPolyAddLS (undefined :: RTree N3 ()) :: Mealy Int Int)

evalPolyAddR :: (Traversable f, Applicative f, Foldable f, Num a) => f a -> a -> a
evalPolyAddR coeffs x = coeffs `dotR` powersl x

-- main = go "evalPolyAddR-rt3" (evalPolyAddR :: RTree N3 Int -> Int -> Int)

-- Linear version
evalPolyAddRS :: forall f a. (GS (f a), LScan f, Traversable f, Applicative f, Num a) =>
               f () -> Mealy a a
evalPolyAddRS _ = Mealy h (pure 0 :: f a,0)
 where
   p = sizeA (undefined :: f ())
   h (a,(poly,i)) = (evalPolyAddR poly a,(poly',i+1))
    where
      poly' | i < p     = shiftR' poly a
            | otherwise = poly

-- main = goM "evalPolyAddRS-rt3" (evalPolyAddRS (undefined :: RTree N3 ()) :: Mealy Int Int)

{--------------------------------------------------------------------
    Counters
--------------------------------------------------------------------}

-- main = go "lAlls-rt2" (lAlls :: Counter (RTree N2 Bool))

-- main = goSep "upL-rt3" 1 (upL :: Counter (RTree N3 Bool))

upL' :: (Applicative f, Traversable f) => Unop (f Bool)
upL' = fst . upL

-- main = goSep "upLp-rt3" 1 (upL' :: Unop (RTree N3 Bool))

-- main = goSep "upLp-2-rt2" 1 (upL' . upL' :: Unop (RTree N2 Bool))

-- main = goSep "nax-a" 1 (\ (a,b) -> not a && (a `xor` b))

upF' :: (Applicative f, LScan f) => Unop (f Bool)
upF' = fst . upF

-- main = goSep "upFp-rt3" 1 (upF' :: Unop (RTree N3 Bool))

-- main = goSep "upFp-2-rt1" 1 (upF' . upF' :: Unop (RTree N1 Bool))

-- main = goM "upCounterL-rt3" (upCounterL :: MStream (RTree N3 Bool))

-- -- 2:1, 3:2, 4:3
-- main = goSep "upF-rt2" (2-1) (upF :: Counter (RTree N2 Bool))

-- main = goM "upCounter-rt1" (upCounter :: MStream (RTree N3 Bool))

----

-- main = goM "foo" (scanl (\ _ () -> False) False)

-- main = goM "foo" (iterateU (const False) False)

-- main = go "delay-False-False" (delay False False)

-- main = go "foo" (scanlT (&&) True :: RTree N1 Bool -> (RTree N1 Bool, Bool))

-- upL bs = (liftA2 toggleIf alls bs, all')
--  where
--    (alls,all') = scanlT (&&) True bs

-- Question: Suppose I use adders, partially applied to 1.
-- Do I get the same circuits as with the up-counters?
-- Yes, as shown below.

-- type Adder  f =         f (Pair Bool) -> f Bool :* Bool
-- type Adder' f = Bool :* f (Pair Bool) -> f Bool :* Bool

-- Apply an Adder' to carry-in of 1 and a zero summand
adder'1 :: Functor f => Adder' f -> Counter f
adder'1 h bs = h (True, (False :#) <$> bs)

-- main = goSep "adder-state-c0-rt3" 1 (adder'1 adderState :: Counter (RTree N3))

-- -- GHC panic.
-- main = goSep "adder-state-trie-c0-rt3" 1 (adder'1 adderStateTrie :: Counter (RTree N3))

-- -- 2:1, 3:2, 4:3
-- main = goSep "scan-adder-c0-rt4" (4-1) (adder'1 scanAdd' :: Counter (RTree N4))

foldMap' :: (Foldable t, Monoid m) => (a -> m) -> t a -> m
foldMap' f = foldl (\ m a -> mappend (f a) m) mempty

-- foldMap' f = foldr (mappend . f) mempty

-- f :: a -> m
-- mappend . f :: a -> m -> m

-- \ a -> mappend (f a)
-- \ a m -> mappend (f a) m

-- \ m -> mappend m . f


-- foldMap' f = foldr (mappend . f) mempty

-- main = go "foo" (\ x y -> (x+y,x-y :: Complex Int))

-- main = go "foo" ((-) :: Binop (Complex Int))
-- main = go "foo" ((*) :: Binop (Complex Int))

-- main = go "foo" (+ negate (5 :: Int))

-- main = go "foo" (== (5 :: Int))

-- main = go "foo" (> (5 :: Int))

-- main = goSep "foo" 1.5 (\ (x :: Int) -> ((x+3,x-3,x*3,-x),(x==3,x>3)))

-- main = go "foo" (\ (x :: Int) -> (x+3,x==3))

-- main = go "foo" ((+) :: Binop Int)

-- main = go "foo" ((>) :: Int -> Int -> Bool)

-- main = go "foo" (\ (x :: Int) y -> (x + negate y, y - negate x))

-- main = go "foo" (negate . negate :: Unop Int)

-- main = go "foo" (negate . negate . negate . negate . negate :: Unop Int)

-- main = go "foo" (\ x (y :: Int) -> (x + negate y, negate x + y, x - negate y, negate x - y))

-- main = go "foo" (3.0 :: Double)

-- main = go "foo" (\ (x :: Double) -> x + 1)

-- main = go "foo" (\ (x :: Int) -> x + 1)

-- main = go "foo" ((+) :: Binop (Complex Double))

-- main = go "foo" ((*) :: Binop (Complex Double))

-- main = go "foo" ((+) :: Binop Double)

-- main = go "foo" ((+) :: Binop Int)

-- main = go "foo" (1 :: Complex Double)

-- main = go "foo" (fromInteger 1 :: Double)

-- main = go "foo" (fromInteger 1 :: PrettyDouble)

-- main = go "foo" (fromIntegral :: Int -> Double)

-- phasor :: (IsNat n, RealFloat a, Enum a) => Nat n -> RTree n (Complex a)
-- phasor n = scanlTEx (*) 1 (pure phaseDelta)
--  where
--    phaseDelta = cis ((-pi) / (2 ** natToZ n))

-- main = go "foo" (phasor (nat :: Nat N1))

-- main = go "foo" (natToZ (nat :: Nat N1) :: Int)