diff --git a/src/Test/Speculate/Expr/Core.hs b/src/Test/Speculate/Expr/Core.hs index 3cccb03..028537c 100644 --- a/src/Test/Speculate/Expr/Core.hs +++ b/src/Test/Speculate/Expr/Core.hs @@ -28,6 +28,9 @@ module Test.Speculate.Expr.Core , unification , isCanonInstanceOf , hasCanonInstanceOf + + -- * Commuting + , commutations ) where @@ -136,3 +139,17 @@ e1 `hasCanonInstanceOf` e2 | e1 `isCanonInstanceOf` e2 = True (e1f :$ e1x) `hasCanonInstanceOf` e2 | e1f `hasCanonInstanceOf` e2 || e1x `hasCanonInstanceOf` e2 = True _ `hasCanonInstanceOf` _ = False + +commutations :: [Expr] -> Expr -> [Expr] +commutations cos = cmms + where + cmms (eo :$ ex :$ ey) | isValue eo && eo `elem` cos + = concat [ [eo :$ ex' :$ ey', eo :$ ey' :$ ex'] + | ex' <- cmms ex + , ey' <- cmms ey + ] + cmms (ef :$ ex) = [ ef' :$ ex' + | ef' <- cmms ef + , ex' <- cmms ex + ] + cmms e = [e] diff --git a/test/expr.hs b/test/expr.hs index f5c6ea6..8b707ec 100644 --- a/test/expr.hs +++ b/test/expr.hs @@ -59,6 +59,25 @@ tests n = , (yy,ff2 xx xx) ] + , commutations [plus] (xx -+- yy) == [xx -+- yy, yy -+- xx] + , commutations [times] (xx -*- yy) == [xx -*- yy, yy -*- xx] + , commutations [times] (xx -+- yy) == [xx -+- yy] + , commutations [plus] (xx -*- yy) == [xx -*- yy] + + , commutations [plus] (xx -+- (yy -+- zz)) + == [ xx -+- (yy -+- zz) + , (yy -+- zz) -+- xx + , xx -+- (zz -+- yy) + , (zz -+- yy) -+- xx + ] + + , commutations [plus,times] (xx -+- (yy -*- zz)) + == [ xx -+- (yy -*- zz) + , (yy -*- zz) -+- xx + , xx -+- (zz -*- yy) + , (zz -*- yy) -+- xx + ] + , constifications xx == map constify [xx] , constifications (xx -+- yy)