-- 
-- (c) Susumu Katayama
--
{-# OPTIONS -XTemplateHaskell -XNoMonomorphismRestriction -cpp -XRankNTypes #-}
module MagicHaskeller.LibTH(module MagicHaskeller.LibTH, module MagicHaskeller) where

import MagicHaskeller
import MagicHaskeller.Types(size)
#ifdef TFRANDOM
import System.Random.TF(seedTFGen)
#else
import System.Random(mkStdGen)
#endif
import Control.Monad(liftM2)
import Data.List hiding (tail)
import Data.Char
import Data.Maybe
-- import Data.Ratio
import MagicHaskeller.FastRatio
import qualified Data.Generics as G

import MagicHaskeller.ProgGenSF(mkTrieOptSFIO)

import qualified Data.IntMap as IM
import Data.Hashable

import Prelude hiding (tail, gcd, enumFromThenTo)

-- whether succ is used only for numbers or not
succOnlyForNumbers :: Bool
succOnlyForNumbers = Bool
False -- This is False, because we now use succ :: Char->Char.

-- total variants of prelude functions
last' :: a -> [a] -> a
last' = (\a
x [a]
xs -> [a] -> a
forall a. [a] -> a
last (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs))
tail :: [a] -> [a]
tail = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1
-- init xs = zipWith const xs (drop 1 xs)
-- gcd in the latest library is total, but with older versions gcd 0 0 causes an error. 
gcd :: t -> t -> t
gcd t
x t
y =  t -> t -> t
forall t. Integral t => t -> t -> t
gcd' (t -> t
forall a. Num a => a -> a
abs t
x) (t -> t
forall a. Num a => a -> a
abs t
y)
  where gcd' :: t -> t -> t
gcd' t
a t
0  =  t
a
        gcd' t
a t
b  =  t -> t -> t
gcd' t
b (t
a t -> t -> t
forall t. Integral t => t -> t -> t
`rem` t
b)

-- This definition does not work correctly for Fractional numbers.
-- Maybe @[l,m..n]@ could be used for other cases than 'EQ' even if the original enumFromThenTo is hidden. YMMV, though.
enumFromThenTo :: a -> a -> a -> [b]
enumFromThenTo a
l a
m a
n = (Int -> b) -> [Int] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Int -> b
forall a. Enum a => Int -> a
toEnum ([Int] -> [b]) -> [Int] -> [b]
forall a b. (a -> b) -> a -> b
$
                       case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
lint Int
mint of 
                         Ordering
EQ -> [Char] -> [Int]
forall a. HasCallStack => [Char] -> a
error [Char]
"MagicHaskeller.LibTH.enumFromThenTo m m n"
                         Ordering
LT -> (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
nint) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
mintInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lint)) Int
lint
                         Ordering
GT -> (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
nint) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
mintInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lint)) Int
lint
  where lint :: Int
lint = a -> Int
forall a. Enum a => a -> Int
fromEnum a
l
        mint :: Int
mint = a -> Int
forall a. Enum a => a -> Int
fromEnum a
m
        nint :: Int
nint = a -> Int
forall a. Enum a => a -> Int
fromEnum a
n
initialize, init075, inittv1 :: IO ()
initialize :: IO ()
initialize = do [Primitive] -> [Primitive] -> IO ()
setPrimitives [] ([Primitive]
list [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
nat [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
natural [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
mb [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
bool [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ $(p [| hd :: (->) [a] (Maybe a) |]) [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
plusInt [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
plusInteger)
                Int -> IO ()
setDepth Int
10
-- MagicHaskeller version 0.8 ignores the setDepth value and always memoizes.

init075 :: IO ()
init075 = do ProgGen -> IO ()
setPG (ProgGen -> IO ()) -> ProgGen -> IO ()
forall a b. (a -> b) -> a -> b
$ [Primitive] -> [Primitive] -> ProgGen
forall pg. ProgramGenerator pg => [Primitive] -> [Primitive] -> pg
mkMemo075 [] ([Primitive]
list [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
nat [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
natural [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
mb [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
bool [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
plusInt [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
plusInteger)
             Int -> IO ()
setDepth Int
10

-- The @tv1@ option prevents type variable @a@ in @forall a. E1(a) -> E2(a) -> ... -> En(a) -> a@ from matching n-ary functions where n>=2.
-- This can safely be used if @(,)@ and @uncurry@ are in the primitive set,
-- because @forall a b c. E1(a->b->c) -> E2(a->b->c) -> ... -> En(a->b->c) -> a -> b -> c@ and @forall a b c. E1((a,b)->c) -> E2((a,b)->c) -> ... -> En((a,b)->c) -> (a,b) -> c@ are isomorphic, and thus the latter can always be used instead of the former.

inittv1 :: IO ()
inittv1 = do ProgGen -> IO ()
setPG (ProgGen -> IO ()) -> ProgGen -> IO ()
forall a b. (a -> b) -> a -> b
$ Options -> [Primitive] -> [Primitive] -> ProgGen
forall pg.
ProgramGenerator pg =>
Options -> [Primitive] -> [Primitive] -> pg
mkPGOpt (Opt Any
forall a. Opt a
options{primopt :: Maybe [[Primitive]]
primopt = Maybe [[Primitive]]
forall a. Maybe a
Nothing, tv1 :: Bool
tv1 = Bool
True})
                             []
                             ([Primitive]
list [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
nat [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
natural [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
mb [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
bool [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
tuple [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ $(p [| (hd :: (->) [a] (Maybe a)) |]) [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
plusInt [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
plusInteger )
             Int -> IO ()
setDepth Int
10

tuple :: [Primitive]
tuple = $(p [| ((,) :: a -> b -> (a,b), uncurry :: (a->b->c) -> (->) (a,b) c) |])
tuple' :: [Primitive]
tuple' = $(p [| ((,) :: a -> b -> (a,b), flip uncurry :: (->) (a,b) ((a->b->c) -> c)) |])

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

mnat_nc :: pg
mnat_nc = [Primitive] -> pg
forall pg. ProgramGenerator pg => [Primitive] -> pg
mkMemo ([Primitive]
nat [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
plusInt)

hd :: [a] -> Maybe a
hd :: [a] -> Maybe a
hd []    = Maybe a
forall a. Maybe a
Nothing
hd (a
x:[a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
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, mb', nat, natural, nat', nat'woPred, natural', plusInt, plusInteger, list'', list', list, bool, boolean, intinst, list1, list1', list2, list3, list3', nats, tuple, tuple', rich, rich', debug :: [Primitive]
mb :: [Primitive]
mb = $(p [| ( Nothing :: Maybe a, Just :: a -> Maybe a, maybe :: a -> (b->a) -> (->) (Maybe b) a ) |] )
mb' :: [Primitive]
mb' = $(p [| ( Nothing :: Maybe a, Just :: a -> Maybe a, flip . maybe :: a -> (->) (Maybe b) ((b->a) -> a) ) |] )

nat :: [Primitive]
nat = $(p [| (0 :: Int, (1+) :: Int->Int, nat_para :: (->) Int (a -> (Int -> a -> a) -> a)) |] )
natural :: [Primitive]
natural = $(p [| (0 :: Integer, (1+) :: Integer->Integer, nat_para :: (->) Integer (a -> (Integer -> a -> a) -> a)) |] )
nat' :: [Primitive]
nat' = $(p [| (0 :: Int, (1+) :: Int->Int, nat_cata :: (->) Int (a -> (a -> a) -> a), pred :: Int->Int) |] )
nat'woPred :: [Primitive]
nat'woPred = $(p [| (0 :: Int, (1+) :: Int->Int, nat_cata :: (->) Int (a -> (a -> a) -> a)) |] )
natural' :: [Primitive]
natural' = $(p [| (0 :: Integer, (1+) :: Integer->Integer, nat_cata :: (->) Integer (a -> (a -> a) -> a), pred :: Integer->Integer) |] )
plusInt :: [Primitive]
plusInt = $(p [| (+) :: (->) Int ((->) Int Int) |])
plusInteger :: [Primitive]
plusInteger = $(p [| (+) :: (->) Integer ((->) Integer Integer) |])

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

-- Nat paramorphism.  nat_cata i x f == iterate f x `genericIndex` abs i holds, but the following implementation is much more efficient (and thus safer).
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata :: i -> a -> (a -> a) -> a
nat_cata i
i a
x a -> a
f = i -> a
forall t. (Eq t, Num t) => t -> a
nc (i -> i
forall a. Num a => a -> a
abs i
i) -- Version 0.8 does not deal with partial functions very well.
    where nc :: t -> a
nc t
0 = a
x
          nc t
i = a -> a
f (t -> a
nc (t
it -> t -> t
forall a. Num a => a -> a -> a
-t
1))

list'' :: [Primitive]
list'' = $(p [| ([] :: [a], (:), flip . flip foldr :: a -> (->) [b] ((b -> a -> a) -> a), tail :: (->) [a] [a]) |] ) -- foldr's argument order makes the synthesis slower:)
list' :: [Primitive]
list' = $(p [| ([] :: [a], (:), foldr :: (b -> a -> a) -> a -> (->) [b] a, tail :: (->) [a] [a]) |] ) -- foldr's argument order makes the synthesis slower:)
list :: [Primitive]
list  = $(p [| ([] :: [a], (:), list_para :: (->) [b] (a -> (b -> [b] -> a -> a) -> a)) |] )

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

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

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

-- | 'postprocess' replaces uncommon functions like catamorphisms with well-known functions.
postprocess :: Exp -> Exp
postprocess :: Exp -> Exp
postprocess (AppE (AppE (AppE (InfixE (Just Exp
e1) (VarE Name
name) (Just Exp
e2)) Exp
e3) Exp
e4) Exp
e5) | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"." = Exp -> Exp
postprocess (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ ((Exp
e1 Exp -> Exp -> Exp
`AppE` (Exp
e2 Exp -> Exp -> Exp
`AppE` Exp
e3)) Exp -> Exp -> Exp
`AppE` Exp
e4) Exp -> Exp -> Exp
`AppE` Exp
e5   -- ad hoc pattern:S
postprocess (AppE (AppE (AppE (AppE (ConE Name
name) Exp
e1) Exp
e2) Exp
e3) Exp
e4) | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"(,,,)" = Exp -> Exp
postprocess (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
tup [Exp
e1, Exp
e2, Exp
e3, Exp
e4]
postprocess (AppE (AppE (AppE (AppE (VarE Name
name) Exp
e1) Exp
e2) Exp
e3) Exp
e4) | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"flip"  = Exp -> Exp
postprocess (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ ((Exp
e1 Exp -> Exp -> Exp
`AppE` Exp
e3) Exp -> Exp -> Exp
`AppE` Exp
e2) Exp -> Exp -> Exp
`AppE` Exp
e4
postprocess (AppE (InfixE (Just Exp
e1) (VarE Name
name) (Just Exp
e2)) Exp
e3) | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"." = Exp -> Exp
postprocess (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Exp
e1 Exp -> Exp -> Exp
`AppE` (Exp
e2 Exp -> Exp -> Exp
`AppE` Exp
e3)
postprocess (AppE (e :: Exp
e@(AppE (AppE (ConE Name
name) Exp
p) Exp
t)) Exp
f) | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"(,,)" = Exp -> Exp
postprocess (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
tup [Exp
p,Exp
t,Exp
f]
postprocess (AppE (e :: Exp
e@(AppE (AppE (VarE Name
name) Exp
p) Exp
t)) Exp
f)
    = case Name -> [Char]
nameBase Name
name of
        [Char]
"iF"       -> Exp -> Exp -> Exp -> Exp
CondE Exp
ppp Exp
ppt Exp
ppf
        [Char]
"enumFromThenTo" -> Range -> Exp
ArithSeqE (Range -> Exp) -> Range -> Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp -> Range
FromThenToR Exp
ppp Exp
ppt Exp
ppf
        [Char]
"nat_cata" -> Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ (Name -> Exp
VarE ([Char] -> Name
mkName [Char]
"iterate") Exp -> Exp -> Exp
`AppE` Exp
ppf) Exp -> Exp -> Exp
`AppE` Exp
ppt)
                             (Name -> Exp
VarE ([Char] -> Name
mkName [Char]
"!!"))     -- Should I use genericIndex instead of (!!) also here?
                             (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ case Exp
ppp of LitE (IntegerL Integer
i)  -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs Integer
i
                                                 Exp
_                 -> Name -> Exp
VarE ([Char] -> Name
mkName [Char]
"abs") Exp -> Exp -> Exp
`AppE` Exp
ppp)
        [Char]
"flip"     -> Exp -> Exp
postprocess (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ (Exp
ppp Exp -> Exp -> Exp
`AppE` Exp
ppf) Exp -> Exp -> Exp
`AppE` Exp
ppt
        [Char]
"."        -> Exp -> Exp
postprocess (Exp
p Exp -> Exp -> Exp
`AppE` (Exp
t Exp -> Exp -> Exp
`AppE` Exp
f))
        [Char]
_          -> Exp -> Exp
postprocess Exp
e Exp -> Exp -> Exp
`AppE` Exp
ppf
  where ppp :: Exp
ppp = Exp -> Exp
postprocess Exp
p
        ppt :: Exp
ppt = Exp -> Exp
postprocess Exp
t
        ppf :: Exp
ppf = Exp -> Exp
postprocess Exp
f
postprocess (AppE f :: Exp
f@(AppE (ConE Name
name) Exp
lj) Exp
e) | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"(,)" = Exp -> Exp
postprocess (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
tup [Exp
lj, Exp
e]
postprocess (AppE f :: Exp
f@(AppE (VarE Name
name) Exp
lj) Exp
e)
    = case Name -> [Char]
nameBase Name
name of [Char]
"drop" -> case Exp
pplj of LitE (IntegerL Integer
j) | Integer
jInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<=Integer
0 -> Exp
ppe
                                                                     | Integer
jInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 -> Integer -> Exp -> Exp
ppdrop Integer
j Exp
e
                                                   Exp
_                 -> (Exp
dropE Exp -> Exp -> Exp
`AppE` Exp
pplj) Exp -> Exp -> Exp
`AppE` Exp
ppe
                            [Char]
"enumFromTo" -> Range -> Exp
ArithSeqE (Range -> Exp) -> Range -> Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Range
FromToR Exp
pplj Exp
ppe
                            [Char]
"last'" -> case Exp
ppe of AppE (VarE Name
rev) Exp
e' | Name -> [Char]
nameBase Name
rev [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"reverse" -> ((Name -> Exp
VarE ([Char] -> Name
mkName [Char]
"foldr") Exp -> Exp -> Exp
`AppE` Exp
constE) Exp -> Exp -> Exp
`AppE` Exp
pplj) Exp -> Exp -> Exp
`AppE` Exp
e'   -- last (x : reverse xs) ==> foldr const x xs
                                                   Exp
_ -> Name -> Exp
VarE ([Char] -> Name
mkName [Char]
"last") Exp -> Exp -> Exp
`AppE` Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
pplj) (Name -> Exp
ConE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
":") (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
ppe)
                            [Char]
"filter" -> case Exp
ppe of AppE (VarE Name
rev) Exp
e' | Name -> [Char]
nameBase Name
rev [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"reverse" -> Exp
reverseE Exp -> Exp -> Exp
`AppE` ((Name -> Exp
VarE ([Char] -> Name
mkName [Char]
"filter") Exp -> Exp -> Exp
`AppE` Exp
pplj) Exp -> Exp -> Exp
`AppE` Exp
e')   -- filter p (reverse xs) ==> reverse (filter p xs)  This is useful in the case of (reverse . drop 1 . reverse) (filter p ((reverse . drop 1 . reverse) xs)). Also, there can be a case of last' x (filter p ((reverse . drop 1 . reverse) xs))
                                                    Exp
_ -> (Name -> Exp
VarE ([Char] -> Name
mkName [Char]
"filter") Exp -> Exp -> Exp
`AppE` Exp
pplj) Exp -> Exp -> Exp
`AppE` Exp
ppe
                            [Char]
_            -> Exp -> Exp
postprocess Exp
f Exp -> Exp -> Exp
`AppE` Exp
ppe
  where pplj :: Exp
pplj = Exp -> Exp
postprocess Exp
lj 
        ppe :: Exp
ppe  = Exp -> Exp
postprocess Exp
e
postprocess (AppE (InfixE m :: Maybe Exp
m@(Just Exp
_) Exp
op Maybe Exp
Nothing)    Exp
e) = Exp -> Exp
postprocess (Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE Maybe Exp
m        Exp
op (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
e))
postprocess (AppE (InfixE Maybe Exp
Nothing    Exp
op m :: Maybe Exp
m@(Just Exp
_)) Exp
e) = Exp -> Exp
postprocess (Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
e) Exp
op Maybe Exp
m)
postprocess (AppE v :: Exp
v@(VarE Name
name) Exp
e)
    = case Name -> [Char]
nameBase Name
name of
--        'b':'y':'1':'_':nm -> VarE $ mkName$ by1 nm
        [Char]
"tail"   -> Integer -> Exp -> Exp
ppdrop Integer
1 Exp
e
        [Char]
"negate" -> case Exp
ppe of LitE (IntegerL Integer
i)        -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ (-Integer
i)
                                LitE (RationalL Rational
r)       -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Rational -> Lit
RationalL (Rational -> Lit) -> Rational -> Lit
forall a b. (a -> b) -> a -> b
$ (-Rational
r)
                                Exp
_                        -> Exp -> Exp -> Exp
AppE Exp
v Exp
ppe
        [Char]
"abs"    -> case Exp
ppe of LitE (IntegerL Integer
i)        -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs Integer
i
                                LitE (RationalL Rational
r)       -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Rational -> Lit
RationalL (Rational -> Lit) -> Rational -> Lit
forall a b. (a -> b) -> a -> b
$ Rational -> Rational
forall a. Num a => a -> a
abs Rational
r
                                Exp
_                        -> Exp -> Exp -> Exp
AppE (Exp -> Exp
ppv Exp
v) Exp
ppe
        [Char]
"floor"  -> case Exp
ppe of LitE (IntegerL Integer
i)        -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
i
                                LitE (RationalL Rational
r)       -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Rational
r
                                Exp
_                        -> Exp -> Exp -> Exp
AppE Exp
v Exp
ppe
        [Char]
"round"  -> case Exp
ppe of LitE (IntegerL Integer
i)        -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
i
                                LitE (RationalL Rational
r)       -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Rational
r
                                Exp
_                        -> Exp -> Exp -> Exp
AppE Exp
v Exp
ppe
        [Char]
"ceiling" -> case Exp
ppe of LitE (IntegerL Integer
i)        -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
i
                                 LitE (RationalL Rational
r)       -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Rational
r
                                 Exp
_                        -> Exp -> Exp -> Exp
AppE Exp
v Exp
ppe
        [Char]
"fromIntegral" -> case Exp
ppe of LitE Lit
i      -> Lit -> Exp
LitE Lit
i
                                      Exp
_           -> Exp -> Exp -> Exp
AppE Exp
v Exp
ppe
        [Char]
"exponent"   -> case Exp
ppe of
                      LitE (IntegerL Integer
i)        -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a. RealFloat a => a -> Int
exponent (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i
                      LitE (RationalL Rational
r)       -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a. RealFloat a => a -> Int
exponent (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r
                      Exp
_                        -> Exp -> Exp -> Exp
AppE Exp
v Exp
ppe
        [Char]
"succ"   -> case Exp
ppe of
                      LitE (IntegerL Integer
i)        -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Enum a => a -> a
succ Integer
i
                      LitE (RationalL Rational
r)       -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Rational -> Lit
RationalL (Rational -> Lit) -> Rational -> Lit
forall a b. (a -> b) -> a -> b
$ Rational -> Rational
forall a. Enum a => a -> a
succ Rational
r
                      LitE (CharL Char
c)           -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Char -> Lit
CharL (Char -> Lit) -> Char -> Lit
forall a b. (a -> b) -> a -> b
$ Char -> Char
forall a. Enum a => a -> a
succ Char
c
                      InfixE (Just (LitE (IntegerL Integer
n))) (VarE Name
nm) (Just Exp
e)
                        | Name -> [Char]
nameBase Name
nm [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"+"    -> Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Enum a => a -> a
succ Integer
n) Exp
plusE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
e)
                      AppE (VarE Name
nm) Exp
e
                        | Bool
succOnlyForNumbers Bool -> Bool -> Bool
&&
                          Name -> [Char]
nameBase Name
nm [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"succ" -> Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
2) Exp
plusE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
e) -- This is OK, if we use succ only for numbers.
                      Exp
_                       -> Exp -> Exp -> Exp
AppE (Exp -> Exp
ppv Exp
v) Exp
ppe
        [Char]
"reverse" -> case Exp
ppe of
                       LitE (StringL [Char]
xs)        -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Lit
StringL ([Char] -> Lit) -> [Char] -> Lit
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
xs
                       ListE [Exp]
es                 -> [Exp] -> Exp
ListE ([Exp] -> Exp) -> [Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> [Exp]
forall a. [a] -> [a]
reverse ([Exp] -> [Exp]) -> [Exp] -> [Exp]
forall a b. (a -> b) -> a -> b
$ (Exp -> Exp) -> [Exp] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Exp
postprocess [Exp]
es
                       ArithSeqE (FromToR (LitE (IntegerL Integer
f)) (LitE (IntegerL Integer
t))) -> Range -> Exp
ArithSeqE (Range -> Exp) -> Range -> Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp -> Range
FromThenToR (Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
t) (Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Integer
tInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) (Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
f)
                       AppE (VarE Name
name) Exp
e' | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"reverse" -> Exp
e'
                       Exp
_         -> Exp -> Exp -> Exp
AppE Exp
reverseE Exp
ppe
        [Char]
"length" -> case Exp
ppe of
                       LitE (StringL [Char]
xs)        -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
xs
                       ListE [Exp]
es                -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [Exp] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Exp]
es
                       ArithSeqE (FromToR (LitE (IntegerL Integer
f)) (LitE (IntegerL Integer
t))) -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Integer
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
f Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 -- can be bottom, if t is less than f.
                       AppE (VarE Name
name) Exp
e' | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"reverse" -> Exp -> Exp -> Exp
AppE Exp
lengthE Exp
e' -- length . reverse => length
                       -- There can also be the length . map f => length rule. The length . map f pattern can appear when f includes some absent argument.
                       Exp
_         -> Exp -> Exp -> Exp
AppE Exp
lengthE Exp
ppe
        [Char]
"sum"    -> case Exp
ppe of
                       AppE (VarE Name
name) Exp
e' | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"reverse" -> Exp -> Exp -> Exp
AppE Exp
sumE Exp
e'
                       Exp
_         -> Exp -> Exp -> Exp
AppE Exp
sumE Exp
ppe
        [Char]
"product" -> case Exp
ppe of
                       AppE (VarE Name
name) Exp
e' | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"reverse" -> Exp -> Exp -> Exp
AppE Exp
productE Exp
e'
                       Exp
_         -> Exp -> Exp -> Exp
AppE Exp
productE Exp
ppe
        [Char]
nb       -> case Int -> IntMap (Exp -> Exp -> Exp) -> Maybe (Exp -> Exp -> Exp)
forall a. Int -> IntMap a -> Maybe a
IM.lookup ([Char] -> Int
forall a. Hashable a => a -> Int
hash [Char]
nb) IntMap (Exp -> Exp -> Exp)
byMap of Just Exp -> Exp -> Exp
fun -> Exp -> Exp -> Exp
fun Exp
ppe (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
AppE (Exp -> Exp
ppv Exp
v) Exp
ppe
                                                      Maybe (Exp -> Exp -> Exp)
Nothing  -> Exp -> Exp -> Exp
AppE (Exp -> Exp
ppv Exp
v) Exp
ppe
  where ppe :: Exp
ppe = Exp -> Exp
postprocess Exp
e 
-- The following pattern is actually unnecessary if only eta-long normal expressions will be generated.
postprocess e :: Exp
e@(VarE Name
_)          = Exp -> Exp
ppv Exp
e
postprocess (AppE Exp
f Exp
x)          = Exp -> Exp
postprocess Exp
f Exp -> Exp -> Exp
`AppE` Exp -> Exp
postprocess Exp
x
postprocess (InfixE Maybe Exp
me1 Exp
op Maybe Exp
me2) 
  = let j1 :: Maybe Exp
j1 = (Exp -> Exp) -> Maybe Exp -> Maybe Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> Exp
postprocess Maybe Exp
me1
        j2 :: Maybe Exp
j2 = (Exp -> Exp) -> Maybe Exp -> Maybe Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> Exp
postprocess Maybe Exp
me2
    in case Exp
op of 
          VarE Name
opname -> 
            case (Maybe Exp
j1,Maybe Exp
j2) of
                       (Just (LitE (IntegerL Integer
i1)), Just (LitE (IntegerL Integer
i2))) ->
                                        case Name -> [Char]
nameBase Name
opname of [Char]
"+" -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Integer
i1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
i2
                                                                [Char]
"-" -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Integer
i1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
i2
                                                                [Char]
"*" -> Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Integer
i1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
i2
                                                                [Char]
_   -> Exp
theDefault
                       (Just (LitE (IntegerL Integer
i1)), Just (InfixE (Just (LitE (IntegerL Integer
i2))) (VarE Name
inopn) Maybe Exp
me3))
                                    | Name -> [Char]
nameBase Name
opname [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"+" Bool -> Bool -> Bool
&& Name -> [Char]
nameBase Name
inopn [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"+",[Char]
"-"] -> Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Integer
i1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
i2) (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ Name -> Name
ppopn Name
inopn) Maybe Exp
me3
                       (Maybe Exp, Maybe Exp)
_ -> Exp
theDefault
                   where theDefault :: Exp
theDefault = Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE Maybe Exp
j1 (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ Name -> Name
ppopn Name
opname) Maybe Exp
j2
          ConE Name
opname -> Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE Maybe Exp
j1 (Name -> Exp
ConE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ Name -> Name
ppopn Name
opname) Maybe Exp
j2

postprocess (LamE [Pat]
pats Exp
e)       = [Pat] -> Exp -> Exp
ppLambda [Pat]
pats (Exp -> Exp
postprocess Exp
e)

postprocess (TupE [Maybe Exp]
es)           = [Exp] -> Exp
tup ((Maybe Exp -> Exp) -> [Maybe Exp] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Exp -> Exp
postprocess(Exp -> Exp) -> (Maybe Exp -> Exp) -> Maybe Exp -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Maybe Exp -> Exp
forall a. Maybe a -> a
unJust) [Maybe Exp]
es)
postprocess (ListE [Exp]
es)          = [Exp] -> Exp
ListE ((Exp -> Exp) -> [Exp] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Exp
postprocess [Exp]
es)
postprocess (SigE Exp
e Type
ty)         = Exp -> Exp
postprocess Exp
e Exp -> Type -> Exp
`SigE` Type
ty
postprocess Exp
e = Exp
e

byMap :: IntMap (Exp -> Exp -> Exp)
byMap = [(Int, Exp -> Exp -> Exp)] -> IntMap (Exp -> Exp -> Exp)
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, Exp -> Exp -> Exp)] -> IntMap (Exp -> Exp -> Exp))
-> [(Int, Exp -> Exp -> Exp)] -> IntMap (Exp -> Exp -> Exp)
forall a b. (a -> b) -> a -> b
$ [(Int, Exp -> Exp -> Exp)]
byEqs[(Int, Exp -> Exp -> Exp)]
-> [(Int, Exp -> Exp -> Exp)] -> [(Int, Exp -> Exp -> Exp)]
forall a. [a] -> [a] -> [a]
++[(Int, Exp -> Exp -> Exp)]
byOrds
byEqs :: [(Int, Exp -> Exp -> Exp)]
byEqs  = ([Char] -> Int
forall a. Hashable a => a -> Int
hash [Char]
"deleteFirstsBy", [Char] -> Exp -> Exp -> Exp
skipEq [Char]
"\\\\") (Int, Exp -> Exp -> Exp)
-> [(Int, Exp -> Exp -> Exp)] -> [(Int, Exp -> Exp -> Exp)]
forall a. a -> [a] -> [a]
: [ ([Char] -> Int
forall a. Hashable a => a -> Int
hash ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
xs[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"By", [Char] -> Exp -> Exp -> Exp
skipEq [Char]
xs) | [Char]
xs <- [[Char]
"nub",[Char]
"delete",[Char]
"union",[Char]
"intersect",[Char]
"group"]]
byOrds :: [(Int, Exp -> Exp -> Exp)]
byOrds = [ ([Char] -> Int
forall a. Hashable a => a -> Int
hash ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
xs[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"By", [Char] -> Exp -> Exp -> Exp
skipOrd [Char]
xs) | [Char]
xs <- [[Char]
"sort",[Char]
"insert",[Char]
"minimum",[Char]
"maximum"]]

skip :: [Char] -> [Char] -> Exp -> Exp -> Exp
skip [Char]
op [Char]
namestr = \Exp
eqExp Exp
wholeExp -> case Exp
eqExp of VarE Name
name | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
op -> Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
namestr
                                                   Exp
_         -> Exp
wholeExp
skipEq :: [Char] -> Exp -> Exp -> Exp
skipEq  = [Char] -> [Char] -> Exp -> Exp -> Exp
skip [Char]
"=="
skipOrd :: [Char] -> Exp -> Exp -> Exp
skipOrd = [Char] -> [Char] -> Exp -> Exp -> Exp
skip [Char]
"compare"

[Char]
shown appearsIn :: [Char] -> a -> Bool
`appearsIn` a
e = (Bool -> Bool -> Bool) -> GenericQ Bool -> a -> Bool
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
G.everything Bool -> Bool -> Bool
(||) (Bool
False Bool -> (Name -> Bool) -> a -> Bool
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
`G.mkQ` (\Name
name -> Name -> [Char]
forall a. Show a => a -> [Char]
show (Name
name::Name) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
shown)) a
e

{-
by1 "le"   = "<="
by1 "less" = "<"
by1 name   = name
-}

-- この辺はCoreLangでやるべきという気も．少なくとも，そっちで関数を定義すべき．
-- \x -> iF foo bar x の場合も先にη簡約されてしまうとイマイチではある．ので，η簡約はiF, nat_cata, tailなどの処理の後にやる．
-- For readability, we apply eta-reduction only when we can fully eta-reduce at the outermost lambda-abstraction.
ppLambda :: [Pat] -> Exp -> Exp
ppLambda [VarP Name
n] (AppE Exp
e (VarE Name
n')) | [Char]
shown [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n' Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char]
shown [Char] -> Exp -> Bool
forall a. Data a => [Char] -> a -> Bool
`appearsIn` Exp
e) = Exp
e
                                               where shown :: [Char]
shown = Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n
ppLambda [VarP Name
n, VarP Name
m, VarP Name
l] (AppE (AppE (AppE Exp
e (VarE Name
n')) (VarE Name
m')) (VarE Name
l')) 
  | [Char]
shown [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n' Bool -> Bool -> Bool
&& [Char]
showm [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
m' Bool -> Bool -> Bool
&& [Char]
showl [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
l' Bool -> Bool -> Bool
&& Bool
free = Exp
e
  | [Char]
shown [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
m' Bool -> Bool -> Bool
&& [Char]
showm [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n' Bool -> Bool -> Bool
&& [Char]
showl [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
l' Bool -> Bool -> Bool
&& Bool
free = Exp
flipE Exp -> Exp -> Exp
`AppE` Exp
e
                                               where shown :: [Char]
shown = Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n
                                                     showm :: [Char]
showm = Name -> [Char]
forall a. Show a => a -> [Char]
show Name
m
                                                     showl :: [Char]
showl = Name -> [Char]
forall a. Show a => a -> [Char]
show Name
l
                                                     free :: Bool
free  = Bool -> Bool
not ([Char]
shown [Char] -> Exp -> Bool
forall a. Data a => [Char] -> a -> Bool
`appearsIn` Exp
e) Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char]
showm [Char] -> Exp -> Bool
forall a. Data a => [Char] -> a -> Bool
`appearsIn` Exp
e) Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char]
showl [Char] -> Exp -> Bool
forall a. Data a => [Char] -> a -> Bool
`appearsIn` Exp
e)
ppLambda [VarP Name
n, VarP Name
m] (AppE (AppE Exp
e (VarE Name
n')) (VarE Name
m')) 
  | [Char]
shown [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n' Bool -> Bool -> Bool
&& [Char]
showm [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
m' Bool -> Bool -> Bool
&& Bool
free = Exp
e
  | [Char]
shown [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
m' Bool -> Bool -> Bool
&& [Char]
showm [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n' Bool -> Bool -> Bool
&& Bool
free = Exp
flipE Exp -> Exp -> Exp
`AppE` Exp
e
                                               where shown :: [Char]
shown = Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n
                                                     showm :: [Char]
showm = Name -> [Char]
forall a. Show a => a -> [Char]
show Name
m
                                                     free :: Bool
free  = Bool -> Bool
not ([Char]
shown [Char] -> Exp -> Bool
forall a. Data a => [Char] -> a -> Bool
`appearsIn` Exp
e) Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char]
showm [Char] -> Exp -> Bool
forall a. Data a => [Char] -> a -> Bool
`appearsIn` Exp
e)
-- postprocess (LamE [WildP]         e)         = constE `AppE` e        -- not sure if this is more readable....
ppLambda [VarP Name
n, Pat
WildP] (VarE Name
n') | Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n' = Exp
constE
ppLambda [VarP Name
n]        (VarE Name
n') | Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n' = Name -> Exp
VarE ([Char] -> Name
mkName [Char]
"id")
ppLambda [VarP Name
n, VarP Name
m] (InfixE (Just (VarE Name
n')) Exp
op (Just (VarE Name
m'))) | Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n' Bool -> Bool -> Bool
&&  Name -> [Char]
forall a. Show a => a -> [Char]
show Name
m [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
m' = Exp
op
ppLambda pats :: [Pat]
pats@[VarP Name
n, VarP Name
m] e :: Exp
e@(InfixE (Just (VarE Name
n')) op :: Exp
op@(VarE Name
opna) (Just (VarE Name
m'))) 
  = if Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
m' Bool -> Bool -> Bool
&&  Name -> [Char]
forall a. Show a => a -> [Char]
show Name
m [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n'
    then case Name -> [Char]
nameBase Name
opna of [Char]
"<"                                              -> Name -> Exp
VarE ([Char] -> Name
mkName [Char]
">")
                               [Char]
"<="                                             -> Name -> Exp
VarE ([Char] -> Name
mkName [Char]
">=")
                               [Char]
"-"                                              -> Name -> Exp
VarE ([Char] -> Name
mkName [Char]
"subtract")
                               [Char]
name | [Char]
name [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"==",[Char]
"/=",[Char]
"+",[Char]
"*",[Char]
"&&",[Char]
"||"] -> Exp
op
                                    | Bool
otherwise                                 -> Exp
flipE Exp -> Exp -> Exp
`AppE` Exp
op
    else [Pat] -> Exp -> Exp
LamE [Pat]
pats Exp
e
ppLambda [VarP Name
n]         (InfixE (Just (VarE Name
n')) Exp
op (Just Exp
e))         
  | [Char]
shown [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n' Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char]
shown [Char] -> Exp -> Bool
forall a. Data a => [Char] -> a -> Bool
`appearsIn` Exp
e) = case Exp
op of VarE Name
name | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"-" -> Name -> Exp
VarE ([Char] -> Name
mkName [Char]
"subtract") Exp -> Exp -> Exp
`AppE` Exp
e
                                                               Exp
_                                -> Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE Maybe Exp
forall a. Maybe a
Nothing Exp
op (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
e)
  where shown :: [Char]
shown = Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n
ppLambda [VarP Name
n]         (InfixE (Just Exp
e) Exp
op (Just (VarE Name
n')))         | [Char]
shown [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n' Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char]
shown [Char] -> Exp -> Bool
forall a. Data a => [Char] -> a -> Bool
`appearsIn` Exp
e) = Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
e) Exp
op Maybe Exp
forall a. Maybe a
Nothing
                                                                  where shown :: [Char]
shown = Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n
ppLambda [Pat]
pats            Exp
e         = [Pat] -> Exp -> Exp
LamE [Pat]
pats Exp
e



ppv :: Exp -> Exp
ppv e :: Exp
e@(VarE Name
name) | Name -> [Char]
nameBase Name
name [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"iF", [Char]
"nat_cata"] = [Pat] -> Exp -> Exp
LamE [ Name -> Pat
VarP Name
n | Name
n <- [Name]
names ] (Exp -> Exp
postprocess (Exp -> Exp -> Exp
AppE (Exp -> Exp -> Exp
AppE (Exp -> Exp -> Exp
AppE Exp
e Exp
p) Exp
t) Exp
f))
                  | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"last'"                = [Pat] -> Exp -> Exp
LamE [ Name -> Pat
VarP Name
n | Name
n <- [Name] -> [Name]
forall a. [a] -> [a]
tail [Name]
names ] (Exp -> Exp
postprocess (Exp -> Exp -> Exp
AppE (Exp -> Exp -> Exp
AppE Exp
e Exp
t) Exp
f))
                  | Bool
otherwise                               = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ Name -> Name
ppopn Name
name
    where names :: [Name]
names   = [ [Char] -> Name
mkName [Char
n] | Char
n <- [Char]
"ptf" ]
          [Exp
p,Exp
t,Exp
f] = (Name -> Exp) -> [Name] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Exp
VarE [Name]
names

ppopn :: Name -> Name
ppopn Name
name = case Name -> Maybe [Char]
nameModule Name
name of Just [Char]
mod | --  mod `elem` ["GHC.Base", "GHC.List", "GHC.Char", "GHC.Num"]  -- Rather, optional qualifications such as Data.Map. and Data.Text. should be qualified, and all other qualifications should be removed.
                                                Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
mod [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"Data.Map", [Char]
"Data.Set", [Char]
"Data.Text", [Char]
"Data.ByteString"] -- These are just examples for now.
                                                     -> [Char] -> Name
mkName ([Char] -> Name) -> [Char] -> Name
forall a b. (a -> b) -> a -> b
$ Name -> [Char]
nameBase Name
name
                                     Maybe [Char]
_        -> Name
name


ppdrop :: Integer -> Exp -> Exp
ppdrop Integer
m0j Exp
e 
  = case Exp -> Exp
postprocess Exp
e of
      AppE (AppE (VarE Name
drn) (LitE (IntegerL Integer
i))) Exp
list | Name -> [Char]
nameBase Name
drn [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"drop" -> Integer -> Exp -> Exp
droppy (Integer
m0j Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i) Exp
list -- NB: m0j and i are both positive.
      Exp
ppe                                             -> Integer -> Exp -> Exp
droppy Integer
m0j Exp
ppe
  where droppy :: Integer -> Exp -> Exp
droppy Integer
i Exp
e = (Exp
dropE Exp -> Exp -> Exp
`AppE` (Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
i)) Exp -> Exp -> Exp
`AppE` Exp
e

constE :: Exp
constE = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"const"
flipE :: Exp
flipE  = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"flip"
plusE :: Exp
plusE  = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"+"
dropE :: Exp
dropE  = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"drop"
reverseE :: Exp
reverseE = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"reverse"
lengthE :: Exp
lengthE  = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"length"
sumE :: Exp
sumE     = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"sum"
productE :: Exp
productE = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"product"

procSucc :: Integer -> Exp -> Exp
procSucc Integer
n (AppE (VarE Name
name) Exp
e) | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"succ" = Integer -> Exp -> Exp
procSucc (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1) Exp
e
procSucc Integer
n (LitE (CharL Char
c))     = Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Char -> Lit
CharL (Char -> Lit) -> Char -> Lit
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> Char -> [Char]
forall a. (a -> a) -> a -> [a]
iterate Char -> Char
forall a. Enum a => a -> a
succ Char
c [Char] -> Integer -> Char
forall i a. Integral i => [a] -> i -> a
`genericIndex` Integer
n
procSucc Integer
n (LitE (IntegerL Integer
i))  = Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
i
procSucc Integer
n (LitE (RationalL Rational
r)) = Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Rational -> Lit
RationalL (Rational -> Lit) -> Rational -> Lit
forall a b. (a -> b) -> a -> b
$ Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
n Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
r
procSucc Integer
n Exp
e | Bool
succOnlyForNumbers = Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
n) (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"+") (Exp -> Maybe Exp
forall a. a -> Maybe a
Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp
postprocess Exp
e) -- This is OK, if we use succ only for numbers.
             | Bool
otherwise          = (Exp -> Exp) -> Exp -> [Exp]
forall a. (a -> a) -> a -> [a]
iterate (Exp -> Exp -> Exp
AppE (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"succ")) (Exp -> Exp
postprocess Exp
e) [Exp] -> Integer -> Exp
forall i a. Integral i => [a] -> i -> a
`genericIndex` Integer
n

postprocessQ :: Exp -> ExpQ
{- This type of patterns is not available yet.
postprocessQ (AppE (AppE (AppE (VarE 'iF)        p)  t) f) = [| if $(postprocessQ p) then $(postprocessQ t) else $(postprocessQ f) |]
postprocessQ (AppE (AppE (AppE (VarE 'nat_para)  i)  x) f) = [| let {np 0  = $(postprocessQ x); np (n+1)  = $(postprocessQ f) n (np n)}     in np (abs $(postprocessQ i)) |]
postprocessQ (AppE (AppE (AppE (VarE 'list_para) xs) x) f) = [| let {lp [] = $(postprocessQ x); lp (y:ys) = $(postprocessQ f) y ys (lp ys)} in lp $(postprocessQ xs) |]
-}
postprocessQ :: Exp -> ExpQ
postprocessQ (AppE (e :: Exp
e@(AppE (AppE (VarE Name
name)        Exp
p)  Exp
t)) Exp
f)
    = case Name -> [Char]
nameBase Name
name of
        [Char]
"iF"        -> [| if $(postprocessQ p) then $(postprocessQ t) else $(postprocessQ f) |]
        [Char]
"nat_cata"  -> [| iterate $(postprocessQ f) $(postprocessQ t) !! abs $(postprocessQ p) |]
        [Char]
"nat_para"  -> [| let {np 0  = $(postprocessQ t); np n  = let i=n-1 in $(postprocessQ f) i (np i)}     in np (abs $(postprocessQ p)) |]
        [Char]
"list_para" -> [| let {lp [] = $(postprocessQ t); lp (y:ys) = $(postprocessQ f) y ys (lp ys)} in lp $(postprocessQ p) |]
        [Char]
_           -> [| $(postprocessQ e) $(postprocessQ f) |]
postprocessQ (AppE Exp
f Exp
x) = [| $(postprocessQ f) $(postprocessQ x) |]
-- postprocessQ (VarE 'iF) = [| \p t f -> if p then t else f |] -- This pattern is actually unnecessary because only eta-long normal expressions will be generated.
-- ...
postprocessQ (InfixE Maybe Exp
me1 Exp
op Maybe Exp
me2) = let fmapM :: (t -> m a) -> Maybe t -> m (Maybe a)
fmapM t -> m a
f Maybe t
Nothing  = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
                                       fmapM t -> m a
f (Just t
x) = (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (t -> m a
f t
x)
                                   in (Maybe Exp -> Maybe Exp -> Exp)
-> Q (Maybe Exp) -> Q (Maybe Exp) -> ExpQ
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (\Maybe Exp
e1 Maybe Exp
e2 -> Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE Maybe Exp
e1 Exp
op Maybe Exp
e2) ((Exp -> ExpQ) -> Maybe Exp -> Q (Maybe Exp)
forall (m :: * -> *) t a.
Monad m =>
(t -> m a) -> Maybe t -> m (Maybe a)
fmapM Exp -> ExpQ
postprocessQ Maybe Exp
me1) ((Exp -> ExpQ) -> Maybe Exp -> Q (Maybe Exp)
forall (m :: * -> *) t a.
Monad m =>
(t -> m a) -> Maybe t -> m (Maybe a)
fmapM Exp -> ExpQ
postprocessQ Maybe Exp
me2)
postprocessQ (LamE [Pat]
pats Exp
e) = (Exp -> Exp) -> ExpQ -> ExpQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Pat] -> Exp -> Exp
LamE [Pat]
pats) (Exp -> ExpQ
postprocessQ Exp
e)
postprocessQ (TupE [Maybe Exp]
es) = ([Exp] -> Exp) -> Q [Exp] -> ExpQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Exp] -> Exp
tup ((Maybe Exp -> ExpQ) -> [Maybe Exp] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Exp -> ExpQ
postprocessQ(Exp -> ExpQ) -> (Maybe Exp -> Exp) -> Maybe Exp -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Maybe Exp -> Exp
forall a. Maybe a -> a
unJust) [Maybe Exp]
es)
postprocessQ (ListE [Exp]
es) = ([Exp] -> Exp) -> Q [Exp] -> ExpQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Exp] -> Exp
ListE ((Exp -> ExpQ) -> [Exp] -> Q [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Exp -> ExpQ
postprocessQ [Exp]
es)
postprocessQ (SigE Exp
e Type
ty) = (Exp -> Exp) -> ExpQ -> ExpQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Exp -> Type -> Exp
`SigE` Type
ty) (Exp -> ExpQ
postprocessQ Exp
e)
postprocessQ Exp
e = Exp -> ExpQ
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
e


exploit :: (Typeable a, Filtrable a) => 
           Bool -- ^ whether to include functions with unused arguments
           -> (a -> Bool) -> IO ()
exploit :: Bool -> (a -> Bool) -> IO ()
exploit Bool
withAbsents a -> Bool
pred = (a -> Bool) -> Every a -> IO (Every a)
forall a.
(Typeable a, Filtrable a) =>
(a -> Bool) -> Every a -> IO (Every a)
filterThenF a -> Bool
pred (ProgGenSF -> Bool -> Every a
forall pg a.
(ProgramGenerator pg, Typeable a) =>
pg -> Bool -> Every a
everything (ProgGenSF
forall pg. ProgramGenerator pg => pg
reallyall::ProgGenSF) Bool
withAbsents) IO (Every a) -> (Every a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Every a -> IO ()
forall a. Every a -> IO ()
pprs

boolean :: [Primitive]
boolean = $(p [| ((&&) :: (->) Bool ((->) Bool Bool),
                  (||) :: (->) Bool ((->) Bool Bool),
                  not  :: (->) Bool Bool) |] )
{-
-- Type classes are not supported yet....
-- Without tuning of the probability distribution over Chars and Lists, these are almost useless.
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.
{-
eq = $(p [| ((==) :: Int->Int->Bool,   (/=) :: Int->Int->Bool,
             (==) :: Char->Char->Bool, (/=) :: Char->Char->Bool,
             (==) :: Bool->Bool->Bool, (/=) :: Bool->Bool->Bool) |])
-}
-}
newtype Partial a = Part {Partial a -> a
undef :: a}
undefs :: [(Primitive, Primitive)]
undefs = ([Primitive] -> (Primitive, Primitive))
-> [[Primitive]] -> [(Primitive, Primitive)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Primitive
a,Primitive
b] -> (Primitive
a,Primitive
b)) ([[Primitive]] -> [(Primitive, Primitive)])
-> [[Primitive]] -> [(Primitive, Primitive)]
forall a b. (a -> b) -> a -> b
$
         [-- Bool や Orderingのように、ありがちな値を返してしまうものは、採用すべきでない。$(p [| (Part False :: Partial Bool,     undefined :: Partial Bool) |]), $(p [| (Part EQ    :: Partial Ordering, undefined :: Partial Ordering) |]),
          $(p [| (Part 53        :: Partial Int,      undefined :: Partial Int) |]), 
          $(p [| (Part '\29'     :: Partial Char,     undefined :: Partial Char) |]),
          $(p [| (Part [43]      :: Partial [Int],    undefined :: Partial [Int]) |]), 
          $(p [| (Part "wleajkf" :: Partial [Char],   undefined :: Partial [Char]) |])]
by1_head :: Partial a -> [a] -> a
by1_head :: Partial a -> [a] -> a
by1_head (Part a
u) [] = a
u
by1_head Partial a
_     (a
x:[a]
_) = a
x
(--#!!) :: Partial a -> [a] -> Int -> a
--#!! :: Partial a -> [a] -> Int -> a
(--#!!) (Part a
u) []     Int
n = a
u
(--#!!) (Part a
u) (a
x:[a]
xs) Int
n 
  = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 of 
     Ordering
LT -> a
u
     Ordering
EQ -> a
x
     Ordering
GT -> Partial a -> [a] -> Int -> a
forall a. Partial a -> [a] -> Int -> a
(--#!!) (a -> Partial a
forall a. a -> Partial a
Part a
u) [a]
xs (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) 

prelPartial :: [Primitive]
prelPartial = $(p [| ( by1_head :: Partial a -> (->) [a] a,
                       (--#!!) :: Partial a -> [a] -> (->) Int a) |] )

newtype Equivalence a = Eq {Equivalence a -> a -> a -> Bool
(--#==) :: a -> a -> Bool}
eq :: Equivalence a
eq = (a -> a -> Bool) -> Equivalence a
forall a. (a -> a -> Bool) -> Equivalence a
Eq a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
by1_eqMaybe :: Equivalence a -> Equivalence (Maybe a)
by1_eqMaybe :: Equivalence a -> Equivalence (Maybe a)
by1_eqMaybe (Eq a -> a -> Bool
op) = (Maybe a -> Maybe a -> Bool) -> Equivalence (Maybe a)
forall a. (a -> a -> Bool) -> Equivalence a
Eq ((Maybe a -> Maybe a -> Bool) -> Equivalence (Maybe a))
-> (Maybe a -> Maybe a -> Bool) -> Equivalence (Maybe a)
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
forall t t. (t -> t -> Bool) -> Maybe t -> Maybe t -> Bool
eqMaybeBy a -> a -> Bool
op
eqMaybeBy :: (t -> t -> Bool) -> Maybe t -> Maybe t -> Bool
eqMaybeBy t -> t -> Bool
_ Maybe t
Nothing  Maybe t
Nothing  = Bool
True
eqMaybeBy t -> t -> Bool
_ Maybe t
Nothing  (Just t
_) = Bool
False
eqMaybeBy t -> t -> Bool
_ (Just t
_) Maybe t
Nothing  = Bool
False
eqMaybeBy t -> t -> Bool
e (Just t
x) (Just t
y) = t -> t -> Bool
e t
x t
y
by1_eqList :: Equivalence a -> Equivalence [a]
by1_eqList :: Equivalence a -> Equivalence [a]
by1_eqList (Eq a -> a -> Bool
e) = ([a] -> [a] -> Bool) -> Equivalence [a]
forall a. (a -> a -> Bool) -> Equivalence a
Eq (([a] -> [a] -> Bool) -> Equivalence [a])
-> ([a] -> [a] -> Bool) -> Equivalence [a]
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> [a] -> [a] -> Bool
forall t t. (t -> t -> Bool) -> [t] -> [t] -> Bool
eqListBy a -> a -> Bool
e
eqListBy :: (t -> t -> Bool) -> [t] -> [t] -> Bool
eqListBy t -> t -> Bool
_ [] [] = Bool
True
eqListBy t -> t -> Bool
_ [] [t]
_  = Bool
False
eqListBy t -> t -> Bool
_ [t]
_  [] = Bool
False
eqListBy t -> t -> Bool
e (t
x:[t]
xs) (t
y:[t]
ys) = t -> t -> Bool
e t
x t
y Bool -> Bool -> Bool
&& (t -> t -> Bool) -> [t] -> [t] -> Bool
eqListBy t -> t -> Bool
e [t]
xs [t]
ys

by2_eqEither :: Equivalence a -> Equivalence b -> Equivalence (Either a b)
by2_eqEither :: Equivalence a -> Equivalence b -> Equivalence (Either a b)
by2_eqEither (Eq a -> a -> Bool
e1) (Eq b -> b -> Bool
e2) = (Either a b -> Either a b -> Bool) -> Equivalence (Either a b)
forall a. (a -> a -> Bool) -> Equivalence a
Eq ((Either a b -> Either a b -> Bool) -> Equivalence (Either a b))
-> (Either a b -> Either a b -> Bool) -> Equivalence (Either a b)
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool)
-> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
forall t t t t.
(t -> t -> Bool)
-> (t -> t -> Bool) -> Either t t -> Either t t -> Bool
eqEitherBy a -> a -> Bool
e1 b -> b -> Bool
e2
eqEitherBy :: (t -> t -> Bool)
-> (t -> t -> Bool) -> Either t t -> Either t t -> Bool
eqEitherBy t -> t -> Bool
e1 t -> t -> Bool
_  (Left  t
x) (Left  t
y) = t -> t -> Bool
e1 t
x t
y
eqEitherBy t -> t -> Bool
_  t -> t -> Bool
_  (Left  t
_) (Right t
_) = Bool
False
eqEitherBy t -> t -> Bool
_  t -> t -> Bool
_  (Right t
_) (Left  t
_) = Bool
False
eqEitherBy t -> t -> Bool
_  t -> t -> Bool
e2 (Right t
x) (Right t
y) = t -> t -> Bool
e2 t
x t
y
by2_eqPair :: Equivalence a -> Equivalence b -> Equivalence (a,b)
by2_eqPair :: Equivalence a -> Equivalence b -> Equivalence (a, b)
by2_eqPair (Eq a -> a -> Bool
e1) (Eq b -> b -> Bool
e2) = ((a, b) -> (a, b) -> Bool) -> Equivalence (a, b)
forall a. (a -> a -> Bool) -> Equivalence a
Eq (((a, b) -> (a, b) -> Bool) -> Equivalence (a, b))
-> ((a, b) -> (a, b) -> Bool) -> Equivalence (a, b)
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> (b -> b -> Bool) -> (a, b) -> (a, b) -> Bool
forall t t t t.
(t -> t -> Bool) -> (t -> t -> Bool) -> (t, t) -> (t, t) -> Bool
eqPairBy a -> a -> Bool
e1 b -> b -> Bool
e2
eqPairBy :: (t -> t -> Bool) -> (t -> t -> Bool) -> (t, t) -> (t, t) -> Bool
eqPairBy t -> t -> Bool
e1 t -> t -> Bool
e2 (t
x,t
y) (t
z,t
w) = t -> t -> Bool
e1 t
x t
z Bool -> Bool -> Bool
&& t -> t -> Bool
e2 t
y t
w

eqs :: [Primitive]
eqs = $(p [| (eq :: Equivalence Bool, eq :: Equivalence Ordering, eq :: Equivalence Int,  eq :: Equivalence Char, -- eq :: Equivalence (Ratio Int) is defined in ratioCls
              eq :: Equivalence [Int],  eq :: Equivalence [Char], by1_eqMaybe :: Equivalence a -> Equivalence (Maybe a), by1_eqList :: Equivalence a -> Equivalence [a],
              by2_eqEither :: Equivalence a -> Equivalence b -> Equivalence (Either a b), by2_eqPair :: Equivalence a -> Equivalence b -> Equivalence (a,b)) |])
prelEqRelated :: [[Primitive]]
prelEqRelated = [$(p [| ((--#==) :: Equivalence a -> (->) a (a -> Bool), (--#/=) :: Equivalence a -> (->) a (a -> Bool)) |]), 
                 $(p [|  by1_elem :: Equivalence a -> a -> [a] -> Bool |]), 
                 []]
dataListEqRelated :: [[Primitive]]
dataListEqRelated = [[],
                     $(p [| (by1_group :: Equivalence a -> [a] -> [[a]], 
                             by1_nub :: Equivalence a -> [a] -> [a]) |]), 
                     $(p [| (by1_isPrefixOf :: Equivalence a -> [a] -> [a] -> Bool, 
                             by1_isSuffixOf :: Equivalence a -> [a] -> [a] -> Bool, 
                             by1_isInfixOf  :: Equivalence a -> [a] -> [a] -> Bool, 
                             by1_stripPrefix :: Equivalence a -> [a] -> [a] -> Maybe [a],
                             by1_lookup :: Equivalence a -> a -> (->) [(a, b)] (Maybe b)
                            ) |])]
                      
(--#/=) :: Equivalence a -> a -> a -> Bool
--#/= :: Equivalence a -> a -> a -> Bool
(--#/=) (Eq a -> a -> Bool
e) a
x a
y = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> a -> Bool
e a
x a
y
by1_elem :: Equivalence a -> a -> [a] -> Bool
by1_elem :: Equivalence a -> a -> [a] -> Bool
by1_elem (Eq a -> a -> Bool
e) a
k = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a -> a -> Bool
e a
k)
by1_group :: Equivalence a -> [a] -> [[a]]
by1_group :: Equivalence a -> [a] -> [[a]]
by1_group (Eq a -> a -> Bool
e) = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy a -> a -> Bool
e
by1_nub :: Equivalence a -> [a] -> [a]
by1_nub :: Equivalence a -> [a] -> [a]
by1_nub (Eq a -> a -> Bool
e) = (a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy a -> a -> Bool
e
by1_isPrefixOf :: Equivalence a -> [a] -> [a] -> Bool
by1_isPrefixOf :: Equivalence a -> [a] -> [a] -> Bool
by1_isPrefixOf Equivalence a
_      []     [a]
_      = Bool
True
by1_isPrefixOf Equivalence a
_      [a]
_      []     = Bool
False
by1_isPrefixOf e :: Equivalence a
e@(Eq a -> a -> Bool
op) (a
x:[a]
xs) (a
y:[a]
ys) = a -> a -> Bool
op a
x a
y Bool -> Bool -> Bool
&& Equivalence a -> [a] -> [a] -> Bool
forall a. Equivalence a -> [a] -> [a] -> Bool
by1_isPrefixOf Equivalence a
e [a]
xs [a]
ys
by1_isSuffixOf :: Equivalence a -> [a] -> [a] -> Bool
by1_isSuffixOf :: Equivalence a -> [a] -> [a] -> Bool
by1_isSuffixOf Equivalence a
e [a]
xs [a]
ys = Equivalence a -> [a] -> [a] -> Bool
forall a. Equivalence a -> [a] -> [a] -> Bool
by1_isPrefixOf Equivalence a
e ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys)
by1_isInfixOf :: Equivalence a -> [a] -> [a] -> Bool
by1_isInfixOf :: Equivalence a -> [a] -> [a] -> Bool
by1_isInfixOf  Equivalence a
e [a]
xs [a]
ys = ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Equivalence a -> [a] -> [a] -> Bool
forall a. Equivalence a -> [a] -> [a] -> Bool
by1_isPrefixOf Equivalence a
e [a]
xs) ([a] -> [[a]]
forall a. [a] -> [[a]]
tails [a]
ys)
by1_stripPrefix :: Equivalence a -> [a] -> [a] -> Maybe [a]
by1_stripPrefix :: Equivalence a -> [a] -> [a] -> Maybe [a]
by1_stripPrefix Equivalence a
eq         []     [a]
ys     = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
ys
by1_stripPrefix eq :: Equivalence a
eq@(Eq a -> a -> Bool
op) (a
x:[a]
xs) (a
y:[a]
ys) | a -> a -> Bool
op a
x a
y = Equivalence a -> [a] -> [a] -> Maybe [a]
forall a. Equivalence a -> [a] -> [a] -> Maybe [a]
by1_stripPrefix Equivalence a
eq [a]
xs [a]
ys
by1_stripPrefix Equivalence a
_          [a]
_      [a]
_      = Maybe [a]
forall a. Maybe a
Nothing
by1_lookup :: Equivalence a -> a -> (->) [(a, b)] (Maybe b)
by1_lookup :: Equivalence a -> a -> [(a, b)] -> Maybe b
by1_lookup Equivalence a
_          a
_   []          =  Maybe b
forall a. Maybe a
Nothing
by1_lookup eq :: Equivalence a
eq@(Eq a -> a -> Bool
op) a
key ((a
x,b
y):[(a, b)]
xys)
    | a -> a -> Bool
op a
key a
x          =  b -> Maybe b
forall a. a -> Maybe a
Just b
y
    | Bool
otherwise         =  Equivalence a -> a -> [(a, b)] -> Maybe b
forall a b. Equivalence a -> a -> [(a, b)] -> Maybe b
by1_lookup Equivalence a
eq a
key [(a, b)]
xys

newtype Ordered a = Ord {Ordered a -> a -> a -> Ordering
by1_compare :: a->a->Ordering}
cmp :: Ordered a
cmp = (a -> a -> Ordering) -> Ordered a
forall a. (a -> a -> Ordering) -> Ordered a
Ord a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
by1_cmpMaybe :: Ordered a -> Ordered (Maybe a)
by1_cmpMaybe :: Ordered a -> Ordered (Maybe a)
by1_cmpMaybe (Ord a -> a -> Ordering
compare) = (Maybe a -> Maybe a -> Ordering) -> Ordered (Maybe a)
forall a. (a -> a -> Ordering) -> Ordered a
Ord ((Maybe a -> Maybe a -> Ordering) -> Ordered (Maybe a))
-> (Maybe a -> Maybe a -> Ordering) -> Ordered (Maybe a)
forall a b. (a -> b) -> a -> b
$ (a -> a -> Ordering) -> Maybe a -> Maybe a -> Ordering
forall t t. (t -> t -> Ordering) -> Maybe t -> Maybe t -> Ordering
compareMaybeBy a -> a -> Ordering
compare
compareMaybeBy :: (t -> t -> Ordering) -> Maybe t -> Maybe t -> Ordering
compareMaybeBy t -> t -> Ordering
_       Maybe t
Nothing  Maybe t
Nothing  = Ordering
EQ
compareMaybeBy t -> t -> Ordering
_       Maybe t
Nothing  (Just t
_) = Ordering
LT 
compareMaybeBy t -> t -> Ordering
_       (Just t
_) Maybe t
Nothing  = Ordering
GT 
compareMaybeBy t -> t -> Ordering
compare (Just t
x) (Just t
y) = t -> t -> Ordering
compare t
x t
y
by1_cmpList :: Ordered a -> Ordered [a]
by1_cmpList :: Ordered a -> Ordered [a]
by1_cmpList (Ord a -> a -> Ordering
compare) = ([a] -> [a] -> Ordering) -> Ordered [a]
forall a. (a -> a -> Ordering) -> Ordered a
Ord (([a] -> [a] -> Ordering) -> Ordered [a])
-> ([a] -> [a] -> Ordering) -> Ordered [a]
forall a b. (a -> b) -> a -> b
$ (a -> a -> Ordering) -> [a] -> [a] -> Ordering
forall t t. (t -> t -> Ordering) -> [t] -> [t] -> Ordering
compareListBy a -> a -> Ordering
compare
compareListBy :: (t -> t -> Ordering) -> [t] -> [t] -> Ordering
compareListBy t -> t -> Ordering
_ [] [] = Ordering
EQ
compareListBy t -> t -> Ordering
_ [] [t]
_  = Ordering
LT
compareListBy t -> t -> Ordering
_ [t]
_  [] = Ordering
GT
compareListBy t -> t -> Ordering
compare (t
x:[t]
xs) (t
y:[t]
ys) = case t -> t -> Ordering
compare t
x t
y of Ordering
EQ -> (t -> t -> Ordering) -> [t] -> [t] -> Ordering
compareListBy t -> t -> Ordering
compare [t]
xs [t]
ys
                                                          Ordering
o  -> Ordering
o
by2_cmpEither :: Ordered a -> Ordered b -> Ordered (Either a b)
by2_cmpEither :: Ordered a -> Ordered b -> Ordered (Either a b)
by2_cmpEither (Ord a -> a -> Ordering
compare1) (Ord b -> b -> Ordering
compare2) = (Either a b -> Either a b -> Ordering) -> Ordered (Either a b)
forall a. (a -> a -> Ordering) -> Ordered a
Ord ((Either a b -> Either a b -> Ordering) -> Ordered (Either a b))
-> (Either a b -> Either a b -> Ordering) -> Ordered (Either a b)
forall a b. (a -> b) -> a -> b
$ (a -> a -> Ordering)
-> (b -> b -> Ordering) -> Either a b -> Either a b -> Ordering
forall t t t t.
(t -> t -> Ordering)
-> (t -> t -> Ordering) -> Either t t -> Either t t -> Ordering
compareEitherBy a -> a -> Ordering
compare1 b -> b -> Ordering
compare2
compareEitherBy :: (t -> t -> Ordering)
-> (t -> t -> Ordering) -> Either t t -> Either t t -> Ordering
compareEitherBy t -> t -> Ordering
compare1 t -> t -> Ordering
_        (Left t
x)  (Left t
y)  = t -> t -> Ordering
compare1 t
x t
y
compareEitherBy t -> t -> Ordering
_        t -> t -> Ordering
_        (Left t
_)  (Right t
_) = Ordering
LT
compareEitherBy t -> t -> Ordering
_        t -> t -> Ordering
_        (Right t
_) (Left t
_)  = Ordering
GT
compareEitherBy t -> t -> Ordering
_        t -> t -> Ordering
compare2 (Right t
x) (Right t
y) = t -> t -> Ordering
compare2 t
x t
y
by2_cmpPair :: Ordered a -> Ordered b -> Ordered (a, b)
by2_cmpPair :: Ordered a -> Ordered b -> Ordered (a, b)
by2_cmpPair (Ord a -> a -> Ordering
compare1) (Ord b -> b -> Ordering
compare2) = ((a, b) -> (a, b) -> Ordering) -> Ordered (a, b)
forall a. (a -> a -> Ordering) -> Ordered a
Ord (((a, b) -> (a, b) -> Ordering) -> Ordered (a, b))
-> ((a, b) -> (a, b) -> Ordering) -> Ordered (a, b)
forall a b. (a -> b) -> a -> b
$ (a -> a -> Ordering)
-> (b -> b -> Ordering) -> (a, b) -> (a, b) -> Ordering
forall t t t t.
(t -> t -> Ordering)
-> (t -> t -> Ordering) -> (t, t) -> (t, t) -> Ordering
comparePairBy a -> a -> Ordering
compare1 b -> b -> Ordering
compare2
comparePairBy :: (t -> t -> Ordering)
-> (t -> t -> Ordering) -> (t, t) -> (t, t) -> Ordering
comparePairBy t -> t -> Ordering
compare1 t -> t -> Ordering
compare2 (t
x,t
y) (t
z,t
w) = case t -> t -> Ordering
compare1 t
x t
z of Ordering
EQ -> t -> t -> Ordering
compare2 t
y t
w
                                                                   Ordering
o  -> Ordering
o
ords :: [Primitive]
ords = $(p [| (cmp :: Ordered Bool, cmp :: Ordered Ordering, -- なぜかcomment outされていたので復活させてみた。問題あるなら戻すが。
               cmp :: Ordered Int, cmp :: Ordered Char, -- cmp :: Ordered (Ratio Int) is defined in ratioCls
               by1_cmpMaybe :: Ordered a -> Ordered (Maybe a), by1_cmpList :: Ordered a -> Ordered [a],
               by2_cmpEither :: Ordered a -> Ordered b -> Ordered (Either a b), by2_cmpPair :: Ordered a -> Ordered b -> Ordered (a,b)) |])
prelOrdRelated :: [[Primitive]]
prelOrdRelated = [$(p [| by1_compare :: Ordered a -> a->a->Ordering |]) [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++
                  $(p [| ((--#<=)  :: Ordered a -> a -> a -> Bool, (--#<) :: Ordered a -> a -> a -> Bool,
                          by1_max     :: Ordered a -> (->) a (a->a),    by1_min :: Ordered a -> (->) a (a->a)) |] ), [],
                  []]
                   --  maximum_by :: Ordered a -> [a] -> a,       minimum_by :: Ordered a -> [a] -> a) |]) -- Those are not total.
dataListOrdRelated :: [[Primitive]]
dataListOrdRelated = [[],[],$(p [| by1_sort :: Ordered a -> [a] -> [a] |] )]

--#<= :: Ordered a -> a -> a -> Bool
(--#<=) (Ord a -> a -> Ordering
compare) a
x a
y = case a -> a -> Ordering
compare a
x a
y of Ordering
GT -> Bool
False
                                                Ordering
_  -> Bool
True
--#< :: Ordered a -> a -> a -> Bool
(--#<)  (Ord a -> a -> Ordering
compare) a
x a
y = case a -> a -> Ordering
compare a
x a
y of Ordering
LT -> Bool
True
                                                Ordering
_  -> Bool
False
by1_max :: Ordered p -> p -> p -> p
by1_max Ordered p
c p
x p
y = if Ordered p -> p -> p -> Bool
forall a. Ordered a -> a -> a -> Bool
(--#<=) Ordered p
c p
x p
y then p
y else p
x
by1_min :: Ordered p -> p -> p -> p
by1_min Ordered p
c p
x p
y = if Ordered p -> p -> p -> Bool
forall a. Ordered a -> a -> a -> Bool
(--#<=) Ordered p
c p
x p
y then p
x else p
y
by1_sort :: Ordered a -> [a] -> [a]
by1_sort (Ord a -> a -> Ordering
compare) = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
compare

intinst :: [Primitive]
intinst = [Primitive]
intinst1[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
intinst2
intinst1 :: [Primitive]
intinst1 = $(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,
               --    (^)  :: Int->Int->Int
                  ) |])
intpartials :: [Primitive]
intpartials = $(p [| (               
                      div  :: Int->Int->Int,
                      mod  :: Int->Int->Int,
                      (^)  :: Int->Int->Int
                     ) |])
intinst2 :: [Primitive]
intinst2 = $(p [| (
                   gcd  :: Int->Int->Int,
                   lcm  :: Int->Int->Int) |])

list1 :: [Primitive]
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]) |] )
list1' :: [Primitive]
list1' = $(p [| (flip map :: (->) [a] ((a -> b) -> [b]),
                 (++)      :: (->) [a] ([a] -> [a]),
                 filter    :: (a -> Bool) -> [a] -> [a],
                 concat    :: (->) [[a]] [a],
                 flip concatMap :: (->) [a] ((a -> [b]) -> [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 :: [Primitive]
list2 = $(p [| (
                lines            :: [Char] -> [[Char]],
                words            :: [Char] -> [[Char]],
                unlines            :: [[Char]] -> [Char],
                unwords            :: [[Char]] -> [Char] ) |] )

list3 :: [Primitive]
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]) ) |] )
list3' :: [Primitive]
list3' = $(p [| (reverse :: [a] -> [a],
                 and         :: (->) [Bool] Bool,
                 or          :: (->) [Bool] Bool,
                 flip any         :: (->) [a] ((a -> Bool) -> Bool),
                 flip all         :: (->) [a] ((a -> Bool) -> Bool),
                 flip . flip zipWith :: (->) [a] ((->) [b] ((a->b->c) -> [c])) ) |] )

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

reallyall :: ProgramGenerator pg => pg
reallyall :: pg
reallyall = [Primitive] -> pg
forall pg. ProgramGenerator pg => [Primitive] -> pg
mkPG [Primitive]
rich

nrnds :: [a]
nrnds = a -> [a]
forall a. a -> [a]
repeat a
5


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

#ifdef TFRANDOM
generator = seedTFGen (3497676378205993723,16020016691208771845,6545968067796471226,2770936286170065919)
#else
generator :: StdGen
generator = Int -> StdGen
mkStdGen Int
123456
#endif

-- Currently only the pg==ConstrLSF case makes sense.
mix, poormix :: ProgramGenerator pg => pg
mix :: pg
mix = StdGen -> [Int] -> [Primitive] -> [Primitive] -> [Primitive] -> pg
forall pg.
ProgramGenerator pg =>
StdGen -> [Int] -> [Primitive] -> [Primitive] -> [Primitive] -> pg
mkPGSF StdGen
generator
              [Int]
forall a. Num a => [a]
nrnds
              []
              ([Primitive]
list[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
bool)
              [Primitive]
rich

-- I think having both succ and pred is not good, and pred x can be synthesized as x - succ 0.
-- Still, having both cons and tail is OK.
soso :: [Primitive]
soso =        ([Primitive]
list'' [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++
                    [Primitive]
nat'woPred [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++
                        [Primitive]
mb' [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
bool [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
plusInt [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ -- x $(p [| (hd :: [a] -> Maybe a, (+) :: Int -> Int -> Int) |]) ++
                    [Primitive]
boolean [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
intinst1 [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++
                    [Primitive]
list1' [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
list3')
rich :: [Primitive]
rich = [Primitive]
soso [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
list2 [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
intinst2 [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ $(p [| init :: [a] -> [a] |])

poormix :: pg
poormix = StdGen -> [Int] -> [Primitive] -> [Primitive] -> [Primitive] -> pg
forall pg.
ProgramGenerator pg =>
StdGen -> [Int] -> [Primitive] -> [Primitive] -> [Primitive] -> pg
mkPGSF StdGen
generator
              [Int]
forall a. Num a => [a]
nrnds
              []
              $(p [| ([] :: [a], True) |] )
              [Primitive]
rich

-- just for debugging
ra :: ProgramGenerator pg => pg
ra :: pg
ra = [Primitive] -> pg
forall pg. ProgramGenerator pg => [Primitive] -> pg
mkPG [Primitive]
rich'
rich' :: [Primitive]
rich' =      ([Primitive]
list'[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
bool[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
boolean[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++
                    [Primitive]
list1 [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
list3)

mx :: ProgramGenerator pg => pg
mx :: pg
mx = StdGen -> [Int] -> [Primitive] -> [Primitive] -> [Primitive] -> pg
forall pg.
ProgramGenerator pg =>
StdGen -> [Int] -> [Primitive] -> [Primitive] -> [Primitive] -> pg
mkPGSF StdGen
generator
             [Int]
forall a. Num a => [a]
nrnds
             []
             ([Primitive]
list[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
bool)
             [Primitive]
rich'

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

-- | Library used by the program server backend
pgfull :: ProgGenSF
-- pgfull = mkPG ($(MagicHaskeller.LibTH.load "libsrc/PreludeList.hs") ++ mb ++ bool ++ boolean ++ $(p [| ([], (:), (+) :: Int -> Int -> Int, replicate :: Int -> a -> [a]) |]) ++ $(p [| until ::  (a -> Bool) -> (a -> a) -> a -> a |]) ++ nat ++ intinst)  -- rich とあまり変わらない．
pgfull :: ProgGenSF
pgfull = Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> ProgGenSF
forall pg.
ProgramGenerator pg =>
Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
mkPGXOpt Options
forall a. Opt a
options{tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20,timeout :: Maybe Int
timeout=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100000} ([Primitive]
eqs[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ords) [(Primitive, Primitive)]
clspartialss [[Primitive]]
full [[(Primitive, Primitive)]]
tupartialssNormal
-- A pgfull must be a CAF, so we must have pgfulls and access pgfullSized via pgfulls. Directly calling pgfullSized is heap-inefficient.
pgfulls :: [ProgGenSF]
pgfulls :: [ProgGenSF]
pgfulls = (Int -> ProgGenSF) -> [Int] -> [ProgGenSF]
forall a b. (a -> b) -> [a] -> [b]
map Int -> ProgGenSF
forall pg. ProgramGenerator pg => Int -> pg
pgfullSized [Int
0..]
  where pgfullSized :: Int -> pg
pgfullSized Int
sz = Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
forall pg.
ProgramGenerator pg =>
Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
mkPGXOpt Options
forall a. Opt a
options{memoCondPure :: Type -> Int -> Bool
memoCondPure = \Type
t Int
d -> Type -> Int
size Type
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz Bool -> Bool -> Bool
&& Int
0Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
d {- && d<7 -}, tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20,timeout :: Maybe Int
timeout=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100000} ([Primitive]
eqs[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ords) [(Primitive, Primitive)]
clspartialss [[Primitive]]
full [[(Primitive, Primitive)]]
tupartialssNormal

mkPgFull :: IO ProgGenSF
mkPgFull :: IO ProgGenSF
mkPgFull = (Common
 -> [Typed [CoreExpr]]
 -> [[Typed [CoreExpr]]]
 -> [[Typed [CoreExpr]]]
 -> IO ProgGenSF)
-> Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> IO ProgGenSF
forall a.
(Common
 -> [Typed [CoreExpr]]
 -> [[Typed [CoreExpr]]]
 -> [[Typed [CoreExpr]]]
 -> a)
-> Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> a
mkPGXOpts Common
-> [Typed [CoreExpr]]
-> [[Typed [CoreExpr]]]
-> [[Typed [CoreExpr]]]
-> IO ProgGenSF
forall e.
Expression e =>
Common
-> [Typed [CoreExpr]]
-> [[Typed [CoreExpr]]]
-> [[Typed [CoreExpr]]]
-> IO (PGSF e)
mkTrieOptSFIO Options
forall a. Opt a
options{tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20,timeout :: Maybe Int
timeout=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20000} ([Primitive]
eqs[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ords) [(Primitive, Primitive)]
clspartialss [[Primitive]]
full [[(Primitive, Primitive)]]
tupartialssNormal
mkPgTotal :: IO ProgGenSF
mkPgTotal :: IO ProgGenSF
mkPgTotal = (Common
 -> [Typed [CoreExpr]]
 -> [[Typed [CoreExpr]]]
 -> [[Typed [CoreExpr]]]
 -> IO ProgGenSF)
-> Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> IO ProgGenSF
forall a.
(Common
 -> [Typed [CoreExpr]]
 -> [[Typed [CoreExpr]]]
 -> [[Typed [CoreExpr]]]
 -> a)
-> Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> a
mkPGXOpts Common
-> [Typed [CoreExpr]]
-> [[Typed [CoreExpr]]]
-> [[Typed [CoreExpr]]]
-> IO ProgGenSF
forall e.
Expression e =>
Common
-> [Typed [CoreExpr]]
-> [[Typed [CoreExpr]]]
-> [[Typed [CoreExpr]]]
-> IO (PGSF e)
mkTrieOptSFIO Options
forall a. Opt a
options{tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20,timeout :: Maybe Int
timeout=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20000} ([Primitive]
eqs[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ords) [] [[Primitive]]
full []

mkDebugPg :: IO ProgGenSF
mkDebugPg :: IO ProgGenSF
mkDebugPg = (Common
 -> [Typed [CoreExpr]]
 -> [[Typed [CoreExpr]]]
 -> [[Typed [CoreExpr]]]
 -> IO ProgGenSF)
-> Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> IO ProgGenSF
forall a.
(Common
 -> [Typed [CoreExpr]]
 -> [[Typed [CoreExpr]]]
 -> [[Typed [CoreExpr]]]
 -> a)
-> Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> a
mkPGXOpts Common
-> [Typed [CoreExpr]]
-> [[Typed [CoreExpr]]]
-> [[Typed [CoreExpr]]]
-> IO ProgGenSF
forall e.
Expression e =>
Common
-> [Typed [CoreExpr]]
-> [[Typed [CoreExpr]]]
-> [[Typed [CoreExpr]]]
-> IO (PGSF e)
mkTrieOptSFIO Options
forall a. Opt a
options{tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20,timeout :: Maybe Int
timeout=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20000} [] [] [[Primitive]]
deb []

deb :: [[Primitive]]
deb = [ $(p [| (reverse :: [a] -> [a], enumFromTo :: Int -> Int -> [Int], 1::Int, product :: [Int] -> Int, concatMap :: (a -> [b]) -> [a] -> [b]) |]), [],[]]

pgfullIO :: IO ProgGenSFIORef
pgfullIO :: IO ProgGenSFIORef
pgfullIO = Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> IO ProgGenSFIORef
forall pg.
ProgramGeneratorIO pg =>
Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> IO pg
mkPGXOptIO Options
forall a. Opt a
options{tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20} ([Primitive]
eqs[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ords) [(Primitive, Primitive)]
clspartialss [[Primitive]]
full [[(Primitive, Primitive)]]
tupartialssNormal
full :: [[Primitive]]
full = ([[Primitive]] -> [[Primitive]] -> [[Primitive]])
-> [[Primitive]] -> [[[Primitive]]] -> [[Primitive]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [[Primitive]] -> [[Primitive]] -> [[Primitive]]
forall a. [[a]] -> [[a]] -> [[a]]
zipAppend [[Primitive]]
literals [[[Primitive]]
fromPrelude, [[Primitive]]
prelEqRelated, [[Primitive]]
dataListEqRelated, [[Primitive]]
prelOrdRelated, [[Primitive]]
dataListOrdRelated, [[Primitive]]
fromDataList, [[Primitive]]
fromDataChar, [[Primitive]]
fromDataMaybe]
clspartialss :: [(Primitive,Primitive)]
clspartialss :: [(Primitive, Primitive)]
clspartialss = [(Primitive, Primitive)]
undefs
tupartialss, tupartialssNormal :: [[(Primitive,Primitive)]]
tupartialss :: [[(Primitive, Primitive)]]
tupartialss
  = ([[Primitive]] -> [(Primitive, Primitive)])
-> [[[Primitive]]] -> [[(Primitive, Primitive)]]
forall a b. (a -> b) -> [a] -> [b]
map (([Primitive] -> (Primitive, Primitive))
-> [[Primitive]] -> [(Primitive, Primitive)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Primitive
a,Primitive
b] -> (Primitive
a,Primitive
b))) 
                  [ [], -- [$(p [|(reverse . drop 1 . reverse :: [a] -> [a], init :: [a] -> [a])|])], -- An unnatural value cannot be returned in this case due to the polymorphism, unless the Partial class is used.
                    [$(p [| (chr . (`mod` 65536) . abs, chr . abs) |]),
                     $(p [| (chr . (`mod` 65536) . succ . ord :: Char->Char, succ :: Char -> Char) |])],
                    [$(p [| ((\m n -> if n==0 then 83 else div m n) :: Int->Int->Int,     div :: Int->Int->Int) |]),
                     $(p [| ((\m n -> if n==0 then 46 else mod m n) :: Int->Int->Int,     mod :: Int->Int->Int) |]),
                     $(p [| ((\m n -> if n<0  then 23 else m ^ n)   :: Int->Int->Int,     (^) :: Int->Int->Int) |]),
                     $(p [| ((\l m n -> if l==m then [n,m,m,n,m,n,n]   else [l,m..n]) :: Int->Int->Int->[Int],     enumFromThenTo :: Int->Int->Int->[Int]) |]),
                     $(p [| ((\l m n -> if l==m then [m,n,n,m,n,n,n,m] else [l,m..n]) :: Char->Char->Char->[Char], enumFromThenTo :: Char->Char->Char->[Char]) |]),
                     $(p [| (chr . (`mod` 65536) . pred . ord :: Char->Char, pred :: Char -> Char) |])
                    ] ]
-- tupartialssNormal is a variant of tupartialss, which make total functions from partial functions by making the latter return `natural' values for error cases.
-- Returning natural values is good if MagicHaskeller.fpartial try total versions after failures of partial versions, and currently that is the case.
tupartialssNormal :: [[(Primitive, Primitive)]]
tupartialssNormal
  = ([[Primitive]] -> [(Primitive, Primitive)])
-> [[[Primitive]]] -> [[(Primitive, Primitive)]]
forall a b. (a -> b) -> [a] -> [b]
map (([Primitive] -> (Primitive, Primitive))
-> [[Primitive]] -> [(Primitive, Primitive)]
forall a b. (a -> b) -> [a] -> [b]
map (\[Primitive
a,Primitive
b] -> (Primitive
a,Primitive
b))) 
                  [ [], -- [$(p [|(reverse . drop 1 . reverse :: [a] -> [a], init :: [a] -> [a])|])], 
                    [$(p [| (chr . (`mod` 65536) . abs, chr . abs) |]),
                     $(p [| (chr . (`mod` 65536) . succ . ord :: Char->Char, succ :: Char -> Char) |])],
                    [$(p [| ((\m n -> if n==0 then 0 else div m n) :: Int->Int->Int,     div :: Int->Int->Int) |]),
                     $(p [| ((\m n -> if n==0 then 0 else mod m n) :: Int->Int->Int,     mod :: Int->Int->Int) |]),
                     $(p [| ((\m n -> if m==0 then 0 else m ^ n)   :: Int->Int->Int,     (^) :: Int->Int->Int) |]),
                     $(p [| ((\l m n -> if l==m then [] else [l,m..n]) :: Int->Int->Int->[Int],     enumFromThenTo :: Int->Int->Int->[Int]) |]),
                     $(p [| ((\l m n -> if l==m then [] else [l,m..n]) :: Char->Char->Char->[Char], enumFromThenTo :: Char->Char->Char->[Char]) |]),
                     $(p [| (chr . (`mod` 65536) . pred . ord :: Char->Char, pred :: Char -> Char) |])
                     ] ]

literals :: [[Primitive]]
literals = [$(p [|(1::Int, 2::Int, 3::Int, ' '::Char)|]), [], []]
fromPrelude :: [[Primitive]]
fromPrelude = [ -- prelPartial ++
               [Primitive]
soso [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ $(p [| (null :: (->) [a] Bool, -- Without this, null is synthesized as all (\_ -> False).
                               abs  :: (->) Int Int, -- compare :: Char->Char->Ordering, compare :: Int->Int->Ordering, 
                               flip . flip foldl :: a -> (->) [b] ((a -> b -> a) -> a), 
                               foldr const :: a -> (->) [a] a, 
                               last' :: a -> [a] -> a,
                               reverse . drop 1 . reverse :: [a] -> [a],
                               enumFromTo :: Int->Int->[Int], enumFromTo :: Char->Char->[Char],
                               fmap :: (a -> b) -> (->) (Maybe a) (Maybe b),
                               flip (flip . either) :: (->) (Either a b) ((a -> c) -> (b -> c) -> c)) |])
               [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ [Primitive]
intinst2 [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ $(p [| (sum :: (->) [Int] Int, product :: (->) [Int] Int) |]), 
               [Primitive]
list2 [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ $(p [| (scanl :: (a -> b -> a) -> a -> [b] -> [a], scanr :: (a -> b -> b) -> b -> [a] -> [b], scanl1 :: (a -> a -> a) -> [a] -> [a], scanr1 :: (a -> a -> a) -> [a] -> [a],
               -- until ::  (a -> Bool) -> (a -> a) -> a -> a) を入れてたが，どうもuntilがあると急に遅くなる．その割に，全く使われない．何じゃらホイ
                show :: Int -> [Char]) |])[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ $(p [| ((,) :: a -> b -> (a,b), flip uncurry :: (->) (a,b) ((a->b->c) -> c)) |]),
                $(p [| ((,,) :: a -> b -> c -> (a,b,c), Left :: a -> Either a b, Right :: b -> Either a b,
                                    zip  :: (->) [a] ((->) [b] [(a, b)]),
                                    zip3 :: (->) [a] ((->) [b] ((->) [c] [(a, b, c)])),
                                    unzip  :: (->) [(a, b)]    ([a], [b]),
                                    unzip3 :: (->) [(a, b, c)] ([a], [b], [c]),
                                    odd :: Int -> Bool, even :: Int -> Bool) |])
              ] -- My version of enumFromThenTo is used. The problem of the library version is that enumFromThenTo 1 1 2 is infinite.
fromDataList :: [[Primitive]]
fromDataList = [$(p [| (sortBy, nubBy, deleteBy, dropWhileEnd, transpose -- , stripPrefix :: [Char]->[Char]->Maybe [Char],
                       )|]),
                $(p [| (
                       find :: (a -> Bool) -> [a] -> Maybe a, flip findIndex :: (->) [a] ((a -> Bool) -> Maybe Int), flip findIndices :: (->) [a] ((a -> Bool) -> [Int]), deleteFirstsBy, unionBy :: (a -> a -> Bool) -> (->) [a] ([a] -> [a]), intersectBy :: (a -> a -> Bool) -> (->) [a] ([a] -> [a]), groupBy, insertBy -- , maximumBy, minimumBy
                       ) |]),
                $(p [| (intersperse, subsequences, permutations,
                       inits, tails,                                
                       flip . flip mapAccumL :: acc -> (->) [x] ((acc -> x -> (acc, y)) -> (acc, [y])),
                       flip . flip mapAccumR :: acc -> (->) [x] ((acc -> x -> (acc, y)) -> (acc, [y]))

                       -- , isPrefixOf :: [Char] -> [Char] -> Bool, isSuffixOf :: [Char] -> [Char] -> Bool, isInfixOf :: [Char] -> [Char] -> Bool
                       ) |])]
fromDataChar :: [[Primitive]]
fromDataChar = [$(p [| (toUpper :: (->) Char Char, toLower :: (->) Char Char) |])[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++
                $(p [| (ord, isControl :: (->) Char Bool, isSpace :: (->) Char Bool, isLower :: (->) Char Bool, isUpper :: (->) Char Bool, isAlpha :: (->) Char Bool, isAlphaNum :: (->) Char Bool, isDigit :: (->) Char Bool, isSymbol :: (->) Char Bool, isPunctuation :: (->) Char Bool, isPrint :: (->) Char Bool) |]),
                $(p [| (isOctDigit :: (->) Char Bool, isHexDigit :: (->) Char Bool) |]), 
                []]
fromDataMaybe :: [[Primitive]]
fromDataMaybe = [[],
                 $(p [| (catMaybes, listToMaybe :: (->) [a] (Maybe a), maybeToList :: (->) (Maybe a) [a]) |]),
                 []]
                -- mapMaybe f = catMaybes . map f

pgWithDoubleRatio :: ProgGenSF
pgWithDoubleRatio :: ProgGenSF
pgWithDoubleRatio = Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> ProgGenSF
forall pg.
ProgramGenerator pg =>
Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
mkPGXOpt Options
forall a. Opt a
options{tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20,timeout :: Maybe Int
timeout=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100000} ([Primitive]
eqs[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ords[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
doubleCls[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ratioCls) [(Primitive, Primitive)]
clspartialss [[Primitive]]
withDoubleRatio [[(Primitive, Primitive)]]
tupartialssNormal
pgWithDoubleRatios :: [ProgGenSF]
pgWithDoubleRatios :: [ProgGenSF]
pgWithDoubleRatios = (Int -> ProgGenSF) -> [Int] -> [ProgGenSF]
forall a b. (a -> b) -> [a] -> [b]
map Int -> ProgGenSF
forall pg. ProgramGenerator pg => Int -> pg
pgWithDoubleRatioSized [Int
0..]
  where pgWithDoubleRatioSized :: Int -> pg
pgWithDoubleRatioSized Int
sz = Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
forall pg.
ProgramGenerator pg =>
Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
mkPGXOpt Options
forall a. Opt a
options{memoCondPure :: Type -> Int -> Bool
memoCondPure = \Type
t Int
d -> Type -> Int
size Type
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz Bool -> Bool -> Bool
&& Int
0Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
d {- && d<7 -}, tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20,timeout :: Maybe Int
timeout=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100000} ([Primitive]
eqs[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ords[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
doubleCls[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ratioCls) [(Primitive, Primitive)]
clspartialss [[Primitive]]
withDoubleRatio [[(Primitive, Primitive)]]
tupartialssNormal

withDoubleRatio :: [[Primitive]]
withDoubleRatio = ([Primitive] -> [Primitive] -> [Primitive])
-> [[Primitive]] -> [[Primitive]] -> [[Primitive]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
(++) [[Primitive]]
withRatio [[Primitive]]
fromPrelDouble

pgWithRatio :: ProgGenSF
pgWithRatio :: ProgGenSF
pgWithRatio = Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> ProgGenSF
forall pg.
ProgramGenerator pg =>
Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
mkPGXOpt Options
forall a. Opt a
options{tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20,timeout :: Maybe Int
timeout=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100000} ([Primitive]
eqs[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ords[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ratioCls) [(Primitive, Primitive)]
clspartialss [[Primitive]]
withRatio [[(Primitive, Primitive)]]
tupartialssNormal
pgWithRatios :: [ProgGenSF]
pgWithRatios :: [ProgGenSF]
pgWithRatios = (Int -> ProgGenSF) -> [Int] -> [ProgGenSF]
forall a b. (a -> b) -> [a] -> [b]
map Int -> ProgGenSF
forall pg. ProgramGenerator pg => Int -> pg
pgWithRatioSized [Int
0..]
  where pgWithRatioSized :: Int -> pg
pgWithRatioSized Int
sz = Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
forall pg.
ProgramGenerator pg =>
Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
mkPGXOpt Options
forall a. Opt a
options{memoCondPure :: Type -> Int -> Bool
memoCondPure = \Type
t Int
d -> Type -> Int
size Type
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz Bool -> Bool -> Bool
&& Int
0Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
d {- && d<7 -}, tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20,timeout :: Maybe Int
timeout=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100000} ([Primitive]
eqs[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ords[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ratioCls) [(Primitive, Primitive)]
clspartialss [[Primitive]]
withRatio [[(Primitive, Primitive)]]
tupartialssNormal

-- pgRatio and pgRatios are currently for debugging, but there may be other uses.
pgRatio :: ProgGenSF
pgRatio :: ProgGenSF
pgRatio = Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> ProgGenSF
forall pg.
ProgramGenerator pg =>
Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
mkPGXOpt Options
forall a. Opt a
options{tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20,timeout :: Maybe Int
timeout=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100000} [Primitive]
ratioCls [] (([Primitive] -> [Primitive] -> [Primitive])
-> [[Primitive]] -> [[Primitive]] -> [[Primitive]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
(++) [[Primitive]]
fromPrelRatio [[Primitive]]
fromDataRatio) [[],[],[]]
pgRatios :: [ProgGenSF]
pgRatios :: [ProgGenSF]
pgRatios = (Int -> ProgGenSF) -> [Int] -> [ProgGenSF]
forall a b. (a -> b) -> [a] -> [b]
map Int -> ProgGenSF
forall pg. ProgramGenerator pg => Int -> pg
pgWithRatioSized [Int
0..]
  where pgWithRatioSized :: Int -> pg
pgWithRatioSized Int
sz = Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
forall pg.
ProgramGenerator pg =>
Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
mkPGXOpt Options
forall a. Opt a
options{memoCondPure :: Type -> Int -> Bool
memoCondPure = \Type
t Int
d -> Type -> Int
size Type
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz Bool -> Bool -> Bool
&& Int
0Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
d {- && d<7 -}, tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20,timeout :: Maybe Int
timeout=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100000} [Primitive]
ratioCls []  (([Primitive] -> [Primitive] -> [Primitive])
-> [[Primitive]] -> [[Primitive]] -> [[Primitive]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
(++) [[Primitive]]
fromPrelRatio [[Primitive]]
fromDataRatio) [[],[],[]]

withRatio :: [[Primitive]]
withRatio = ([[Primitive]] -> [[Primitive]] -> [[Primitive]])
-> [[Primitive]] -> [[[Primitive]]] -> [[Primitive]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (([Primitive] -> [Primitive] -> [Primitive])
-> [[Primitive]] -> [[Primitive]] -> [[Primitive]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
(++)) [[Primitive]]
full [[[Primitive]]
fromPrelRatio, [[Primitive]]
fromDataRatio]

ratioCls :: [Primitive]
ratioCls = $(p [| (eq :: Equivalence (Ratio Int), cmp :: Ordered (Ratio Int)) |])
fromPrelRatio :: [[Primitive]]
fromPrelRatio = [ $(p [| (1      :: Ratio Int, 
                          10     :: Ratio Int,
                          100     :: Ratio Int,
                          1000     :: Ratio Int,
                          succ   :: Ratio Int -> Ratio Int,
                          negate :: Ratio Int -> Ratio Int,
                          abs    :: Ratio Int -> Ratio Int,
                          sum    :: (->) [Ratio Int] (Ratio Int),
                          product :: (->) [Ratio Int] (Ratio Int),
                          (+) :: Ratio Int -> Ratio Int -> Ratio Int,
                          (-) :: Ratio Int -> Ratio Int -> Ratio Int,
                          (*) :: Ratio Int -> Ratio Int -> Ratio Int,
                          (/) :: Ratio Int -> Ratio Int -> Ratio Int,
                          fromIntegral :: Int -> Ratio Int,
                          properFraction :: (->) (Ratio Int) (Int, Ratio Int),
                          round   :: (->) (Ratio Int) Int,
                          floor   :: (->) (Ratio Int) Int,
                          ceiling :: (->) (Ratio Int) Int,
                          (^^) :: Ratio Int -> Int -> Ratio Int) |]),
                  [],
                  [] ]
fromDataRatio :: [[Primitive]]
fromDataRatio = [  
                  $(p [| ((%)  :: Int -> Int -> Ratio Int,
                          numerator   :: (->) (Ratio Int) Int,
                          denominator :: (->) (Ratio Int) Int) |]),                                            
                  [], [] ]

pgWithDouble :: ProgGenSF
pgWithDouble :: ProgGenSF
pgWithDouble = Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> ProgGenSF
forall pg.
ProgramGenerator pg =>
Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
mkPGXOpt Options
forall a. Opt a
options{tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20,timeout :: Maybe Int
timeout=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100000} ([Primitive]
eqs[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ords[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
doubleCls) [(Primitive, Primitive)]
clspartialss [[Primitive]]
withDouble [[(Primitive, Primitive)]]
tupartialssNormal
pgWithDoubles :: [ProgGenSF]
pgWithDoubles :: [ProgGenSF]
pgWithDoubles = (Int -> ProgGenSF) -> [Int] -> [ProgGenSF]
forall a b. (a -> b) -> [a] -> [b]
map Int -> ProgGenSF
forall pg. ProgramGenerator pg => Int -> pg
pgWithDoubleSized [Int
0..]
  where pgWithDoubleSized :: Int -> pg
pgWithDoubleSized Int
sz = Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
forall pg.
ProgramGenerator pg =>
Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> pg
mkPGXOpt Options
forall a. Opt a
options{memoCondPure :: Type -> Int -> Bool
memoCondPure = \Type
t Int
d -> Type -> Int
size Type
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz Bool -> Bool -> Bool
&& Int
0Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
d {- && d<7 -}, tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20,timeout :: Maybe Int
timeout=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100000} ([Primitive]
eqs[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ords[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
doubleCls) [(Primitive, Primitive)]
clspartialss [[Primitive]]
withDouble [[(Primitive, Primitive)]]
tupartialssNormal

mkPgWithDouble :: IO ProgGenSF
mkPgWithDouble :: IO ProgGenSF
mkPgWithDouble = (Common
 -> [Typed [CoreExpr]]
 -> [[Typed [CoreExpr]]]
 -> [[Typed [CoreExpr]]]
 -> IO ProgGenSF)
-> Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> IO ProgGenSF
forall a.
(Common
 -> [Typed [CoreExpr]]
 -> [[Typed [CoreExpr]]]
 -> [[Typed [CoreExpr]]]
 -> a)
-> Options
-> [Primitive]
-> [(Primitive, Primitive)]
-> [[Primitive]]
-> [[(Primitive, Primitive)]]
-> a
mkPGXOpts Common
-> [Typed [CoreExpr]]
-> [[Typed [CoreExpr]]]
-> [[Typed [CoreExpr]]]
-> IO ProgGenSF
forall e.
Expression e =>
Common
-> [Typed [CoreExpr]]
-> [[Typed [CoreExpr]]]
-> [[Typed [CoreExpr]]]
-> IO (PGSF e)
mkTrieOptSFIO Options
forall a. Opt a
options{tv1 :: Bool
tv1=Bool
True,nrands :: [Int]
nrands=Int -> [Int]
forall a. a -> [a]
repeat Int
20,timeout :: Maybe Int
timeout=Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100000} ([Primitive]
eqs[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
ords[Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++[Primitive]
doubleCls) [(Primitive, Primitive)]
clspartialss [[Primitive]]
withDouble [[(Primitive, Primitive)]]
tupartialssNormal

withDouble :: [[Primitive]]
withDouble = ([Primitive] -> [Primitive] -> [Primitive])
-> [[Primitive]] -> [[Primitive]] -> [[Primitive]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
(++) [[Primitive]]
full [[Primitive]]
fromPrelDouble

doubleCls :: [Primitive]
doubleCls = $(p [| ( -- eq :: Equivalence Double,
                    cmp :: Ordered Double) |])
fromPrelDouble :: [[Primitive]]
fromPrelDouble= [ $(p [| (1      :: Double, 
                          10     :: Double,
                          100     :: Double,
                          1000     :: Double,
                          succ   :: Double -> Double,
                          negate :: Double -> Double,
                          abs    :: Double -> Double,
                          signum :: Double -> Double,
                          recip  :: Double -> Double,
                          sum    :: (->) [Double] Double,
                          product :: (->) [Double] Double,
                          (+) :: Double -> Double -> Double,
                          (-) :: Double -> Double -> Double,
                          (*) :: Double -> Double -> Double,
                          (/) :: Double -> Double -> Double,
                          fromIntegral :: Int -> Double,
                          properFraction :: (->) Double (Int, Double),
                          round   :: (->) Double Int,
                          floor   :: (->) Double Int,
                          ceiling :: (->) Double Int,
                          truncate :: (->) Double Int,
                          (^^) :: Double -> Int -> Double,
                          pi :: Double
                          ) |]),
                  $(p [| (          
                          exp :: Double -> Double,
                          log :: Double -> Double,
                          sqrt :: Double -> Double,
                          (**) :: Double -> Double -> Double,
                          logBase :: Double -> Double -> Double,
                          sin :: Double -> Double,
                          cos :: Double -> Double,
                          tan :: Double -> Double,
                          asin :: Double -> Double,
                          acos :: Double -> Double,
                          atan :: Double -> Double,
                          sinh :: Double -> Double,
                          cosh :: Double -> Double,
                          tanh :: Double -> Double,
                          asinh :: Double -> Double,
                          acosh :: Double -> Double,
                          atanh :: Double -> Double,
                          floatDigits :: Double -> Int,
                          exponent :: Double -> Int,
                          significand :: Double -> Double,
                          scaleFloat :: Int -> Double -> Double,
                          atan2 :: Double -> Double -> Double
                         ) |]),
                  [] ]