{-# LANGUAGE MultiParamTypeClasses #-}


data Expr = Lit Integer             -- Literal value
          | Var Integer             -- Variable reference
          | Let Integer Expr Expr   -- Variable binding

          | Signum Expr             -- Num ops
          | Abs Expr
          | Add Expr Expr
          | Mul Expr Expr
            deriving (Show, Eq)

instance Num Expr where
    a + b = Add a b
    a * b = Mul a b
    signum = Signum
    abs = Abs
    fromInteger = Lit


f1 x y = x * y
f2 x y = x + y

-- f1 1 2 :: Expr  =>  Mul (Value 1) (Value 2)
-- f1 1 2 :: Expr  =>  Add (Value 1) (Value 2)


f3 x y = a * a where
    a = x + y

-- f3 1 2 :: Expr  =>  Mul (Add (Value 1) (Value 2)) (Add (Value 1) (Value 2))
-- How to recover the sharing?
-- http://zwizwa.be/-/meta/20110114-130928



f4 x y =
    do
      a <- x + y
      return (a * a)


-- See defs in 
-- [1] http://www.cs.rice.edu/~taha/publications/conference/pepm06.pdf

-- 3 parameters: state, result, code
data SC s r c = SC {runSC :: (s -> (s -> c -> r) -> r)}



-- This is turned into a monad which performs the plumbling only.
instance Monad (SC s r) where
    return x = SC (\s k -> k s x)
    (SC a) >>= f = SC (\s k -> a s (\s' x -> (runSC (f x)) s' k))

-- In addition we need to express the memoization mechanism in an
-- abstract way.  This can be done by expressing syntax as type class
-- functions instead of ADT constructors.


-- Things we do not abstract:
--   Variables are identified using an Integer type

-- class VarAlloc e s where
--     varAlloc :: s -> (Integer, s)
--     varDecl  :: Integer -> e -> e -> e
--     varRef   :: Integer -> e
--     varShare :: e -> s -> (s -> e -> e) -> e


data VState = VState Integer
-- instance VarAlloc Expr VState where
--     varDecl = Let
--     varRef  = Var
--     varAlloc (VState n) = (n, VState (n+1))

--     varShare x s k =
--         Let n x x' where
--                 x' = k s' (Var n)
--                 (n, s') = varAlloc s

varAlloc (VState n) = 
    (n, VState (n+1))
varShare x s k =
    Let n x x' where
            x' = k s' (Var n)
            (n, s') = varAlloc s
 
showSC (SC a) = a (VState 0) (\s c -> c)


returnN = SC . varShare
bindN a f = a >>= (\x -> ((returnN x) >>= f))



test y = do
  x <- returnN y
  return (x * x)

test' = showSC $ test $ Lit 1



-- Move the Let insertion behind a type class to keep the structure
-- monadic.


-- class Sharing state expr where 
    -- Take an expression and
--    bindVariable :: expr -> (expr -> expr) -> expr