-- -- (c) Susumu Katayama -- -- This file is supposed to be used with Version 0.8.5 of MagicHaskeller. -- For previous versions, try: -- darcs get http://nautilus.cs.miyazaki-u.ac.jp/~skata/ somedirectoryname -- and retrieve an older version via some darcs command. {-# OPTIONS -XTemplateHaskell -XNoMonomorphismRestriction -cpp #-} 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 = False -- This is False, because we now use succ :: Char->Char. -- total variants of prelude functions last' = (\x xs -> last (x:xs)) tail = drop 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 x y = gcd' (abs x) (abs y) where gcd' a 0 = a gcd' a b = gcd' b (a `rem` 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 l m n = map toEnum $ case compare lint mint of EQ -> error "MagicHaskeller.LibTH.enumFromThenTo m m n" LT -> takeWhile (<=nint) $ iterate (+(mint-lint)) lint GT -> takeWhile (>=nint) $ iterate (+(mint-lint)) lint where lint = fromEnum l mint = fromEnum m nint = fromEnum n initialize, init075, inittv1 :: IO () initialize = do setPrimitives [] (list ++ nat ++ natural ++ mb ++ bool ++ $(p [| hd :: (->) [a] (Maybe a) |]) ++ plusInt ++ plusInteger) setDepth 10 -- MagicHaskeller version 0.8 ignores the setDepth value and always memoizes. init075 = do setPG $ mkMemo075 [] (list ++ nat ++ natural ++ mb ++ bool ++ plusInt ++ plusInteger) setDepth 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 = do setPG $ mkPGOpt (options{primopt = Nothing, tv1 = True}) [] (list ++ nat ++ natural ++ mb ++ bool ++ tuple ++ $(p [| (hd :: (->) [a] (Maybe a)) |]) ++ plusInt ++ plusInteger ) setDepth 10 tuple = $(p [| ((,) :: a -> b -> (a,b), uncurry :: (a->b->c) -> (->) (a,b) c) |]) 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 = mkPG (list ++ nat ++ natural ++ mb ++ bool ++ $(p [| hd :: (->) [a] (Maybe a) |]) ++ plusInt ++ plusInteger) mlist = mkPG list mlist' = mkPG list' mnat = mkPG (nat ++ plusInt) mnatural = mkPG (natural ++ plusInteger) mlistnat = mkPG (list ++ nat ++ plusInt) mlistnatural = mkPG (list ++ natural ++ plusInteger) mnat_nc = mkMemo (nat ++ plusInt) hd :: [a] -> Maybe a hd [] = Nothing hd (x:_) = Just x -- Prefixed (->) means that the parameter can be matched as an assumption when 'constrL' option is True. Also, this info is used when 'guess' option is True. For example of maybe :: a -> (b->a) -> (->) (Maybe b) a, -- Gamma |- A Gamma,B |- A -- ---------------------------maybe -- Gamma, Maybe B |- A -- rather than -- Gamma |- A Gamma,B |- A Gamma |- Maybe B -- -----------------------------------------------maybe -- Gamma |- A -- This is just for the efficiency reason, and one can use the infixed form, i.e., maybe :: a -> (b->a) -> Maybe b -> a, if efficiency does not matter. In fact, this info is ignored if both 'guess' and 'constrL' options are False. mb, 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 = $(p [| ( Nothing :: Maybe a, Just :: a -> Maybe a, maybe :: a -> (b->a) -> (->) (Maybe b) a ) |] ) mb' = $(p [| ( Nothing :: Maybe a, Just :: a -> Maybe a, flip . maybe :: a -> (->) (Maybe b) ((b->a) -> a) ) |] ) nat = $(p [| (0 :: Int, (1+) :: Int->Int, nat_para :: (->) Int (a -> (Int -> a -> a) -> a)) |] ) natural = $(p [| (0 :: Integer, (1+) :: Integer->Integer, nat_para :: (->) Integer (a -> (Integer -> a -> a) -> a)) |] ) nat' = $(p [| (0 :: Int, (1+) :: Int->Int, nat_cata :: (->) Int (a -> (a -> a) -> a), pred :: Int->Int) |] ) nat'woPred = $(p [| (0 :: Int, (1+) :: Int->Int, nat_cata :: (->) Int (a -> (a -> a) -> a)) |] ) natural' = $(p [| (0 :: Integer, (1+) :: Integer->Integer, nat_cata :: (->) Integer (a -> (a -> a) -> a), pred :: Integer->Integer) |] ) plusInt = $(p [| (+) :: (->) Int ((->) Int Int) |]) plusInteger = $(p [| (+) :: (->) Integer ((->) Integer Integer) |]) -- Nat paramorphism nat_para :: Integral i => i -> a -> (i -> a -> a) -> a nat_para i x f = np (abs i) -- Version 0.8 does not deal with partial functions very well. where np 0 = x np i = let i' = i-1 in f i' (np i') -- 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 x f = nc (abs i) -- Version 0.8 does not deal with partial functions very well. where nc 0 = x nc i = f (nc (i-1)) list'' = $(p [| ([] :: [a], (:), flip . flip foldr :: a -> (->) [b] ((b -> a -> a) -> a), tail :: (->) [a] [a]) |] ) -- foldr's argument order makes the synthesis slower:) list' = $(p [| ([] :: [a], (:), foldr :: (b -> a -> a) -> a -> (->) [b] a, tail :: (->) [a] [a]) |] ) -- foldr's argument order makes the synthesis slower:) 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 [] x f = x list_para (y:ys) x f = f y ys (list_para ys x f) bool = $(p [| (True, False, iF :: (->) Bool (a -> a -> a)) |] ) iF :: Bool -> a -> a -> a iF True t f = t iF False t f = f -- | 'postprocess' replaces uncommon functions like catamorphisms with well-known functions. postprocess :: Exp -> Exp postprocess (AppE (AppE (AppE (InfixE (Just e1) (VarE name) (Just e2)) e3) e4) e5) | nameBase name == "." = postprocess $ ((e1 `AppE` (e2 `AppE` e3)) `AppE` e4) `AppE` e5 -- ad hoc pattern:S postprocess (AppE (AppE (AppE (AppE (ConE name) e1) e2) e3) e4) | nameBase name == "(,,,)" = postprocess $ TupE [e1, e2, e3, e4] postprocess (AppE (AppE (AppE (AppE (VarE name) e1) e2) e3) e4) | nameBase name == "flip" = postprocess $ ((e1 `AppE` e3) `AppE` e2) `AppE` e4 postprocess (AppE (InfixE (Just e1) (VarE name) (Just e2)) e3) | nameBase name == "." = postprocess $ e1 `AppE` (e2 `AppE` e3) postprocess (AppE (e@(AppE (AppE (ConE name) p) t)) f) | nameBase name == "(,,)" = postprocess $ TupE [p,t,f] postprocess (AppE (e@(AppE (AppE (VarE name) p) t)) f) = case nameBase name of "iF" -> CondE ppp ppt ppf "enumFromThenTo" -> ArithSeqE $ FromThenToR ppp ppt ppf "nat_cata" -> InfixE (Just $ (VarE (mkName "iterate") `AppE` ppf) `AppE` ppt) (VarE (mkName "!!")) -- Should I use genericIndex instead of (!!) also here? (Just $ case ppp of LitE (IntegerL i) -> LitE $ IntegerL $ abs i _ -> VarE (mkName "abs") `AppE` ppp) "flip" -> postprocess $ (ppp `AppE` ppf) `AppE` ppt "." -> postprocess (p `AppE` (t `AppE` f)) _ -> postprocess e `AppE` ppf where ppp = postprocess p ppt = postprocess t ppf = postprocess f postprocess (AppE f@(AppE (ConE name) lj) e) | nameBase name == "(,)" = postprocess $ TupE [lj, e] postprocess (AppE f@(AppE (VarE name) lj) e) = case nameBase name of "drop" -> case pplj of LitE (IntegerL j) | j<=0 -> ppe | j> 0 -> ppdrop j e _ -> (dropE `AppE` pplj) `AppE` ppe "enumFromTo" -> ArithSeqE $ FromToR pplj ppe "last'" -> case ppe of AppE (VarE rev) e' | nameBase rev == "reverse" -> ((VarE (mkName "foldr") `AppE` constE) `AppE` pplj) `AppE` e' -- last (x : reverse xs) ==> foldr const x xs _ -> VarE (mkName "last") `AppE` InfixE (Just pplj) (ConE $ mkName ":") (Just ppe) "filter" -> case ppe of AppE (VarE rev) e' | nameBase rev == "reverse" -> reverseE `AppE` ((VarE (mkName "filter") `AppE` pplj) `AppE` 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)) _ -> (VarE (mkName "filter") `AppE` pplj) `AppE` ppe _ -> postprocess f `AppE` ppe where pplj = postprocess lj ppe = postprocess e postprocess (AppE (InfixE m@(Just _) op Nothing) e) = postprocess (InfixE m op (Just e)) postprocess (AppE (InfixE Nothing op m@(Just _)) e) = postprocess (InfixE (Just e) op m) postprocess (AppE v@(VarE name) e) = case nameBase name of -- 'b':'y':'1':'_':nm -> VarE $ mkName$ by1 nm "tail" -> ppdrop 1 e "negate" -> case ppe of LitE (IntegerL i) -> LitE $ IntegerL $ (-i) LitE (RationalL r) -> LitE $ RationalL $ (-r) _ -> AppE v ppe "abs" -> case ppe of LitE (IntegerL i) -> LitE $ IntegerL $ abs i LitE (RationalL r) -> LitE $ RationalL $ abs r _ -> AppE (ppv v) ppe "floor" -> case ppe of LitE (IntegerL i) -> LitE $ IntegerL i LitE (RationalL r) -> LitE $ IntegerL $ floor r _ -> AppE v ppe "round" -> case ppe of LitE (IntegerL i) -> LitE $ IntegerL i LitE (RationalL r) -> LitE $ IntegerL $ round r _ -> AppE v ppe "ceiling" -> case ppe of LitE (IntegerL i) -> LitE $ IntegerL i LitE (RationalL r) -> LitE $ IntegerL $ ceiling r _ -> AppE v ppe "fromIntegral" -> case ppe of LitE i -> LitE i _ -> AppE v ppe "succ" -> case ppe of LitE (IntegerL i) -> LitE $ IntegerL $ succ i LitE (RationalL r) -> LitE $ RationalL $ succ r LitE (CharL c) -> LitE $ CharL $ succ c InfixE (Just (LitE (IntegerL n))) (VarE nm) (Just e) | nameBase nm == "+" -> InfixE (Just $ LitE $ IntegerL $ succ n) plusE (Just e) AppE (VarE nm) e | succOnlyForNumbers && nameBase nm == "succ" -> InfixE (Just $ LitE $ IntegerL 2) plusE (Just e) -- This is OK, if we use succ only for numbers. _ -> AppE (ppv v) ppe "reverse" -> case ppe of LitE (StringL xs) -> LitE $ StringL $ reverse xs ListE es -> ListE $ reverse $ map postprocess es ArithSeqE (FromToR (LitE (IntegerL f)) (LitE (IntegerL t))) -> ArithSeqE $ FromThenToR (LitE $ IntegerL t) (LitE $ IntegerL $ t-1) (LitE $ IntegerL f) AppE (VarE name) e' | nameBase name == "reverse" -> e' _ -> AppE reverseE ppe "length" -> case ppe of LitE (StringL xs) -> LitE $ IntegerL $ toInteger $ length xs ListE es -> LitE $ IntegerL $ toInteger $ length es ArithSeqE (FromToR (LitE (IntegerL f)) (LitE (IntegerL t))) -> LitE $ IntegerL $ t - f + 1 -- can be bottom, if t is less than f. AppE (VarE name) e' | nameBase name == "reverse" -> AppE lengthE 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. _ -> AppE lengthE ppe "sum" -> case ppe of AppE (VarE name) e' | nameBase name == "reverse" -> AppE sumE e' _ -> AppE sumE ppe "product" -> case ppe of AppE (VarE name) e' | nameBase name == "reverse" -> AppE productE e' _ -> AppE productE ppe nb -> case IM.lookup (hash nb) byMap of Just fun -> fun ppe $ AppE (ppv v) ppe Nothing -> AppE (ppv v) ppe where ppe = postprocess e -- The following pattern is actually unnecessary if only eta-long normal expressions will be generated. postprocess e@(VarE _) = ppv e postprocess (AppE f x) = postprocess f `AppE` postprocess x postprocess (InfixE me1 op me2) = let j1 = fmap postprocess me1 j2 = fmap postprocess me2 in case op of VarE opname -> case (j1,j2) of (Just (LitE (IntegerL i1)), Just (LitE (IntegerL i2))) -> case nameBase opname of "+" -> LitE $ IntegerL $ i1+i2 "-" -> LitE $ IntegerL $ i1-i2 "*" -> LitE $ IntegerL $ i1*i2 _ -> theDefault (Just (LitE (IntegerL i1)), Just (InfixE (Just (LitE (IntegerL i2))) (VarE inopn) me3)) | nameBase opname == "+" && nameBase inopn `elem` ["+","-"] -> InfixE (Just $ LitE $ IntegerL $ i1+i2) (VarE $ ppopn inopn) me3 _ -> theDefault where theDefault = InfixE j1 (VarE $ ppopn opname) j2 ConE opname -> InfixE j1 (ConE $ ppopn opname) j2 postprocess (LamE pats e) = ppLambda pats (postprocess e) postprocess (TupE es) = TupE (map postprocess es) postprocess (ListE es) = ListE (map postprocess es) postprocess (SigE e ty) = postprocess e `SigE` ty postprocess e = e byMap = IM.fromList $ byEqs++byOrds byEqs = (hash "deleteFirstsBy", skipEq "\\\\") : [ (hash $ xs++"By", skipEq xs) | xs <- ["nub","delete","union","intersect","group"]] byOrds = [ (hash $ xs++"By", skipOrd xs) | xs <- ["sort","insert","minimum","maximum"]] skip op namestr = \eqExp wholeExp -> case eqExp of VarE name | nameBase name == op -> VarE $ mkName namestr _ -> wholeExp skipEq = skip "==" skipOrd = skip "compare" shown `appearsIn` e = G.everything (||) (False `G.mkQ` (\name -> show (name::Name) == shown)) 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 [VarP n] (AppE e (VarE n')) | shown == show n' && not (shown `appearsIn` e) = e where shown = show n ppLambda [VarP n, VarP m, VarP l] (AppE (AppE (AppE e (VarE n')) (VarE m')) (VarE l')) | shown == show n' && showm == show m' && showl == show l' && free = e | shown == show m' && showm == show n' && showl == show l' && free = flipE `AppE` e where shown = show n showm = show m showl = show l free = not (shown `appearsIn` e) && not (showm `appearsIn` e) && not (showl `appearsIn` e) ppLambda [VarP n, VarP m] (AppE (AppE e (VarE n')) (VarE m')) | shown == show n' && showm == show m' && free = e | shown == show m' && showm == show n' && free = flipE `AppE` e where shown = show n showm = show m free = not (shown `appearsIn` e) && not (showm `appearsIn` e) -- postprocess (LamE [WildP] e) = constE `AppE` e -- not sure if this is more readable.... ppLambda [VarP n, WildP] (VarE n') | show n == show n' = constE ppLambda [VarP n] (VarE n') | show n == show n' = VarE (mkName "id") ppLambda [VarP n, VarP m] (InfixE (Just (VarE n')) op (Just (VarE m'))) | show n == show n' && show m == show m' = op ppLambda pats@[VarP n, VarP m] e@(InfixE (Just (VarE n')) op@(VarE opna) (Just (VarE m'))) = if show n == show m' && show m == show n' then case nameBase opna of "<" -> VarE (mkName ">") "<=" -> VarE (mkName ">=") "-" -> VarE (mkName "subtract") name | name `elem` ["==","/=","+","*","&&","||"] -> op | otherwise -> flipE `AppE` op else LamE pats e ppLambda [VarP n] (InfixE (Just (VarE n')) op (Just e)) | shown == show n' && not (shown `appearsIn` e) = case op of VarE name | nameBase name == "-" -> VarE (mkName "subtract") `AppE` e _ -> InfixE Nothing op (Just e) where shown = show n ppLambda [VarP n] (InfixE (Just e) op (Just (VarE n'))) | shown == show n' && not (shown `appearsIn` e) = InfixE (Just e) op Nothing where shown = show n ppLambda pats e = LamE pats e ppv e@(VarE name) | nameBase name `elem` ["iF", "nat_cata"] = LamE [ VarP n | n <- names ] (postprocess (AppE (AppE (AppE e p) t) f)) | nameBase name == "last'" = LamE [ VarP n | n <- tail names ] (postprocess (AppE (AppE e t) f)) | otherwise = VarE $ ppopn name where names = [ mkName [n] | n <- "ptf" ] [p,t,f] = map VarE names ppopn name = case nameModule name of Just 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. not $ mod `elem` ["Data.Map", "Data.Set", "Data.Text", "Data.ByteString"] -- These are just examples for now. -> mkName $ nameBase name _ -> name ppdrop m0j e = case postprocess e of AppE (AppE (VarE drn) (LitE (IntegerL i))) list | nameBase drn == "drop" -> droppy (m0j + i) list -- NB: m0j and i are both positive. ppe -> droppy m0j ppe where droppy i e = (dropE `AppE` (LitE $ IntegerL i)) `AppE` e constE = VarE $ mkName "const" flipE = VarE $ mkName "flip" plusE = VarE $ mkName "+" dropE = VarE $ mkName "drop" reverseE = VarE $ mkName "reverse" lengthE = VarE $ mkName "length" sumE = VarE $ mkName "sum" productE = VarE $ mkName "product" procSucc n (AppE (VarE name) e) | nameBase name == "succ" = procSucc (n+1) e procSucc n (LitE (CharL c)) = LitE $ CharL $ iterate succ c `genericIndex` n procSucc n (LitE (IntegerL i)) = LitE $ IntegerL $ n+i procSucc n (LitE (RationalL r)) = LitE $ RationalL $ fromInteger n + r procSucc n e | succOnlyForNumbers = InfixE (Just $ LitE $ IntegerL n) (VarE $ mkName "+") (Just $ postprocess e) -- This is OK, if we use succ only for numbers. | otherwise = iterate (AppE (VarE $ mkName "succ")) (postprocess e) `genericIndex` 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 (AppE (e@(AppE (AppE (VarE name) p) t)) f) = case nameBase name of "iF" -> [| if $(postprocessQ p) then $(postprocessQ t) else $(postprocessQ f) |] "nat_cata" -> [| iterate $(postprocessQ f) $(postprocessQ t) !! abs $(postprocessQ p) |] "nat_para" -> [| let {np 0 = $(postprocessQ t); np n = let i=n-1 in $(postprocessQ f) i (np i)} in np (abs $(postprocessQ p)) |] "list_para" -> [| let {lp [] = $(postprocessQ t); lp (y:ys) = $(postprocessQ f) y ys (lp ys)} in lp $(postprocessQ p) |] _ -> [| $(postprocessQ e) $(postprocessQ f) |] postprocessQ (AppE f 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 me1 op me2) = let fmapM f Nothing = return Nothing fmapM f (Just x) = fmap Just (f x) in liftM2 (\e1 e2 -> InfixE e1 op e2) (fmapM postprocessQ me1) (fmapM postprocessQ me2) postprocessQ (LamE pats e) = fmap (LamE pats) (postprocessQ e) postprocessQ (TupE es) = fmap TupE (mapM postprocessQ es) postprocessQ (ListE es) = fmap ListE (mapM postprocessQ es) postprocessQ (SigE e ty) = fmap (`SigE` ty) (postprocessQ e) postprocessQ e = return e exploit :: (Typeable a, Filtrable a) => Bool -- ^ whether to include functions with unused arguments -> (a -> Bool) -> IO () exploit withAbsents pred = filterThenF pred (everything (reallyall::ProgGenSF) withAbsents) >>= pprs 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 {undef :: a} undefs = map (\[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 (Part u) [] = u by1_head _ (x:_) = x (--#!!) :: Partial a -> [a] -> Int -> a (--#!!) (Part u) [] n = u (--#!!) (Part u) (x:xs) n = case compare n 0 of LT -> u EQ -> x GT -> (--#!!) (Part u) xs (n-1) prelPartial = $(p [| ( by1_head :: Partial a -> (->) [a] a, (--#!!) :: Partial a -> [a] -> (->) Int a) |] ) newtype Equivalence a = Eq {(--#==) :: a -> a -> Bool} eq = Eq (==) by1_eqMaybe :: Equivalence a -> Equivalence (Maybe a) by1_eqMaybe (Eq op) = Eq $ eqMaybeBy op eqMaybeBy _ Nothing Nothing = True eqMaybeBy _ Nothing (Just _) = False eqMaybeBy _ (Just _) Nothing = False eqMaybeBy e (Just x) (Just y) = e x y by1_eqList :: Equivalence a -> Equivalence [a] by1_eqList (Eq e) = Eq $ eqListBy e eqListBy _ [] [] = True eqListBy _ [] _ = False eqListBy _ _ [] = False eqListBy e (x:xs) (y:ys) = e x y && eqListBy e xs ys by2_eqEither :: Equivalence a -> Equivalence b -> Equivalence (Either a b) by2_eqEither (Eq e1) (Eq e2) = Eq $ eqEitherBy e1 e2 eqEitherBy e1 _ (Left x) (Left y) = e1 x y eqEitherBy _ _ (Left _) (Right _) = False eqEitherBy _ _ (Right _) (Left _) = False eqEitherBy _ e2 (Right x) (Right y) = e2 x y by2_eqPair :: Equivalence a -> Equivalence b -> Equivalence (a,b) by2_eqPair (Eq e1) (Eq e2) = Eq $ eqPairBy e1 e2 eqPairBy e1 e2 (x,y) (z,w) = e1 x z && e2 y w 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 = [$(p [| ((--#==) :: Equivalence a -> (->) a (a -> Bool), (--#/=) :: Equivalence a -> (->) a (a -> Bool)) |]), $(p [| by1_elem :: Equivalence a -> a -> [a] -> Bool |]), []] 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 (--#/=) (Eq e) x y = not $ e x y by1_elem :: Equivalence a -> a -> [a] -> Bool by1_elem (Eq e) k = any (e k) by1_group :: Equivalence a -> [a] -> [[a]] by1_group (Eq e) = groupBy e by1_nub :: Equivalence a -> [a] -> [a] by1_nub (Eq e) = nubBy e by1_isPrefixOf :: Equivalence a -> [a] -> [a] -> Bool by1_isPrefixOf _ [] _ = True by1_isPrefixOf _ _ [] = False by1_isPrefixOf e@(Eq op) (x:xs) (y:ys) = op x y && by1_isPrefixOf e xs ys by1_isSuffixOf :: Equivalence a -> [a] -> [a] -> Bool by1_isSuffixOf e xs ys = by1_isPrefixOf e (reverse xs) (reverse ys) by1_isInfixOf :: Equivalence a -> [a] -> [a] -> Bool by1_isInfixOf e xs ys = any (by1_isPrefixOf e xs) (tails ys) by1_stripPrefix :: Equivalence a -> [a] -> [a] -> Maybe [a] by1_stripPrefix eq [] ys = Just ys by1_stripPrefix eq@(Eq op) (x:xs) (y:ys) | op x y = by1_stripPrefix eq xs ys by1_stripPrefix _ _ _ = Nothing by1_lookup :: Equivalence a -> a -> (->) [(a, b)] (Maybe b) by1_lookup _ _ [] = Nothing by1_lookup eq@(Eq op) key ((x,y):xys) | op key x = Just y | otherwise = by1_lookup eq key xys newtype Ordered a = Ord {by1_compare :: a->a->Ordering} cmp = Ord compare by1_cmpMaybe :: Ordered a -> Ordered (Maybe a) by1_cmpMaybe (Ord compare) = Ord $ compareMaybeBy compare compareMaybeBy _ Nothing Nothing = EQ compareMaybeBy _ Nothing (Just _) = LT compareMaybeBy _ (Just _) Nothing = GT compareMaybeBy compare (Just x) (Just y) = compare x y by1_cmpList :: Ordered a -> Ordered [a] by1_cmpList (Ord compare) = Ord $ compareListBy compare compareListBy _ [] [] = EQ compareListBy _ [] _ = LT compareListBy _ _ [] = GT compareListBy compare (x:xs) (y:ys) = case compare x y of EQ -> compareListBy compare xs ys o -> o by2_cmpEither :: Ordered a -> Ordered b -> Ordered (Either a b) by2_cmpEither (Ord compare1) (Ord compare2) = Ord $ compareEitherBy compare1 compare2 compareEitherBy compare1 _ (Left x) (Left y) = compare1 x y compareEitherBy _ _ (Left _) (Right _) = LT compareEitherBy _ _ (Right _) (Left _) = GT compareEitherBy _ compare2 (Right x) (Right y) = compare2 x y by2_cmpPair :: Ordered a -> Ordered b -> Ordered (a, b) by2_cmpPair (Ord compare1) (Ord compare2) = Ord $ comparePairBy compare1 compare2 comparePairBy compare1 compare2 (x,y) (z,w) = case compare1 x z of EQ -> compare2 y w o -> o 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 = [$(p [| by1_compare :: Ordered a -> a->a->Ordering |]) ++ $(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 = [[],[],$(p [| by1_sort :: Ordered a -> [a] -> [a] |] )] (--#<=) (Ord compare) x y = case compare x y of GT -> False _ -> True (--#<) (Ord compare) x y = case compare x y of LT -> True _ -> False by1_max c x y = if (--#<=) c x y then y else x by1_min c x y = if (--#<=) c x y then x else y by1_sort (Ord compare) = sortBy compare intinst = intinst1++intinst2 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 = $(p [| ( div :: Int->Int->Int, mod :: Int->Int->Int, (^) :: Int->Int->Int ) |]) intinst2 = $(p [| ( gcd :: Int->Int->Int, lcm :: Int->Int->Int) |]) list1 = $(p [| (map :: (a -> b) -> (->) [a] [b], (++) :: (->) [a] ([a] -> [a]), filter :: (a -> Bool) -> [a] -> [a], concat :: (->) [[a]] [a], concatMap :: (a -> [b]) -> (->) [a] [b], length :: (->) [a] Int, replicate :: Int -> a -> [a], take :: Int -> [a] -> [a], drop :: Int -> [a] -> [a], takeWhile :: (a -> Bool) -> [a] -> [a], dropWhile :: (a -> Bool) -> [a] -> [a]) |] ) 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 = $(p [| ( lines :: [Char] -> [[Char]], words :: [Char] -> [[Char]], unlines :: [[Char]] -> [Char], unwords :: [[Char]] -> [Char] ) |] ) list3 = $(p [| (reverse :: [a] -> [a], and :: (->) [Bool] Bool, or :: (->) [Bool] Bool, any :: (a -> Bool) -> (->) [a] Bool, all :: (a -> Bool) -> (->) [a] Bool, zipWith :: (a->b->c) -> (->) [a] ((->) [b] [c]) ) |] ) 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 = $(p [| (1 ::Int, 2 :: Int, 3 :: Int) |]) reallyall :: ProgramGenerator pg => pg reallyall = mkPG rich nrnds = repeat 5 -- comment out (mkStdGen 123456) when using 0.8.3* #ifdef TFRANDOM generator = seedTFGen (3497676378205993723,16020016691208771845,6545968067796471226,2770936286170065919) #else generator = mkStdGen 123456 #endif -- Currently only the pg==ConstrLSF case makes sense. mix, poormix :: ProgramGenerator pg => pg mix = mkPGSF generator nrnds [] (list++bool) 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 = (list'' ++ nat'woPred ++ mb' ++ bool ++ plusInt ++ -- x $(p [| (hd :: [a] -> Maybe a, (+) :: Int -> Int -> Int) |]) ++ boolean ++ intinst1 ++ list1' ++ list3') rich = soso ++ list2 ++ intinst2 ++ $(p [| init :: [a] -> [a] |]) poormix = mkPGSF generator nrnds [] $(p [| ([] :: [a], True) |] ) rich -- just for debugging ra :: ProgramGenerator pg => pg ra = mkPG rich' rich' = (list'++bool++boolean++ list1 ++ list3) mx :: ProgramGenerator pg => pg mx = mkPGSF generator nrnds [] (list++bool) rich' 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 = mkPGXOpt options{tv1=True,nrands=repeat 20,timeout=Just 100000} (eqs++ords) clspartialss full 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 = map pgfullSized [0..] where pgfullSized sz = mkPGXOpt options{memoCondPure = \t d -> size t < sz && 0 [a], enumFromTo :: Int -> Int -> [Int], 1::Int, product :: [Int] -> Int, concatMap :: (a -> [b]) -> [a] -> [b]) |]), [],[]] -- deb = [ $(p [| (show :: Int->[Char]) |]), [],[]] -- x String o [Char] pgfullIO :: IO ProgGenSFIORef pgfullIO = mkPGXOptIO options{tv1=True,nrands=repeat 20} (eqs++ords) clspartialss full tupartialssNormal full = foldr zipAppend literals [fromPrelude, prelEqRelated, dataListEqRelated, prelOrdRelated, dataListOrdRelated, fromDataList, fromDataChar, fromDataMaybe] clspartialss :: [(Primitive,Primitive)] clspartialss = undefs tupartialss, tupartialssNormal :: [[(Primitive,Primitive)]] tupartialss = map (map (\[a,b] -> (a,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 = map (map (\[a,b] -> (a,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 = [$(p [|(1::Int, 2::Int, 3::Int, ' '::Char)|]), [], []] fromPrelude = [ -- prelPartial ++ soso ++ $(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)) |]) ++ intinst2 ++ $(p [| (sum :: (->) [Int] Int, product :: (->) [Int] Int) |]), list2 ++ $(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]) |])++ $(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 = [$(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 = [$(p [| (toUpper :: (->) Char Char, toLower :: (->) Char Char) |])++ $(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 = [[], $(p [| (catMaybes, listToMaybe :: (->) [a] (Maybe a), maybeToList :: (->) (Maybe a) [a]) |]), []] -- mapMaybe f = catMaybes . map f pgWithDoubleRatio :: ProgGenSF pgWithDoubleRatio = mkPGXOpt options{tv1=True,nrands=repeat 20,timeout=Just 100000} (eqs++ords++doubleCls++ratioCls) clspartialss withDoubleRatio tupartialssNormal pgWithDoubleRatios :: [ProgGenSF] pgWithDoubleRatios = map pgWithDoubleRatioSized [0..] where pgWithDoubleRatioSized sz = mkPGXOpt options{memoCondPure = \t d -> size t < sz && 0 size t < sz && 0 size t < sz && 0 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 = [ $(p [| ((%) :: Int -> Int -> Ratio Int, numerator :: (->) (Ratio Int) Int, denominator :: (->) (Ratio Int) Int) |]), [], [] ] pgWithDouble :: ProgGenSF pgWithDouble = mkPGXOpt options{tv1=True,nrands=repeat 20,timeout=Just 100000} (eqs++ords++doubleCls) clspartialss withDouble tupartialssNormal pgWithDoubles :: [ProgGenSF] pgWithDoubles = map pgWithDoubleSized [0..] where pgWithDoubleSized sz = mkPGXOpt options{memoCondPure = \t d -> size t < sz && 0 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 ) |]), [] ]