Я пытаюсь ответить на qaru.site/info/413509/..., но единственное решение, которое я придумал до сих пор, довольно уродливо.
Это похоже на довольно распространенную проблему, поэтому я хотел знать, было ли более элегантное решение.
В принципе, у нас есть GADT, который разрешает либо Expression Int, либо Expression Bool (игнорируя codataIf = If (B True) codataIf codataIf):
data Expression a where
I :: Int -> Expression Int
B :: Bool -> Expression Bool
Add :: Expression Int -> Expression Int -> Expression Int
Mul :: Expression Int -> Expression Int -> Expression Int
Eq :: Expression Int -> Expression Int -> Expression Bool
And :: Expression Bool -> Expression Bool -> Expression Bool
Or :: Expression Bool -> Expression Bool -> Expression Bool
If :: Expression Bool -> Expression a -> Expression a -> Expression a
И (в моей версии проблемы) мы хотим иметь возможность оценить дерево выражений снизу вверх, используя простую операцию, чтобы объединить листья в новый лист:
step :: Expression a -> Expression a
step = \case
Add (I x) (I y) -> I $ x + y
Mul (I x) (I y) -> I $ x * y
Eq (I x) (I y) -> B $ x == y
And (B x) (B y) -> B $ x && y
Or (B x) (B y) -> B $ x || y
If (B b) x y -> if b then x else y
z -> z
Я с трудом использовал DataDeriving для вывода экземпляров uniplate и Biplate (которые, возможно, должны были быть красным флагом), поэтому
Я применил собственные экземпляры uniplate для Expression Int, Expression Bool и Biplate экземпляров для (Expression a) (Expression a), (Expression Int) (Expression Bool) и (Expression Bool) (Expression Int).
Позвольте мне придумать эти восходящие обходы:
evalInt :: Expression Int -> Expression Int
evalInt = transform step
evalIntBi :: Expression Bool -> Expression Bool
evalIntBi = transformBi (step :: Expression Int -> Expression Int)
evalBool :: Expression Bool -> Expression Bool
evalBool = transform step
evalBoolBi :: Expression Int -> Expression Int
evalBoolBi = transformBi (step :: Expression Bool -> Expression Bool)
Но так как каждый из них может выполнять только одно преобразование (объедините Int листья или Bool листья, но не все), они не могут выполнить полное упрощение, но должны быть связаны друг с другом вручную:
λ example1
If (Eq (I 0) (Add (I 0) (I 0))) (I 1) (I 2)
λ evalInt it
If (Eq (I 0) (I 0)) (I 1) (I 2)
λ evalBoolBi it
If (B True) (I 1) (I 2)
λ evalInt it
I 1
λ example2
If (Eq (I 0) (Add (I 0) (I 0))) (B True) (B False)
λ evalIntBi it
If (Eq (I 0) (I 0)) (B True) (B False)
λ evalBool it
B True
Моим хакерским обходным решением было определить экземпляр uniplate для Either (Expression Int) (Expression Bool):
type WExp = Either (Expression Int) (Expression Bool)
instance Uniplate WExp where
uniplate = \case
Left (Add x y) -> plate (i2 Left Add) |* Left x |* Left y
Left (Mul x y) -> plate (i2 Left Mul) |* Left x |* Left y
Left (If b x y) -> plate (bi2 Left If) |* Right b |* Left x |* Left y
Right (Eq x y) -> plate (i2 Right Eq) |* Left x |* Left y
Right (And x y) -> plate (b2 Right And) |* Right x |* Right y
Right (Or x y) -> plate (b2 Right Or) |* Right x |* Right y
Right (If b x y) -> plate (b3 Right If) |* Right b |* Right x |* Right y
e -> plate e
where i2 side op (Left x) (Left y) = side (op x y)
i2 _ _ _ _ = error "type mismatch"
b2 side op (Right x) (Right y) = side (op x y)
b2 _ _ _ _ = error "type mismatch"
bi2 side op (Right x) (Left y) (Left z) = side (op x y z)
bi2 _ _ _ _ _ = error "type mismatch"
b3 side op (Right x) (Right y) (Right z) = side (op x y z)
b3 _ _ _ _ _ = error "type mismatch"
evalWExp :: WExp -> WExp
evalWExp = transform (either (Left . step) (Right . step))
Теперь я могу сделать полное упрощение:
λ evalWExp . Left $ example1
Left (I 1)
λ evalWExp . Right $ example2
Right (B True)
Но количество error и обертывание/разворот, которые я должен был сделать, чтобы сделать эту работу, просто заставляет это чувствовать себя нелестно и неправильно для меня.
Есть ли правильный способ решить эту проблему с помощью uniplate?
