{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

-- Explicit sharing across several expressions:
--   Explicit sharing with sklansky
-- This code is to answer the challenge by Matthew Naylor.
{-
Matthew Naylor wrote:
http://www.haskell.org/pipermail/haskell-cafe/2008-February/039671.html

If a 128-bit processor were being developed, sklansky could reasonably
be passed 128 elements,

  *Main> test_sklansky 128    -- on an AMD64 2200
  (3.71 secs, 296129440 bytes)

and could form part of a larger expression, and be called several
times.  So I think this is close to a real situation where CSE is not
practical.  But like you say, a human would not write such a humungous
expression by hand; hand-written expressions may therefore be ideal
for crunching by your CSE method.

Still, we might like to write generators like sklansky.  Hope is
offered by the new "let_" construct, but it's not clear how to use it
in this case. The problem is that sklansky is a function over lists of
expressions rather than single expressions, and the "let_" construct
can only bind single expressions and return single expressions.  To
write sklansky using your approach, it seems (to me) that the DSL's
expression type needs to be extended to support lists.  Will this not
be complicated and introduce notational inconvenience?  (In an earlier
post, I outlined a method for embedding algebraic data types in
Haskell, and it does have some notational burden.)
-}

--  We demonstrate the explicit sharing in the sklansky example, without
--  adding lists to our DSL and without explicit use of monads.
--  We explicitly avoid rewriting sklansky in the monadic style.
--  The challenge is to insert the statically unknown number of
--  let_ expressions to indicate the explicit sharing.

module ExpLetList where

import ExpF (N(..), NodeId, DAG(..), Exp(..), do_bench)
import ExpLet (ExpLet(..))
import BiMap (empty)
import Control.Monad.State

-- The key are two operations for
class LC n m a where
  gseq :: [n a] -> m [a]
  gcom :: m [a] -> ([n a] -> m [a]) -> m [a]

-- The law: gcom gsec === id

-- The best way to understand them is through the following instance
-- of m == n:

instance Monad m => LC m m a where
    gseq = sequence
    gcom m f = m >>= f . map return

-- We will be using the structure for the case when m /= n
-- N itself is not a monad

instance LC N (State DAG) Int where
    gseq xs = sequence (map unN xs)
    gcom m f = m >>= f . map (N . return)

-- Recall the original sklansky
{-
sklansky :: (a -> a -> a) -> [a] -> [a]
sklansky f [] = []
sklansky f [x] = [x]
sklansky f xs = left' ++ [ f (last left') r | r <- right' ]
  where
    (left, right) = splitAt (length xs `div` 2) xs
    left'  = sklansky f left
    right' = sklansky f right
-}

-- To indicate the explicit sharing, we have to change
-- the code, of course.
-- But we don't have to re-write in the full-blown
-- monadic style
-- For example, the key part, the comprehension
--    left' ++ [ f (last left') r | r <- right' ]
-- remained the same. We just inserted a `generalized let'
sklansky' :: LC m n a =>
     (m a -> m a -> m a) -> [m a] -> n [a]
sklansky' f a@[] =  gseq a
sklansky' f [x] = gseq [x]
sklansky' f xs = 
  gcom left' (\left' ->
   gcom right' (\right' ->
      gseq $ left' ++ [ f (last left') r | r <- right' ]))
  where
    (left, right) = splitAt (length xs `div` 2) xs
    left'  = sklansky' f left
    right' = sklansky' f right


test_sklansky' n = runState sk (DAG empty)
  where
  sk = sklansky' add xs
  xs = (map (variable . show) [1..n]) :: [N Int]

t4 = test_sklansky' 4

-- modulo 6<->4
{-
([0,2,6,7],DAG BiMap[(0,NVar "1"),(1,NVar "2"),
  (2,NAdd 0 1),(3,NVar "3"),(4,NVar "4"),
  (5,NAdd 3 4),(6,NAdd 2 3),(7,NAdd 2 5)])
-}

{-
*ExpLetList> test_sklansky' 8
([0,2,6,7,16,17,18,19],
  DAG BiMap[(0,NVar "1"),(1,NVar "2"),
  (2,NAdd 0 1),(3,NVar "3"),(4,NVar "4"),
  (5,NAdd 3 4),(6,NAdd 2 3),(7,NAdd 2 5),
  (8,NVar "5"),(9,NVar "6"),(10,NAdd 8 9),
  (11,NVar "7"),(12,NVar "8"),
  (13,NAdd 11 12),(14,NAdd 10 11),(15,NAdd 10 13),
  (16,NAdd 7 8),(17,NAdd 7 10),(18,NAdd 7 14),(19,NAdd 7 15)])
-}


-- Not so bad... The implicit sharing detection is quite fast
bench_skl' n = do_bench $ test_sklansky' n

{-
-- in ExpF.hs: using implicit sharing only
*ExpF> bench_skl 128
576
(0.50 secs, 10,412,660 bytes)
*ExpF> bench_skl 256
1280
(3.09 secs, 38,912,932 bytes)
-}

-- Now, with the explicit sharing
-- It takes significantly less time, and significantly less space
{-
*ExpLetList> bench_skl' 128
576
(0.09 secs, 4,858,480 bytes)
*ExpLetList> bench_skl' 256
1280
(0.21 secs, 4,170,644 bytes)
-}