-- Copyright (c) 2009, ERICSSON AB
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--
--     * Redistributions of source code must retain the above copyright notice,
--       this list of conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in the
--       documentation and/or other materials provided with the distribution.
--     * Neither the name of the ERICSSON AB nor the names of its contributors
--       may be used to endorse or promote products derived from this software
--       without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

-- | Primitive and helper functions supported by Feldspar

module Feldspar.Core.Functions where



import qualified Prelude

import Feldspar.Prelude
import Feldspar.Core.Types
import Feldspar.Core.Expr



infix 4 ==
infix 4 /=
infix 4 <
infix 4 >
infix 4 <=
infix 4 >=
infix 1 ?



(==) :: Storable a => Data a -> Data a -> Data Bool
(==) = functionFold2 "(==)" (Prelude.==)

(/=) :: Storable a => Data a -> Data a -> Data Bool
(/=) = functionFold2 "(/=)" (Prelude./=)

(<) :: Storable a => Data a -> Data a -> Data Bool
(<) = functionFold2 "(<)" (Prelude.<)

(>) :: Storable a => Data a -> Data a -> Data Bool
(>) = functionFold2 "(>)" (Prelude.>)

(<=) :: Storable a => Data a -> Data a -> Data Bool
(<=) = functionFold2 "(<=)" (Prelude.<=)

(>=) :: Storable a => Data a -> Data a -> Data Bool
(>=) = functionFold2 "(>=)" (Prelude.>=)

not :: Data Bool -> Data Bool
not = functionFold "not" Prelude.not

-- | Selects the elements of the pair depending on the condition
(?) :: Computable a => Data Bool -> (a,a) -> a
cond ? (a,b) = ifThenElse cond (const a) (const b) unit

(&&) :: Data Bool -> Data Bool -> Data Bool
(&&) = functionFold2 "(&&)" (Prelude.&&)

(||) :: Data Bool -> Data Bool -> Data Bool
(||) = functionFold2 "(||)" (Prelude.||)

-- | Lazy conjunction, second argument only run if necessary
(&&*) :: Computable a =>
    (a -> Data Bool) -> (a -> Data Bool) -> (a -> Data Bool)
(f &&* g) a = let fa = f a in ifThenElse fa g (const false) a

-- | Lazy disjunction, second argument only run if necessary
(||*) :: Computable a =>
    (a -> Data Bool) -> (a -> Data Bool) -> (a -> Data Bool)
(f ||* g) a = let fa = f a in ifThenElse fa (const true) g a

min :: Storable a => Data a -> Data a -> Data a
min a b = a<=b ? (a,b)

max :: Storable a => Data a -> Data a -> Data a
max a b = a>=b ? (a,b)

div :: Data Int -> Data Int -> Data Int
div = functionFold2 "div" (Prelude.div)

mod :: Data Int -> Data Int -> Data Int
mod = functionFold2 "mod" (Prelude.mod)

(^) :: Data Int -> Data Int -> Data Int
(^) = functionFold2 "(^)" (Prelude.^)

-- | @for start end init body@:
--
-- A for-loop ranging over @[start .. end]@. @init@ is the starting state. The
-- @body@ computes the next state given the current state and the current loop
-- index.
for :: Computable a => Data Int -> Data Int -> a -> (Data Int -> a -> a) -> a
for start end init body = snd $ while cont body' (start,init)
  where
    cont  (i,s) = i <= end
    body' (i,s) = (i+1, body i s)