module Test.FitSpec.ShowMutable
( ShowMutable (..)
, mutantSEq
, showMutantAsTuple
, showMutantNested
, showMutantDefinition
, showMutantBindings
, MutantS ()
, mutantSTuple
)
where
import Test.FitSpec.PrettyPrint
import Test.LeanCheck.Error (errorToNothing, Listable(..))
import Data.Maybe (mapMaybe,isNothing)
import Control.Monad (join)
import Data.List (intercalate,tails)
import Data.Char (isLetter)
import Data.Ratio (Ratio)
import Data.Word (Word)
showMutantAsTuple :: ShowMutable a => [String] -> a -> a -> String
showMutantAsTuple :: [String] -> a -> a -> String
showMutantAsTuple [String]
names a
f a
f' = [String] -> MutantS -> String
showMutantSAsTuple [String]
names
(MutantS -> String) -> MutantS -> String
forall a b. (a -> b) -> a -> b
$ MutantS -> MutantS
flatten
(MutantS -> MutantS) -> MutantS -> MutantS
forall a b. (a -> b) -> a -> b
$ a -> a -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS a
f a
f'
showMutantBindings :: ShowMutable a => [String] -> a -> a -> String
showMutantBindings :: [String] -> a -> a -> String
showMutantBindings [String]
names a
f a
f' = Bool -> [String] -> MutantS -> String
showMutantSBindings Bool
False [String]
names
(MutantS -> String) -> MutantS -> String
forall a b. (a -> b) -> a -> b
$ MutantS -> MutantS
flatten
(MutantS -> MutantS) -> MutantS -> MutantS
forall a b. (a -> b) -> a -> b
$ a -> a -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS a
f a
f'
showMutantDefinition :: ShowMutable a => [String] -> a -> a -> String
showMutantDefinition :: [String] -> a -> a -> String
showMutantDefinition [String]
names a
f a
f' = Bool -> [String] -> MutantS -> String
showMutantSBindings Bool
True [String]
names
(MutantS -> String) -> MutantS -> String
forall a b. (a -> b) -> a -> b
$ MutantS -> MutantS
flatten
(MutantS -> MutantS) -> MutantS -> MutantS
forall a b. (a -> b) -> a -> b
$ a -> a -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS a
f a
f'
showMutantNested :: ShowMutable a => [String] -> a -> a -> String
showMutantNested :: [String] -> a -> a -> String
showMutantNested [String]
names a
f a
f' = [String] -> MutantS -> String
showMutantSAsTuple [String]
names
(MutantS -> String) -> MutantS -> String
forall a b. (a -> b) -> a -> b
$ a -> a -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS a
f a
f'
showMutant :: ShowMutable a => a -> a -> String
showMutant :: a -> a -> String
showMutant = [String] -> a -> a -> String
forall a. ShowMutable a => [String] -> a -> a -> String
showMutantAsTuple []
defaultFunctionNames :: [String]
defaultFunctionNames :: [String]
defaultFunctionNames = [String
"f",String
"g",String
"h"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'") [String]
defaultFunctionNames
defaultNames :: [String]
defaultNames :: [String]
defaultNames = [String] -> String
forall a. [a] -> a
head [String]
defaultFunctionNames String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
defVarNames
where defVarNames :: [String]
defVarNames = [String
"x",String
"y",String
"z",String
"w"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'") [String]
defVarNames
class ShowMutable a where
mutantS :: a -> a -> MutantS
mutantSEq :: (Eq a, Show a)
=> a -> a -> MutantS
mutantSEq :: a -> a -> MutantS
mutantSEq a
x a
x' = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x'
then String -> MutantS
Unmutated (String -> MutantS) -> String -> MutantS
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x
else String -> MutantS
Atom (String -> MutantS) -> String -> MutantS
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x'
instance ShowMutable () where mutantS :: () -> () -> MutantS
mutantS = () -> () -> MutantS
forall a. (Eq a, Show a) => a -> a -> MutantS
mutantSEq
instance ShowMutable Int where mutantS :: Int -> Int -> MutantS
mutantS = Int -> Int -> MutantS
forall a. (Eq a, Show a) => a -> a -> MutantS
mutantSEq
instance ShowMutable Integer where mutantS :: Integer -> Integer -> MutantS
mutantS = Integer -> Integer -> MutantS
forall a. (Eq a, Show a) => a -> a -> MutantS
mutantSEq
instance ShowMutable Char where mutantS :: Char -> Char -> MutantS
mutantS = Char -> Char -> MutantS
forall a. (Eq a, Show a) => a -> a -> MutantS
mutantSEq
instance ShowMutable Bool where mutantS :: Bool -> Bool -> MutantS
mutantS = Bool -> Bool -> MutantS
forall a. (Eq a, Show a) => a -> a -> MutantS
mutantSEq
instance (Eq a, Show a) => ShowMutable [a] where mutantS :: [a] -> [a] -> MutantS
mutantS = [a] -> [a] -> MutantS
forall a. (Eq a, Show a) => a -> a -> MutantS
mutantSEq
instance (Eq a, Show a) => ShowMutable (Maybe a) where mutantS :: Maybe a -> Maybe a -> MutantS
mutantS = Maybe a -> Maybe a -> MutantS
forall a. (Eq a, Show a) => a -> a -> MutantS
mutantSEq
instance (Eq a, Show a, Eq b, Show b) => ShowMutable (Either a b)
where mutantS :: Either a b -> Either a b -> MutantS
mutantS = Either a b -> Either a b -> MutantS
forall a. (Eq a, Show a) => a -> a -> MutantS
mutantSEq
instance (Eq a, Show a, Integral a) => ShowMutable (Ratio a)
where mutantS :: Ratio a -> Ratio a -> MutantS
mutantS = Ratio a -> Ratio a -> MutantS
forall a. (Eq a, Show a) => a -> a -> MutantS
mutantSEq
instance ShowMutable Float where mutantS :: Float -> Float -> MutantS
mutantS = Float -> Float -> MutantS
forall a. (Eq a, Show a) => a -> a -> MutantS
mutantSEq
instance ShowMutable Double where mutantS :: Double -> Double -> MutantS
mutantS = Double -> Double -> MutantS
forall a. (Eq a, Show a) => a -> a -> MutantS
mutantSEq
instance ShowMutable Ordering where mutantS :: Ordering -> Ordering -> MutantS
mutantS = Ordering -> Ordering -> MutantS
forall a. (Eq a, Show a) => a -> a -> MutantS
mutantSEq
instance ShowMutable Word where mutantS :: Word -> Word -> MutantS
mutantS = Word -> Word -> MutantS
forall a. (Eq a, Show a) => a -> a -> MutantS
mutantSEq
instance (Listable a, Show a, ShowMutable b) => ShowMutable (a->b) where
mutantS :: (a -> b) -> (a -> b) -> MutantS
mutantS a -> b
f a -> b
f' = [([String], MutantS)] -> MutantS
Function
([([String], MutantS)] -> MutantS)
-> ([a] -> [([String], MutantS)]) -> [a] -> MutantS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [([String], MutantS)] -> [([String], MutantS)]
forall a. Int -> [a] -> [a]
take Int
10
([([String], MutantS)] -> [([String], MutantS)])
-> ([a] -> [([String], MutantS)]) -> [a] -> [([String], MutantS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], MutantS) -> Bool)
-> [([String], MutantS)] -> [([String], MutantS)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (([String], MutantS) -> Bool) -> ([String], MutantS) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutantS -> Bool
isUnmutated (MutantS -> Bool)
-> (([String], MutantS) -> MutantS) -> ([String], MutantS) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], MutantS) -> MutantS
forall a b. (a, b) -> b
snd)
([([String], MutantS)] -> [([String], MutantS)])
-> ([a] -> [([String], MutantS)]) -> [a] -> [([String], MutantS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe ([String], MutantS)) -> [a] -> [([String], MutantS)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe ([String], MutantS)
bindingFor
([a] -> [([String], MutantS)])
-> ([a] -> [a]) -> [a] -> [([String], MutantS)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
200
([a] -> MutantS) -> [a] -> MutantS
forall a b. (a -> b) -> a -> b
$ [a]
forall a. Listable a => [a]
list
where bindingFor :: a -> Maybe ([String], MutantS)
bindingFor a
x = (MutantS -> ([String], MutantS))
-> Maybe MutantS -> Maybe ([String], MutantS)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) [a -> String
forall a. Show a => a -> String
show a
x])
(Maybe MutantS -> Maybe ([String], MutantS))
-> Maybe MutantS -> Maybe ([String], MutantS)
forall a b. (a -> b) -> a -> b
$ MutantS -> Maybe MutantS
forall a. a -> Maybe a
errorToNothing (b -> b -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS (a -> b
f a
x) (a -> b
f' a
x))
instance (ShowMutable a, ShowMutable b) => ShowMutable (a,b) where
mutantS :: (a, b) -> (a, b) -> MutantS
mutantS (a
f,b
g) (a
f',b
g') = [MutantS] -> MutantS
Tuple [ a -> a -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS a
f a
f'
, b -> b -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS b
g b
g' ]
instance (ShowMutable a, ShowMutable b, ShowMutable c)
=> ShowMutable (a,b,c) where
mutantS :: (a, b, c) -> (a, b, c) -> MutantS
mutantS (a
f,b
g,c
h) (a
f',b
g',c
h') = [MutantS] -> MutantS
Tuple [ a -> a -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS a
f a
f'
, b -> b -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS b
g b
g'
, c -> c -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS c
h c
h' ]
data MutantS = Unmutated String
| Atom String
| Tuple [MutantS]
| Function [([String],MutantS)]
deriving Int -> MutantS -> String -> String
[MutantS] -> String -> String
MutantS -> String
(Int -> MutantS -> String -> String)
-> (MutantS -> String)
-> ([MutantS] -> String -> String)
-> Show MutantS
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [MutantS] -> String -> String
$cshowList :: [MutantS] -> String -> String
show :: MutantS -> String
$cshow :: MutantS -> String
showsPrec :: Int -> MutantS -> String -> String
$cshowsPrec :: Int -> MutantS -> String -> String
Show
isUnmutated :: MutantS -> Bool
isUnmutated :: MutantS -> Bool
isUnmutated (Unmutated String
_) = Bool
True
isUnmutated (Tuple [MutantS]
ms) = (MutantS -> Bool) -> [MutantS] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all MutantS -> Bool
isUnmutated [MutantS]
ms
isUnmutated (Function [([String], MutantS)]
bs) = (([String], MutantS) -> Bool) -> [([String], MutantS)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (MutantS -> Bool
isUnmutated (MutantS -> Bool)
-> (([String], MutantS) -> MutantS) -> ([String], MutantS) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], MutantS) -> MutantS
forall a b. (a, b) -> b
snd) [([String], MutantS)]
bs
isUnmutated MutantS
_ = Bool
False
isFunction :: MutantS -> Bool
isFunction :: MutantS -> Bool
isFunction (Function [([String], MutantS)]
_) = Bool
True
isFunction MutantS
_ = Bool
False
flatten :: MutantS -> MutantS
flatten :: MutantS -> MutantS
flatten (Tuple [MutantS]
ms) = [MutantS] -> MutantS
Tuple ([MutantS] -> MutantS) -> [MutantS] -> MutantS
forall a b. (a -> b) -> a -> b
$ (MutantS -> MutantS) -> [MutantS] -> [MutantS]
forall a b. (a -> b) -> [a] -> [b]
map MutantS -> MutantS
flatten [MutantS]
ms
flatten (Function [([],MutantS
s)]) = MutantS -> MutantS
flatten MutantS
s
flatten (Function (([],MutantS
s):[([String], MutantS)]
_)) = String -> MutantS
forall a. HasCallStack => String -> a
error String
"flatten: ambiguous value"
flatten (Function [([String], MutantS)]
bs) = let bs' :: [([String], MutantS)]
bs' = (([String], MutantS) -> ([String], MutantS))
-> [([String], MutantS)] -> [([String], MutantS)]
forall a b. (a -> b) -> [a] -> [b]
map ((MutantS -> MutantS) -> ([String], MutantS) -> ([String], MutantS)
forall a b c. (a -> b) -> (c, a) -> (c, b)
mapSnd MutantS -> MutantS
flatten) [([String], MutantS)]
bs in
if (([String], MutantS) -> Bool) -> [([String], MutantS)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool)
-> (([String], MutantS) -> Bool) -> ([String], MutantS) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutantS -> Bool
isFunction (MutantS -> Bool)
-> (([String], MutantS) -> MutantS) -> ([String], MutantS) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], MutantS) -> MutantS
forall a b. (a, b) -> b
snd) [([String], MutantS)]
bs'
then [([String], MutantS)] -> MutantS
Function [([String], MutantS)]
bs'
else [([String], MutantS)] -> MutantS
Function
([([String], MutantS)] -> MutantS)
-> [([String], MutantS)] -> MutantS
forall a b. (a -> b) -> a -> b
$ Int -> [([String], MutantS)] -> [([String], MutantS)]
forall a. Int -> [a] -> [a]
take Int
10
([([String], MutantS)] -> [([String], MutantS)])
-> [([String], MutantS)] -> [([String], MutantS)]
forall a b. (a -> b) -> a -> b
$ (([String], MutantS) -> [([String], MutantS)])
-> [([String], MutantS)] -> [([String], MutantS)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([String]
as,Function [([String], MutantS)]
bs'') -> (([String], MutantS) -> ([String], MutantS))
-> [([String], MutantS)] -> [([String], MutantS)]
forall a b. (a -> b) -> [a] -> [b]
map (([String] -> [String])
-> ([String], MutantS) -> ([String], MutantS)
forall a b c. (a -> b) -> (a, c) -> (b, c)
mapFst ([String]
as[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++)) [([String], MutantS)]
bs'') [([String], MutantS)]
bs'
flatten MutantS
m = MutantS
m
showMutantS :: MutantS -> String
showMutantS :: MutantS -> String
showMutantS (Unmutated String
s) = String
s
showMutantS (Atom String
s) = String
s
showMutantS (Tuple [MutantS]
ms) = [String] -> String
showTuple ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (MutantS -> String) -> [MutantS] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map MutantS -> String
showMutantS [MutantS]
ms
showMutantS (Function [([String], MutantS)]
bs) = [String] -> [([String], MutantS)] -> String
showLambda [String
"??"] [([String], MutantS)]
bs
showMutantSAsTuple :: [String] -> MutantS -> String
showMutantSAsTuple :: [String] -> MutantS -> String
showMutantSAsTuple [String]
ns (Tuple [MutantS]
ms) = [String] -> String
showTuple ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> MutantS -> String) -> [String] -> [MutantS] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> MutantS -> String
show1 ([String]
ns [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
+- [String]
defaultFunctionNames) [MutantS]
ms
where show1 :: String -> MutantS -> String
show1 String
n (Unmutated String
_) = String
n
show1 String
n (Function [([String], MutantS)]
bs) = [String] -> [([String], MutantS)] -> String
showLambda (String -> [String]
fvnames String
n) [([String], MutantS)]
bs
show1 String
_ MutantS
m = MutantS -> String
showMutantS MutantS
m
showMutantSAsTuple [String]
ns MutantS
m = [String] -> MutantS -> String
showMutantSAsTuple [String]
ns ([MutantS] -> MutantS
Tuple [MutantS
m])
showMutantSBindings :: Bool -> [String] -> MutantS -> String
showMutantSBindings :: Bool -> [String] -> MutantS -> String
showMutantSBindings Bool
new [String]
ns (Tuple [MutantS]
ms) = ((String, MutantS) -> String) -> [(String, MutantS)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> MutantS -> String) -> (String, MutantS) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> MutantS -> String
show1)
([(String, MutantS)] -> String) -> [(String, MutantS)] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [MutantS] -> [(String, MutantS)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([String]
ns [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
defaultFunctionNames) [MutantS]
ms
where show1 :: String -> MutantS -> String
show1 String
_ (Unmutated String
s) = String
""
show1 String
_ (Function []) = String
""
show1 String
n (Function [([String], MutantS)]
bs) = Bool -> [String] -> [([String], MutantS)] -> String
showBindings Bool
new (String -> [String]
fvnames String
n) [([String], MutantS)]
bs
show1 String
n MutantS
m = let fn :: String
fn = [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
fvnames String
n
fn' :: String
fn' | Bool
new = String -> String
prime String
fn
| Bool
otherwise = String
fn
in (String -> [String] -> String
apply String
fn' [] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = ")
String -> String -> String
`beside` MutantS -> String
showMutantS MutantS
m
showMutantSBindings Bool
new [String]
ns MutantS
m = Bool -> [String] -> MutantS -> String
showMutantSBindings Bool
new [String]
ns ([MutantS] -> MutantS
Tuple [MutantS
m])
showLambda :: [String] -> [([String],MutantS)] -> String
showLambda :: [String] -> [([String], MutantS)] -> String
showLambda [] [] = String
"undefined {- (err?) unmutated -}"
showLambda (String
n:[String]
_) [] = String -> [String] -> String
apply String
n []
showLambda [String]
_ [([],MutantS
m)] = MutantS -> String
showMutantS MutantS
m
showLambda [String]
_ (([],MutantS
_):[([String], MutantS)]
_) = String
"undefined {- (err?) ambiguous value -}"
showLambda [String]
ns [([String], MutantS)]
bs = ((String
"\\" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
bound String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> ") String -> String -> String
`beside`)
(String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"case " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
showTuple [String]
bound String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
`beside` String
cases
where
cases :: String
cases = (([String], MutantS) -> String) -> [([String], MutantS)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([String]
as,MutantS
r) -> ([String] -> String
showTuple [String]
as String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> ") String -> String -> String
`beside` MutantS -> String
showResult MutantS
r) [([String], MutantS)]
bs
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_ -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
apply String
fn [String]
bound
showResult :: MutantS -> String
showResult (Function [([String], MutantS)]
bs') = [String] -> [([String], MutantS)] -> String
showLambda (String -> [String] -> String
apply String
fn [String]
boundString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
unbound) [([String], MutantS)]
bs'
showResult MutantS
m = MutantS -> String
showMutantS MutantS
m
unbound :: [String]
unbound = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
bound) [String]
vns
bound :: [String]
bound = (String -> String -> String) -> [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> String -> String
forall a b. a -> b -> a
const [String]
vns (([String], MutantS) -> [String]
forall a b. (a, b) -> a
fst (([String], MutantS) -> [String])
-> ([String], MutantS) -> [String]
forall a b. (a -> b) -> a -> b
$ [([String], MutantS)] -> ([String], MutantS)
forall a. [a] -> a
head [([String], MutantS)]
bs)
(String
fn:[String]
vns) = [String]
ns [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
+- [String]
defaultNames
showBindings :: Bool -> [String] -> [([String],MutantS)] -> String
showBindings :: Bool -> [String] -> [([String], MutantS)] -> String
showBindings Bool
new [String]
ns [([String], MutantS)]
bs =
String -> [[String]] -> String
table String
" " ([[String]] -> String) -> [[String]] -> String
forall a b. (a -> b) -> a -> b
$ (([String] -> MutantS -> [String])
-> ([String], MutantS) -> [String]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [String] -> MutantS -> [String]
showBind (([String], MutantS) -> [String])
-> [([String], MutantS)] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
`map` [([String], MutantS)]
bs)
[[String]] -> [[String]] -> [[String]]
forall a. [a] -> [a] -> [a]
++ [String -> [String]
words (String -> [String] -> String
apply String
fn' [String]
bound) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"=", String -> [String] -> String
apply String
fn [String]
bound] | Bool
new]
where
showBind :: [String] -> MutantS -> [String]
showBind [String
a1,String
a2] MutantS
r | String -> Bool
isInfix String
fn' = [String
a1, String
fn', String
a2, String
"=", MutantS -> String
showMutantS MutantS
r]
showBind [String]
as MutantS
r = [String
fn'] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
as [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"=", MutantS -> String
showMutantS MutantS
r]
fn' :: String
fn' | Bool
new = String -> String
prime String
fn
| Bool
otherwise = String
fn
bound :: [String]
bound = (String -> String -> String) -> [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> String -> String
forall a b. a -> b -> a
const [String]
vns (([String], MutantS) -> [String]
forall a b. (a, b) -> a
fst (([String], MutantS) -> [String])
-> ([String], MutantS) -> [String]
forall a b. (a -> b) -> a -> b
$ [([String], MutantS)] -> ([String], MutantS)
forall a. [a] -> a
head [([String], MutantS)]
bs)
(String
fn:[String]
vns) = [String]
ns [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
+- [String]
defaultNames
fvnames :: String -> [String]
fvnames :: String -> [String]
fvnames = [String] -> [String]
fvns' ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
where fvns' :: [String] -> [String]
fvns' :: [String] -> [String]
fvns' [String
a,String
o,String
b] | String -> Bool
isInfix String
o = String
oString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String
a,String
b]
fvns' [] = [String]
defaultNames
fvns' [String]
fvs = [String]
fvs
apply :: String -> [String] -> String
apply :: String -> [String] -> String
apply String
f [String
x,String
y] | String -> Bool
isInfix String
f = [String] -> String
unwords [String
x,String
f,String
y]
apply String
f [String]
xs = if String -> Bool
isInfix String
f
then [String] -> String
unwords (String -> String
toPrefix String
fString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xs)
else [String] -> String
unwords (String
fString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xs)
isInfix :: String -> Bool
isInfix :: String -> Bool
isInfix (Char
c:String
cs) = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'(' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isLetter Char
c)
toPrefix :: String -> String
toPrefix :: String -> String
toPrefix (Char
'`':String
cs) = String -> String
forall a. [a] -> [a]
init String
cs
toPrefix String
cs = Char
'('Char -> String -> String
forall a. a -> [a] -> [a]
:String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
prime :: String -> String
prime :: String -> String
prime (Char
'`':String
cs) = Char
'`'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
forall a. [a] -> [a]
init String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'`"
prime (Char
'(':String
cs) = Char
'('Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
forall a. [a] -> [a]
init String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-)"
prime String
cs | String -> Bool
isInfix String
cs = String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-"
| Bool
otherwise = String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
mapFst :: (a->b) -> (a,c) -> (b,c)
mapFst :: (a -> b) -> (a, c) -> (b, c)
mapFst a -> b
f (a
x,c
y) = (a -> b
f a
x,c
y)
mapSnd :: (a->b) -> (c,a) -> (c,b)
mapSnd :: (a -> b) -> (c, a) -> (c, b)
mapSnd a -> b
f (c
x,a
y) = (c
x,a -> b
f a
y)
(+-) :: Eq a => [a] -> [a] -> [a]
[a]
xs +- :: [a] -> [a] -> [a]
+- [a]
ys = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) [a]
ys
instance (ShowMutable a, ShowMutable b, ShowMutable c, ShowMutable d)
=> ShowMutable (a,b,c,d) where
mutantS :: (a, b, c, d) -> (a, b, c, d) -> MutantS
mutantS (a
f,b
g,c
h,d
i) (a
f',b
g',c
h',d
i') = [MutantS] -> MutantS
Tuple [ a -> a -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS a
f a
f'
, b -> b -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS b
g b
g'
, c -> c -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS c
h c
h'
, d -> d -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS d
i d
i' ]
instance (ShowMutable a, ShowMutable b, ShowMutable c,
ShowMutable d, ShowMutable e)
=> ShowMutable (a,b,c,d,e) where
mutantS :: (a, b, c, d, e) -> (a, b, c, d, e) -> MutantS
mutantS (a
f,b
g,c
h,d
i,e
j) (a
f',b
g',c
h',d
i',e
j') = [MutantS] -> MutantS
Tuple [ a -> a -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS a
f a
f'
, b -> b -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS b
g b
g'
, c -> c -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS c
h c
h'
, d -> d -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS d
i d
i'
, e -> e -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS e
j e
j' ]
instance (ShowMutable a, ShowMutable b, ShowMutable c,
ShowMutable d, ShowMutable e, ShowMutable f)
=> ShowMutable (a,b,c,d,e,f) where
mutantS :: (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> MutantS
mutantS (a
f,b
g,c
h,d
i,e
j,f
k) (a
f',b
g',c
h',d
i',e
j',f
k') = [MutantS] -> MutantS
Tuple [ a -> a -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS a
f a
f'
, b -> b -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS b
g b
g'
, c -> c -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS c
h c
h'
, d -> d -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS d
i d
i'
, e -> e -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS e
j e
j'
, f -> f -> MutantS
forall a. ShowMutable a => a -> a -> MutantS
mutantS f
k f
k' ]
mutantSTuple :: [MutantS] -> MutantS
mutantSTuple :: [MutantS] -> MutantS
mutantSTuple = [MutantS] -> MutantS
Tuple