module Sifflet.Examples 
    (exampleFunctions
    , exampleFunctionNames
    , exampleEnv 
    , foo, eFoo -- used in Testing.Unit.ExprTests
    , eMax -- ditto
    , eFact -- ditto
    , getExampleFunction
    )

where

import Sifflet.Language.Expr

-- TEST COMPOUND FUNCTIONS

-- | grossProfit salesA salesB = 0.12 salesA + 0.25 salesB

grossProfit :: Function
grossProfit = 
    Function (Just "grossProfit") [VpTypeNum, VpTypeNum] VpTypeNum
             (Compound ["salesA", "salesB"]
              (eCall "+" [eCall "*" [eFloat 0.12, eSymbol "salesA"],
                          eCall "*" [eFloat 0.25, eSymbol "salesB"]]))

-- | bonus1 profit = if profit > 100000 
--                   then 1000 + 0.0012 * profit
--                   else 0
bonus1 :: Function
bonus1 =
    Function (Just "bonus1") [VpTypeNum] VpTypeNum
             (Compound ["profit"]
              (eIf (eCall ">" [eSymbol "profit", eInt 100000])
                   (eCall "+" [eInt 1000,
                               eCall "*" [eFloat 0.0012, eSymbol "profit"]])
                   (eInt 0)))

-- | bonus2 salesA salesB = bonus1 (grossProfit salesA salesB)
bonus2 :: Function
bonus2 =
    Function (Just "bonus2") [VpTypeNum, VpTypeNum] VpTypeNum
             (Compound ["salesA", "salesB"]
              (eCall "bonus1" [eCall "grossProfit" [eSymbol "salesA",
                                                    eSymbol "salesB"]]))

-- | foo a b = 2 * a + b
foo :: Function
foo = Function (Just "foo") [VpTypeNum, VpTypeNum] VpTypeNum
      (Compound ["a", "b"]
       (eCall "+" [eCall "*" [eInt 2, eSymbol "a"],
               eSymbol "b"])
      )

-- | An expression representing a call to foo
eFoo :: Expr -> Expr -> Expr
eFoo e1 e2 = eCall "foo" [e1, e2]

-- | max x y = if x > y then x else y
max :: Function
max = let ex = eSymbol "x"
          ey = eSymbol "y"
       in Function (Just "max") [VpTypeNum, VpTypeNum] VpTypeNum
          (Compound ["x", "y"] (eIf (eGt ex ey) ex ey))

-- | An expression representing a call to max
eMax :: Expr -> Expr -> Expr
eMax e1 e2 = eCall "max" [e1, e2]

-- | fact n = if n == 0 then 1 else n * (fact (n - 1))
fact :: Function
fact = let en = eSymbol "n" in
        Function (Just "fact") [VpTypeNum] VpTypeNum
                 (Compound ["n"] 
                  (eIf (eZerop en) 
                   (eInt 1)
                   (eTimes en (eFact (eSub1 en)))))

-- | An expression representing a call to fact
eFact :: Expr -> Expr
eFact e1 = eCall "fact" [e1]

-- | sum of the integers 0..n
-- Lewis and Loftus, Jave Software Solutions, 6th. ed. (they call it "sum")
sumFromZero :: Function
sumFromZero = let en = eSymbol "n" in
              Function (Just "sumFromZero") [VpTypeNum] VpTypeNum
                       (Compound ["n"]
                        (eIf (eZerop en)
                         (eInt 0)
                         (ePlus en (eSumFromZero (eSub1 en)))))

buggySumFromZero :: Function
buggySumFromZero = 
    let body = ePlus (eSym "n")
                     (eCall "buggySumFromZero"
                            [eMinus (eSym "n") (eInt 1)])
    in Function (Just "buggySumFromZero") [VpTypeNum] VpTypeNum 
           (Compound ["n"] body)

eFib1 :: Expr -> Expr
eFib1 en = eCall "fib1" [en]

fib1 :: Function
fib1 = let en = eSymbol "n"
           one = eInt 1
           two = eInt 2
       in Function (Just "fib1") [VpTypeNum] VpTypeNum
          (Compound ["n"]
           (eIf (eEq en one)
            one
            (eIf (eEq en two)
             one
             (ePlus (eFib1 (eMinus en two))
              (eFib1 (eMinus en one))))))

-- implying that there should be fib2 ...

eSumFromZero :: Expr -> Expr
eSumFromZero en = eCall "sumFromZero" [en]

-- | rmul: multiplication by repeated addition.
-- The "multiply" function in Hanly and Koffman,
-- "Problem Solving and Program Design in C", 5th ed.

rmul :: Function
rmul = let em = eSymbol "m"
           en = eSymbol "n"
        in Function (Just "rmul") [VpTypeNum, VpTypeNum] VpTypeNum
           (Compound ["m", "n"]
            (eIf (eZerop en)
             (eInt 0)
             (ePlus em (eRmul em (eSub1 en)))))

-- | An expression representing a call to rmul
eRmul :: Expr -> Expr -> Expr
eRmul em en = eCall "rmul" [em, en]

eGcd :: Expr -> Expr -> Expr
eGcd em en = eCall "gcd" [em, en]

gcd :: Function
gcd = let em = eSymbol "m"
          en = eSymbol "n"
      in Function (Just "gcd") [VpTypeNum, VpTypeNum] VpTypeNum
         (Compound ["m", "n"]
          (eIf (eZerop (eMod em en))
           en
           (eGcd en (eMod em en))))


-- | Even and odd, the slow way.
-- Springer and Friedman, Scheme and the Art of Programming (??).
-- Rubio-Sanchez, Urquiza-Fuentes, and Pareja-Flores,
-- "A Gentle Introduction to Mutual Recursion",
-- in ITiCSE 2008: The 13th SIGCSE Conference on Innovation and
-- Technology in Computer Science Education, 2008.

eEvenp, eOddp :: Expr -> Expr
eEvenp en = eCall "even?" [en]
eOddp en = eCall "odd?" [en]

evenp, oddp :: Function

evenp = let en = eSymbol "n"
        in Function (Just "even?") [VpTypeNum] VpTypeBool
           (Compound ["n"]
            (eIf (eZerop en)
             eTrue
             (eOddp (eSub1 en))))

oddp = let en = eSymbol "n"
       in Function (Just "odd?") [VpTypeNum] VpTypeBool
          (Compound ["n"]
           (eIf (eZerop en)
            eFalse
            (eEvenp (eSub1 en))))

-- | Fibonacci series through mutual recursion.
-- Rubio-Sanchez, Urquiza-Fuentes, and Pareja-Flores, "Gentle Introduction"

eRabbitBabies, eRabbitAdults :: Expr -> Expr
eRabbitBabies en = eCall "rabbitBabies" [en]
eRabbitAdults en = eCall "rabbitAdults" [en]

rabbitTotal, rabbitAdults, rabbitBabies :: Function

rabbitTotal = let m = eSymbol "month"
              in Function (Just "rabbitTotal") [VpTypeNum] VpTypeNum
                 (Compound ["month"]
                  (ePlus (eRabbitBabies m) (eRabbitAdults m)))

rabbitAdults = let m = eSymbol "month"
                   zero = eInt 0
                   one = eInt 1
               in Function (Just "rabbitAdults") [VpTypeNum] VpTypeNum 
                  (Compound ["month"]
                   (eIf (eEq m one)
                    zero
                    (ePlus
                     (eRabbitAdults (eSub1 m)) -- all adults survive
                     (eRabbitBabies (eSub1 m))))) -- all babies grow up

rabbitBabies = let m = eSymbol "month" 
                   one = eInt 1
               in Function (Just "rabbitBabies") [VpTypeNum] VpTypeNum 
                  (Compound ["month"]
                   (eIf (eEq m one)
                    one
                    (eRabbitAdults (eSub1 m)))) -- all adults reproduce
                   
buggyLength :: Function
buggyLength = let xs = eSymbol "xs"
                  one = eInt 1
             in Function (Just "buggyLength") 
                    [VpTypeList (VpTypeVar "e1")] VpTypeNum
                    (Compound ["xs"]
                     (eIf (eCall "null" [xs])
                      one       -- base case off by one, should be zero
                      (ePlus one 
                       (eCall "buggyLength"
                        [eCall "tail" [xs]]))))

listLength :: Function
listLength = let xs = eSymbol "xs"
                 one = eInt 1
                 zero = eInt 0
             in Function (Just "length") 
                    [VpTypeList (VpTypeVar "e1")] VpTypeNum
                    (Compound ["xs"]
                     (eIf (eCall "null" [xs])
                      zero
                      (ePlus one 
                       (eCall "length"
                        [eCall "tail" [xs]]))))

listSum :: Function
listSum = 
    Function (Just "sum") [VpTypeList VpTypeNum] VpTypeNum 
                 (Compound ["xs"] sumbody)

sumbody :: Expr
sumbody = 
    eIf (eCall "null" [eSym "xs"])
        (eInt 0)
        (ePlus (eCall "head" [eSym "xs"])
               (eCall "sum" [eCall "tail" [eSym "xs"]]))

buggySum :: Function
buggySum = let xs = eSymbol "xs"
           in Function (Just "buggySum")
              [VpTypeList VpTypeNum] VpTypeNum
              (Compound ["xs"]
               -- missing "if" and base case
               (ePlus (eCall "head" [xs])
                (eCall "buggySum" [eCall "tail" [xs]])))

exampleFunctions :: [Function]
exampleFunctions = [grossProfit, bonus1, bonus2
                   , foo, Sifflet.Examples.max
                   , fact, sumFromZero, rmul, fib1
                   , Sifflet.Examples.gcd, evenp, oddp
                   , rabbitBabies, rabbitAdults, rabbitTotal
                   , buggyLength, listLength, listSum, buggySum
                   , buggySumFromZero]

exampleFunctionNames :: [String]
exampleFunctionNames = map functionName exampleFunctions

exampleEnv :: Env
exampleEnv = 
    envInsertL baseEnv exampleFunctionNames (map VFun exampleFunctions)

-- | This function will be in error if the function name is not
-- found in exampleEnv.
getExampleFunction :: String -> Function
getExampleFunction = envGetFunction exampleEnv