-- This file is supposed to be used with Version 0.8.4 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 -fth #-}
module LibTH(module LibTH, module MagicHaskeller) where

import MagicHaskeller
import System.Random(mkStdGen)

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

-- Specialized memoization tables. Choose one for quicker results.
myall, mall, mlist, mnat, mlistnat, mnat_nc  :: ProgramGenerator pg => pg
mall  = mkPG (list ++ nat ++ mb ++ bool ++ $(p [| (hd :: (->) [a] (Maybe a), (+) :: Int -> Int -> Int) |]))
mlist = mkPG list
mnat  = mkPG (nat ++ $(p [| (+) :: Int -> Int -> Int |]))
mlistnat = mkPG (list ++ nat ++ $(p [| (+) :: Int -> Int -> Int |]))
myall = mkPG (list ++ nat ++ mb ++ bool ++ $(p [| ( (==) :: Int -> Int -> Bool, (<=) :: Int -> Int -> Bool, insert :: Int -> [Int] -> [Int], hd :: (->) [a] (Maybe a), (+) :: Int -> Int -> Int) |]))
mnat_nc = mkMemo (nat ++ $(p [| (+) :: Int -> Int -> Int |]))

insert :: Int -> [Int] -> [Int]
insert a [] = [a]
insert a (x:xs)
	| a <= x = (a:x:xs)
	| otherwise = x:(insert a xs) 

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

-- Prefixed (->) means the parameter can be matched as an assumption. 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.

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)) |] )

-- Nat paramorphism
nat_para :: Int -> a -> (Int -> 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], 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,
                   (>)  :: 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]) |] )