-- | Simple example language built using 'Lam'.

module Feldspar.DSL.Val where



import Data.Typeable

import Feldspar.DSL.Expression
import Feldspar.DSL.Lambda
import Feldspar.DSL.Sharing



--------------------------------------------------------------------------------
-- * Library
--------------------------------------------------------------------------------

data Val role a = Val String a

instance ExprEq Val
  where
    exprEq (Val v1 _) (Val v2 _) = v1==v2

instance Eval Val
  where
    eval (Val _ a) = a

instance ExprShow Val
  where
    exprShow (Val val _) = val

simpleVal :: Show a => a -> Lam Val () a
simpleVal a = Inject $ Val (show a) a

function :: (Typeable ra, Typeable a) =>
    String -> (a -> b) -> (Lam Val ra a -> Lam Val rb b)
function name f a = Inject (Val name f) :$: a

function2 :: (Typeable ra, Typeable a, Typeable rb, Typeable b) =>
    String -> (a -> b -> c) -> (Lam Val ra a -> Lam Val rb b -> Lam Val rc c)
function2 name f a b = Inject (Val name f) :$: a :$: b

int :: Int -> Lam Val () Int
int = simpleVal

true  = simpleVal True
false = simpleVal False

instance (Num a, Typeable a) => Num (Lam Val () a)
  where
    fromInteger = simpleVal . fromInteger
    abs         = function "abs" abs
    signum      = function "signum" signum
    (+)         = function2 "(+)" (+)
    (-)         = function2 "(-)" (-)
    (*)         = function2 "(*)" (*)



--------------------------------------------------------------------------------
-- * Examples
--------------------------------------------------------------------------------

expr1 :: Lam Val (() -> ()) (Int -> Int)
expr1 = Lambda $ \x -> x + (let_ "temp" (2 + 3 + x) $ \y -> y+x)

expr2 :: Lam Val (() -> ()) (Int -> Int)
expr2 = Lambda $ \x -> x + (let_ "temp" (2 + 3 + x) $ \y -> 2 + 3 + y+x)

test1 = drawLambda expr2
test2 = drawLambda $ simpleSharing expr2

problem = drawLambda $
    simpleSharing ((1+2+3) + (1+2+4) + (1+2+3+4) :: Lam Val () Int)
  -- TODO: 1+2 not shared
  --       Use fixpoint iteration?