-- 
-- (c) Susumu Katayama 2009
--
-- This file is supposed to be used with Version 0.8.5 of MagicHaskeller.
-- For previous versions, try:
-- darcs get http://nautilus.cs.miyazaki-u.ac.jp/~skata/ somedirectoryname
-- and retrieve an older version via some darcs command.
{-# OPTIONS -XTemplateHaskell -XNoMonomorphismRestriction -fglasgow-exts #-}
module MagicHaskeller.LibTH(module MagicHaskeller.LibTH, module MagicHaskeller) where

import MagicHaskeller
import System.Random(mkStdGen)

initialize, init075 :: IO ()
initialize = do setPrimitives (list ++ nat ++ natural ++ mb ++ bool ++ $(p [| (hd :: (->) [a] (Maybe a), (+) :: Int -> Int -> Int, (+) :: Integer -> Integer -> Integer) |]))
                setDepth 10
-- MagicHaskeller version 0.8 ignores the setDepth value and always memoizes.

init075 = do setPG $ mkMemo075 (list ++ nat ++ natural ++ mb ++ bool ++ $(p [| ((+) :: Int -> Int -> Int, (+) :: Integer -> Integer -> Integer) |] ))
             setDepth 10

-- Specialized memoization tables. Choose one for quicker results.
mall, mlist, mlist', mnat, mlistnat, mnat_nc  :: ProgramGenerator pg => pg
mall  = mkPG (list ++ nat ++ natural ++ mb ++ bool ++ $(p [| (hd :: (->) [a] (Maybe a), (+) :: Int -> Int -> Int, (+) :: Integer -> Integer -> Integer) |]))
mlist = mkPG list
mlist' = mkPG list'
mnat  = mkPG (nat ++ $(p [| (+) :: Int -> Int -> Int |]))
mnatural  = mkPG (natural ++ $(p [| (+) :: Integer -> Integer -> Integer |]))
mlistnat = mkPG (list ++ nat ++ $(p [| (+) :: Int -> Int -> Int |]))
mlistnatural = mkPG (list ++ natural ++ $(p [| (+) :: Integer -> Integer -> Integer |]))

mnat_nc = mkMemo (nat ++ $(p [| (+) :: Int -> Int -> Int |]))

hd :: [a] -> Maybe a
hd []    = Nothing
hd (x:_) = Just x

-- Prefixed (->) means that the parameter can be matched as an assumption when 'constrL' option is True. Also, this info is used when 'guess' option is True. For example of maybe :: a -> (b->a) -> (->) (Maybe b) a, 
--   Gamma |- A   Gamma,B |- A
--  ---------------------------maybe
--   Gamma, Maybe B |- A
-- rather than
--   Gamma |- A   Gamma,B |- A   Gamma |- Maybe B
--  -----------------------------------------------maybe
--   Gamma |- A
-- This is just for the efficiency reason, and one can use the infixed form, i.e., maybe :: a -> (b->a) -> Maybe b -> a, if efficiency does not matter. In fact, this info is ignored if both 'guess' and 'constrL' options are False.

mb, nat, natural, list', list, bool, boolean, eq, intinst, list1, list2, list3, nats, rich, rich', debug :: [Primitive]
mb = $(p [| ( Nothing :: Maybe a, Just :: a -> Maybe a, maybe :: a -> (b->a) -> (->) (Maybe b) a ) |] )

nat = $(p [| (0 :: Int, succ :: Int->Int, nat_para :: (->) Int (a -> (Int -> a -> a) -> a)) |] )
natural = $(p [| (0 :: Integer, succ :: Integer->Integer, nat_para :: (->) Integer (a -> (Integer -> a -> a) -> a)) |] )

-- Nat paramorphism
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i) -- Version 0.8 does not deal with partial functions very well.
    where np 0 = x
          np i = let i' = i-1
                 in f i' (np i')

list' = $(p [| ([] :: [a], (:) :: a -> [a] -> [a], foldr :: (b -> a -> a) -> a -> (->) [b] a) |] )
list  = $(p [| ([] :: [a], (:) :: a -> [a] -> [a], list_para :: (->) [b] (a -> (b -> [b] -> a -> a) -> a)) |] )

-- List paramorphism
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para []     x f = x
list_para (y:ys) x f = f y ys (list_para ys x f)

bool = $(p [| (True, False, iF :: (->) Bool (a -> a -> a)) |] )

iF :: Bool -> a -> a -> a
iF True  t f = t
iF False t f = f


boolean = $(p [| ((&&) :: Bool -> Bool -> Bool,
                  (||) :: Bool -> Bool -> Bool,
                  not  :: Bool -> Bool) |] )
-- Type classes are not supported yet....
eq = $(p [| ((==) :: Int->Int->Bool,   (/=) :: Int->Int->Bool,
             (==) :: Char->Char->Bool, (/=) :: Char->Char->Bool,
             (==) :: Bool->Bool->Bool, (/=) :: Bool->Bool->Bool,
             (==) :: [Int] ->[Int] ->Bool, (/=) :: [Int] ->[Int]->Bool,
             (==) :: [Char]->[Char]->Bool, (/=) :: [Char]->[Char]->Bool,
             (==) :: [Bool]->[Bool]->Bool, (/=) :: [Bool]->[Bool]->Bool) |] )
-- ...bothered.
intinst = $(p [| ( (<=) :: Int->Int->Bool,
                   (<)  :: Int->Int->Bool,
                   (>=) :: Int->Int->Bool,
                   (>)  :: Int->Int->Bool,
                   max  :: Int->Int->Int,
                   min  :: Int->Int->Int,
                   (-)  :: Int->Int->Int,
                   (*)  :: Int->Int->Int,
                   div  :: Int->Int->Int,
                   mod  :: Int->Int->Int,
                   gcd  :: Int->Int->Int,
                   lcm  :: Int->Int->Int,
                   (^)  :: Int->Int->Int) |])

list1 = $(p [| (map       :: (a -> b) -> (->) [a] [b],
                (++)      :: [a] -> [a] -> [a],
                filter    :: (a -> Bool) -> [a] -> [a],
                concat    :: [[a]] -> [a],
                concatMap :: (a -> [b]) -> (->) [a] [b],
                length    :: (->) [a] Int,
                replicate :: Int -> a -> [a],
                take      :: Int -> [a] -> [a],
                drop      :: Int -> [a] -> [a],
                takeWhile :: (a -> Bool) -> [a] -> [a],
                dropWhile :: (a -> Bool) -> [a] -> [a]) |] )
list2 = $(p [| (
                lines            :: [Char] -> [[Char]],
                words            :: [Char] -> [[Char]],
                unlines            :: [[Char]] -> [Char],
                unwords            :: [[Char]] -> [Char] ) |] )

list3 = $(p [| (reverse :: [a] -> [a],
                and         :: [Bool] -> Bool,
                or          :: [Bool] -> Bool,
                any         :: (a -> Bool) -> (->) [a] Bool,
                all         :: (a -> Bool) -> (->) [a] Bool,
                zipWith          :: (a->b->c) -> (->) [a] ((->) [b] [c]) ) |] )

nats = $(p [| (1 ::Int, 2 :: Int, 3 :: Int) |])

reallyall :: ProgramGenerator pg => pg
reallyall = mkPG rich

nrnds = repeat 5


-- comment out (mkStdGen 123456) when using 0.8.3*


-- Currently only the pg==ConstrLSF case makes sense.
mix, poormix :: ProgramGenerator pg => pg
mix = mkPGSF (mkStdGen 123456)
              nrnds
              (list++bool)
              rich

rich =        (list ++ bool ++
                    -- nat ++
                        -- mb ++ bool ++ $(p [| (hd :: [a] -> Maybe a, (+) :: Int -> Int -> Int) |]) ++
                    boolean ++ eq ++ -- intinst ++
                    list1 ++ list2 ++ list3)


poormix = mkPGSF (mkStdGen 123456)
              nrnds
              $(p [| ([] :: [a], True) |] )
              rich

-- just for debugging
ra :: ProgramGenerator pg => pg
ra = mkPG rich'
rich' =      (list++bool++boolean++
                    list1 ++ list3)

mx :: ProgramGenerator pg => pg
mx = mkPGSF (mkStdGen 123456)
             nrnds
             (list++bool)
             rich'

debug = $(p [| (list_para :: (->) [b] (a -> (b -> [b] -> a -> a) -> a), concatMap :: (a -> [b]) -> (->) [a] [b]) |] )

