-- 
-- (c) Susumu Katayama
--
{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction, PatternGuards, CPP #-}
module MagicHaskeller.LibExcel(module MagicHaskeller.LibExcel, module MagicHaskeller.LibExcelStaged) where

import MagicHaskeller
import MagicHaskeller.LibExcelStaged
import MagicHaskeller.Types(size)
import Control.Monad(liftM2)
import Data.List
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

#ifdef SEMIGROUP
import Prelude hiding ((<>))
#endif


-- whether succ is used only for numbers or not
succOnlyForNumbers :: Bool
succOnlyForNumbers = Bool
True -- This is True for Excel.

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

-- init xs = zipWith const xs (drop 1 xs)


-- | 'ppExcel' replaces uncommon functions like catamorphisms with well-known functions.
ppExcel :: Exp -> Exp
ppExcel :: Exp -> Exp
ppExcel (AppE (AppE (AppE (AppE (AppE (AppE (VarE Name
name) Exp
e1) Exp
e2) Exp
e3) Exp
e4) Exp
e5) Exp
e6) | Just [Char]
stem <- [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"6'" ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
nb = [Char] -> [Exp] -> Exp
mkUncurried ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
stem) ((Exp -> Exp) -> [Exp] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Exp
ppExcel [Exp
e1, Exp
e2, Exp
e3, Exp
e4, Exp
e5, Exp
e6])
  where nb :: [Char]
nb = Name -> [Char]
nameBase Name
name
ppExcel (AppE (AppE (AppE (AppE (AppE (VarE Name
name) Exp
e1) Exp
e2) Exp
e3) Exp
e4) Exp
e5) | Just [Char]
stem <- [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"5'" ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
nb = [Char] -> [Exp] -> Exp
mkUncurried ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
stem) ((Exp -> Exp) -> [Exp] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Exp
ppExcel [Exp
e1, Exp
e2, Exp
e3, Exp
e4, Exp
e5])
  where nb :: [Char]
nb = Name -> [Char]
nameBase Name
name
ppExcel (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
ppExcel (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
ppExcel (AppE (AppE (InfixE (Just Exp
e1) (VarE Name
name) (Just Exp
e2)) Exp
e3) Exp
e4) | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"." = Exp -> Exp
ppExcel (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
ppExcel (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
ppExcel (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
tup [Exp
e1, Exp
e2, Exp
e3, Exp
e4]
ppExcel (AppE (AppE (AppE (AppE (VarE Name
name) Exp
e1) Exp
e2) Exp
e3) Exp
e4) | [Char]
nb [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"flip"             = Exp -> Exp
ppExcel (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
                                                            | [Char]
nb [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"sUBST4"           = [Char] -> [Exp] -> Exp
mkUncurried [Char]
"sUBSTITUTE" ((Exp -> Exp) -> [Exp] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Exp
ppExcel [Exp
e1, Exp
e2, Exp
e3, Exp -> [Char] -> Exp -> Exp
mkVarOp Exp
lit1 [Char]
"+" (Exp
absE Exp -> Exp -> Exp
`AppE` Exp
e4)])
                                                            | Just [Char]
stem <- [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"4'" ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
nb = [Char] -> [Exp] -> Exp
mkUncurried ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
stem) ((Exp -> Exp) -> [Exp] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Exp
ppExcel [Exp
e1, Exp
e2, Exp
e3, Exp
e4])
  where nb :: [Char]
nb = Name -> [Char]
nameBase Name
name
ppExcel (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
ppExcel (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)
ppExcel (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
ppExcel (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
tup [Exp
p,Exp
t,Exp
f]
ppExcel (AppE (e :: Exp
e@(AppE (AppE (VarE Name
name) Exp
p) Exp
t)) Exp
f)
    = case [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Name -> [Char]
nameBase Name
name of
        [Char]
"xIdnif"      -> Exp -> [Char] -> Exp -> Exp
mkVarOp ([Char] -> [Exp] -> Exp
mkUncurried [Char]
"finD" [Exp
char7, [Char] -> [Exp] -> Exp
mkUncurried [Char]
"sUBSTITUTE" [[Char] -> [Exp] -> Exp
mkUncurried [Char]
"concatenate" [Exp
ppp,Exp
ppt], Exp
ppp, Exp
char7, Exp -> Exp
ppExcel (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Exp -> [Char] -> Exp -> Exp
mkVarOp Exp
lit1 [Char]
"+" (Exp
absE Exp -> Exp -> Exp
`AppE` Exp
f) ]]) [Char]
"-" Exp
lit1   -- The "findIx" case.  findIx c xs n = finD(char(7), sUBSTITUTE(concatenate(c,xs), c, char(7), 1+abs(n)))-1
        [Char]
"pilf"        -> Exp -> Exp
ppExcel (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 -- The "flip" case
        [Char]
"."           -> Exp -> Exp
ppExcel (Exp
p Exp -> Exp -> Exp
`AppE` (Exp
t Exp -> Exp -> Exp
`AppE` Exp
f))
        Char
'3':Char
'\'':[Char]
stem -> Exp -> Exp
ppExcel (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> [Exp] -> Exp
mkUncurried ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
stem) [Exp
p,Exp
t,Exp
f]
        [Char]
_             -> Exp -> Exp
ppExcel Exp
e Exp -> Exp -> Exp
`AppE` Exp
ppf
  where ppp :: Exp
ppp = Exp -> Exp
ppExcel Exp
p
        ppt :: Exp
ppt = Exp -> Exp
ppExcel Exp
t
        ppf :: Exp
ppf = Exp -> Exp
ppExcel Exp
f
ppExcel (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
ppExcel (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
tup [Exp
lj, Exp
e]
ppExcel (AppE (AppE (VarE Name
name) Exp
e1) Exp
e2) | [Char]
nb [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"fLOOR0" = case Exp
ppe2 of LitE (IntegerL Integer
n) | Integer
nInteger -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>Integer
0 -> Exp
floore1e2
                                                                                          | Bool
otherwise -> Exp
lit0
                                                                        LitE (RationalL Rational
n) | Rational
nRational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>Rational
0 -> Exp
floore1e2
                                                                                           | Bool
otherwise -> Exp
lit0
                                                                        AppE (VarE Name
nm) Exp
_  | Name -> [Char]
nameBase Name
nm [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"pI" -> Exp
floore1e2 -- just to avoid the awkward case of iF(pI() > 0, blah)
                                                                        Exp
_                  -> Exp -> Exp -> Exp -> Exp
mkIF (Exp -> [Char] -> Exp -> Exp
mkVarOp Exp
ppe2 [Char]
">" Exp
lit0) Exp
floore1e2 Exp
lit0
                                        | [Char]
nb [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"countStr" = case Exp
ppe2 of LitE (StringL [Char]
"") -> Exp
lit0
                                                                          LitE (StringL [Char]
_)  -> Exp
counted
                                                                          ListE []          -> Exp
lit0
                                                                          ListE [Exp]
_           -> Exp
counted
                                                                          Exp
_                 -> Exp -> Exp -> Exp -> Exp
mkIF (Exp -> [Char] -> Exp -> Exp
mkVarOp Exp
ppe2 [Char]
"<>" (Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Lit
StringL [Char]
"")) Exp
counted Exp
lit0
                                        | [Char]
nb [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"dropLeft" = [Char] -> [Exp] -> Exp
mkUncurried [Char]
"right" [Exp
ppe1, Exp -> [Char] -> Exp -> Exp
mkVarOp (Exp -> Exp
ppExcel (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Exp
lenE Exp -> Exp -> Exp
`AppE` Exp
ppe1) [Char]
"-" Exp
ppe2]
                                        | Just [Char]
stem <- [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"2'" ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
nb = Exp -> Exp
ppExcel (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> [Exp] -> Exp
mkUncurried ([Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
stem) [Exp
e1, Exp
e2]
  where nb :: [Char]
nb = Name -> [Char]
nameBase Name
name
        ppe1 :: Exp
ppe1 = Exp -> Exp
ppExcel Exp
e1
        ppe2 :: Exp
ppe2 = Exp -> Exp
ppExcel Exp
e2
        counted :: Exp
counted = Exp -> Exp
ppExcel (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Exp -> [Char] -> Exp -> Exp
mkVarOp (Exp -> [Char] -> Exp -> Exp
mkVarOp (Exp
lenE Exp -> Exp -> Exp
`AppE` Exp
e1) [Char]
"-" (Exp
lenE Exp -> Exp -> Exp
`AppE` ([Exp] -> Exp
mkSUBST4 [Exp
e1, Exp
ppe2, Lit -> Exp
LitE ([Char] -> Lit
StringL [Char]
"")]))) [Char]
"/" (Exp
lenE Exp -> Exp -> Exp
`AppE` Exp
ppe2) -- countStr x str = (len(x)-len(sUBsTITUTE(x,str,""))) / len(str)
        floore1e2 :: Exp
floore1e2 = [Char] -> [Exp] -> Exp
mkUncurried [Char]
"fLOOR" [Exp
ppe1, Exp
ppe2]
ppExcel (AppE (InfixE m :: Maybe Exp
m@(Just Exp
_) Exp
op Maybe Exp
Nothing)    Exp
e) = Exp -> Exp
ppExcel (Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE Maybe Exp
m        Exp
op (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
e))
ppExcel (AppE (InfixE Maybe Exp
Nothing    Exp
op m :: Maybe Exp
m@(Just Exp
_)) Exp
e) = Exp -> Exp
ppExcel (Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
e) Exp
op Maybe Exp
m)
ppExcel (AppE v :: Exp
v@(VarE Name
name) Exp
e)
    = case Name -> [Char]
nameBase Name
name of
        [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 -> [Char] -> Exp -> Exp
mkVarOp (Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
0) [Char]
"-" Exp
ppe -- @negate x@ should become @0 - x@
        [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
                                ParensE Exp
_                -> Exp -> Exp -> Exp
AppE (Exp -> Exp
ppv Exp
v) Exp
ppe
                                Exp
_                        -> Exp -> Exp -> Exp
AppE (Exp -> Exp
ppv Exp
v) (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp
ParensE Exp
ppe
        [Char]
"floor"  -> Exp
ppe
        [Char]
"fromIntegral" -> 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]
"+"    -> Exp -> [Char] -> Exp -> Exp
mkVarOp (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) [Char]
"+" 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" -> Exp -> [Char] -> Exp -> Exp
mkVarOp (Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
2) [Char]
"+" 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]
"left1" -> 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
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 [Char]
xs
                       ListE [Exp]
es                 -> [Exp] -> Exp
ListE ([Exp] -> Exp) -> [Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ Int -> [Exp] -> [Exp]
forall a. Int -> [a] -> [a]
take Int
1 ([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
ppExcel [Exp]
es
                       ArithSeqE (FromToR (LitE (IntegerL Integer
f)) (LitE (IntegerL Integer
t))) -> [Exp] -> Exp
ListE [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]
"left1" -> Exp
ppe
                       Exp
_         -> Exp -> Exp -> Exp
AppE Exp
leftE (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
tup [Exp
ppe, Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
1]
        [Char]
"right1" -> 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], Int) -> [Char]
forall b. ([b], Int) -> [b]
right([Char]
xs,Int
1)
                       ListE [Exp]
es                 -> [Exp] -> Exp
ListE ([Exp] -> Exp) -> [Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ ([Exp], Int) -> [Exp]
forall b. ([b], Int) -> [b]
right((Exp -> Exp) -> [Exp] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Exp
ppExcel [Exp]
es, Int
1)
                       AppE (VarE Name
name) Exp
e' | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"right1" -> Exp
ppe
                       Exp
_         -> Exp -> Exp -> Exp
AppE Exp
rightE (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
tup [Exp
ppe, Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ Integer -> Lit
IntegerL Integer
1]
        [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
ppExcel [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]
"len" -> 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
lenE 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.
                       ParensE Exp
_ -> Exp -> Exp -> Exp
AppE Exp
lenE Exp
ppe
                       Exp
_         -> Exp -> Exp -> Exp
AppE Exp
lenE (Exp -> Exp
ParensE 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 Exp
ppe of 
                       TupE [Maybe Exp]
_                            -> Exp -> Exp -> Exp
AppE (Exp -> Exp
ppv Exp
v) Exp
ppe
                       ConE Name
name | Name -> [Char]
nameBase Name
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"()" -> Exp -> Exp -> Exp
AppE (Exp -> Exp
ppv Exp
v) Exp
ppe
                       Exp
_                                 -> Exp -> Exp -> Exp
AppE (Exp -> Exp
ppv Exp
v) (Exp -> Exp
ParensE Exp
ppe)
  where ppe :: Exp
ppe = Exp -> Exp
ppExcel Exp
e 
-- The following pattern is actually unnecessary if only eta-long normal expressions will be generated.
ppExcel e :: Exp
e@(VarE Name
_)          = Exp -> Exp
ppv Exp
e
ppExcel e :: Exp
e@(ConE Name
_)          = Exp -> Exp
ppv Exp
e
ppExcel (AppE Exp
f Exp
x)          = case Exp
ppx of
                                    TupE [Maybe Exp]
_ -> Exp -> Exp
ppExcel Exp
f Exp -> Exp -> Exp
`AppE` Exp
ppx
                                    Exp
_      -> Exp -> Exp
ppExcel Exp
f Exp -> Exp -> Exp
`AppE` Exp -> Exp
ParensE Exp
ppx
  where ppx :: Exp
ppx = Exp -> Exp
ppExcel Exp
x
ppExcel (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
ppExcel 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
ppExcel 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
                       (Just Exp
e, Just (LitE (IntegerL Integer
1)))
                                        | Name -> [Char]
nameBase Name
opname [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"/",[Char]
"*"] -> Exp
e
                       (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

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

ppExcel (TupE [Maybe Exp]
es)           = [Exp] -> Exp
tup ((Maybe Exp -> Exp) -> [Maybe Exp] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map (Exp -> Exp
ppExcel(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)
ppExcel (ListE [Exp]
es)          = [Exp] -> Exp
ListE ((Exp -> Exp) -> [Exp] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Exp
ppExcel [Exp]
es)
ppExcel (SigE Exp
e Type
ty)         = Exp -> Exp
ppExcel Exp
e Exp -> Type -> Exp
`SigE` Type
ty
ppExcel Exp
e = Exp
e


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



ppdrop :: Integer -> Exp -> Exp
ppdrop Integer
m0j Exp
e 
  = case Exp -> Exp
ppExcel 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"
leftE :: Exp
leftE = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"left"
rightE :: Exp
rightE = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"right"
lenE :: Exp
lenE   = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"len"
absE :: Exp
absE   = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
"abs"

mkIF :: Exp -> Exp -> Exp -> Exp
mkIF Exp
p Exp
t Exp
f  = Name -> Exp
VarE ([Char] -> Name
mkName [Char]
"iF")  Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
tup [Exp
p, Exp
t, Exp
f]
mkUncurried :: [Char] -> [Exp] -> Exp
mkUncurried [Char]
str [Exp]
es = Name -> Exp
VarE ([Char] -> Name
mkName [Char]
str) Exp -> Exp -> Exp
`AppE` [Exp] -> Exp
tup [Exp]
es
mkSUBST4 :: [Exp] -> Exp
mkSUBST4 = [Char] -> [Exp] -> Exp
mkUncurried [Char]
"sUBSTITUTE"
mkVarOp :: Exp -> [Char] -> Exp -> Exp
mkVarOp Exp
e1 [Char]
op Exp
e2 = Maybe Exp -> Exp -> Maybe Exp -> Exp
InfixE (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
e1) (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName [Char]
op) (Exp -> Maybe Exp
forall a. a -> Maybe a
Just Exp
e2)

char7 :: Exp
char7 = Name -> Exp
VarE ([Char] -> Name
mkName [Char]
"char") Exp -> Exp -> Exp
`AppE` Lit -> Exp
LitE (Integer -> Lit
IntegerL Integer
7)
lit0 :: Exp
lit0  = Lit -> Exp
LitE (Integer -> Lit
IntegerL Integer
0)
lit1 :: Exp
lit1  = Lit -> Exp
LitE (Integer -> Lit
IntegerL Integer
1)

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
ppExcel 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
ppExcel Exp
e) [Exp] -> Integer -> Exp
forall i a. Integral i => [a] -> i -> a
`genericIndex` Integer
n



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



mkPgExcel :: IO ProgGenSF
mkPgExcel :: IO ProgGenSF
mkPgExcel = (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{tv0 :: Bool
tv0=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]]
excel [[],[],[]]
mkPgExcels :: Int -> IO ProgGenSF
mkPgExcels :: Int -> IO ProgGenSF
mkPgExcels Int
sz = (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{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 -}, tv0 :: Bool
tv0=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]]
excel [[],[],[]]

<> :: a -> a -> Bool
(<>) = a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=)

-- doubleCls = $(p [| (eq :: Equivalence Double) |])

excel :: [[Primitive]]
excel = [$(p [| (" " :: [Char], "," :: [Char], "-" :: [Char], 
                 fromIntegral :: Int -> Double, floor :: Double -> Int, -- These two are hidden by ppExcel.
                 0::Int, 1::Int, (1+)::Int->Int, 3::Int,
                 0::Double, 1::Double, -- (1+)::Double->Double, 
                 (<) :: Int -> Int -> Bool, (<=) :: Int -> Int -> Bool, (<>) :: Int -> Int -> Bool, 
                 (<) :: Double -> Double -> Bool, -- (<=) :: Double -> Double -> Bool, (<>) :: Double -> Double -> Bool, 
                 (<>) :: [Char] -> [Char] -> Bool, 
                 not :: (->) Bool Bool, True :: Bool, False :: Bool, aND'2 :: (->) Bool ((->) Bool Bool), oR'2 :: (->) Bool ((->) Bool Bool), iF'3 :: (->) Bool (a -> a -> a),
                 (,) :: a -> b -> (a,b), (,,) :: a -> b -> c -> (a,b,c), (,,,) :: a -> b -> c -> d -> (a,b,c,d)) |])
         [Primitive] -> [Primitive] -> [Primitive]
forall a. [a] -> [a] -> [a]
++ $(p [| (
                                            upper::[Char]->[Char],                                             
                                            lower::[Char]->[Char],
                                            proper::[Char]->[Char],
                                            left1 :: [Char] -> [Char],
                                            right1 :: [Char] -> [Char],
                                            left'2 :: [Char] -> Int -> [Char],
                                            right'2 :: [Char] -> Int -> [Char],
                                            dropLeft :: [Char] -> Int -> [Char],
                                            mid'3 :: [Char] -> Int -> Int -> [Char],
                                            len :: (->) [Char] Int,
                                            concatenate'2 :: (->) [Char] ([Char] -> [Char]),
                                            concatenatE'3 :: (->) [Char] ([Char] -> [Char] -> [Char]),
                                            concatenaTE'4 :: (->) [Char] ([Char] -> [Char] -> [Char] -> [Char]),
                                            concatenATE'5 :: (->) [Char] ([Char] -> [Char] -> [Char] -> [Char] -> [Char]),
                                            concateNATE'6 :: (->) [Char] ([Char] -> [Char] -> [Char] -> [Char] -> [Char] -> [Char]),
                                            {-
                                            sum :: [Double] -> Double,
                                            product :: [Double] -> Double,
                                            max :: [Double] -> Double,
                                            min :: [Double] -> Double,
                                            average :: [Double] -> Double,
                                            count :: [Double] -> Double,
                                            sumif :: [Maybe Double] -> Double,
-}
                                            flip cEILING'2 . abs :: Double -> (->) Double Double,
                                            fLOOR0   :: (->) Double (Double -> Double),
                                            rOUND'2   :: (->) Double (Int -> Double),
                                            roundup'2 :: (->) Double (Int -> Double),
                                            rounddown'2 :: (->) Double (Int -> Double),
                                            trim::[Char]->[Char],
                                            fIND'3 :: [Char] -> [Char] -> Int -> Maybe Int,
                                            ifERROR'2 :: Maybe a -> a -> a,
                                            fact   :: Int -> Maybe Int,
                                            combin'2 :: Int -> Int -> Maybe Int, 
                                            mOD'2    :: Int -> Int -> Maybe Int,
                                            degrees :: Double -> Double,
                                            radians :: Double -> Double,
                                            findIx  :: [Char] -> [Char] -> Int -> Int,
                                            sUBsTITUTE'3 :: [Char] -> [Char] -> [Char] -> [Char],
                                            sUBST4 :: [Char] -> [Char] -> [Char] -> Int -> [Char],
                                            countStr :: [Char] -> [Char] -> Int,
                          negate :: Int -> Int,
                          abs    :: Int -> Int,
                          (+) :: (->) Int ((->) Int Int),
                          (-) :: Int -> Int -> Int,
                          (*) :: Int -> Int -> Int,
                          10     :: Double,
                          100     :: Double,
                          1000     :: Double,
                          negate :: Double -> Double,
                          abs    :: Double -> Double,
                          sign :: Double -> Double,
--                          recip  :: Double -> Double,  -- (1/) だけど、まあ(/)と1で作れるし、いらんやろ。
                          (+) :: (->) Double ((->) Double Double),
                          (-) :: Double -> Double -> Double,
                          (*) :: Double -> Double -> Double,
                          (/) :: Double -> Double -> Double, -- 本当はエラー処理すべし。
--                          fromIntegral :: Int -> Double,
                          pI () :: Double
                          ) |]),
                  $(p [| (          
                          exp :: Double -> Double,
                          ln  :: Double -> Maybe Double,
                          sQRT :: Double -> Maybe Double,
                          power'2 :: Double -> Double -> Maybe Double,
                          lOG'2 :: Double -> Double -> Maybe 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'2 :: Double -> Double -> Double
                         ) |]),
                  [] ]