packages feed

dumb-cas 0.1.2.0 → 0.2.0.0

raw patch · 6 files changed

+182/−44 lines, 6 filesdep ~basedep ~hashablePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, hashable

API changes (from Hackage documentation)

- CAS.Dumb.Symbols.ASCII: instance (CAS.Dumb.Symbols.ASCIISymbols c, GHC.Base.Monoid c) => GHC.Show.Show (CAS.Dumb.Tree.CAS' CAS.Dumb.Tree.GapId (CAS.Dumb.Symbols.Infix c) (CAS.Dumb.Symbols.Encapsulation c) (CAS.Dumb.Symbols.ASCII.Symbol c))
- CAS.Dumb.Symbols.ASCII: instance CAS.Dumb.Symbols.ASCIISymbols c => GHC.Show.Show (CAS.Dumb.Tree.CAS (CAS.Dumb.Symbols.Infix c) (CAS.Dumb.Symbols.Encapsulation c) (CAS.Dumb.Symbols.ASCII.Symbol c))
- CAS.Dumb.Symbols.Unicode.MathLatin_RomanGreek__BopomofoGaps: instance CAS.Dumb.Symbols.UnicodeSymbols c => GHC.Show.Show (CAS.Dumb.Symbols.Unicode.MathLatin_RomanGreek__BopomofoGaps.Expression c)
- CAS.Dumb.Symbols.Unicode.MathLatin_RomanGreek__BopomofoGaps: instance CAS.Dumb.Symbols.UnicodeSymbols c => GHC.Show.Show (CAS.Dumb.Symbols.Unicode.MathLatin_RomanGreek__BopomofoGaps.Pattern c)
+ CAS.Dumb: SpecialEncapsulation :: (SpecialEncapsulation s) -> Encapsulation s
+ CAS.Dumb.Symbols: Negation :: AlgebraicInvEncapsulation
+ CAS.Dumb.Symbols: Reciprocal :: AlgebraicInvEncapsulation
+ CAS.Dumb.Symbols: SpecialEncapsulation :: (SpecialEncapsulation s) -> Encapsulation s
+ CAS.Dumb.Symbols: class Eq (SpecialEncapsulation c) => RenderableEncapsulations c
+ CAS.Dumb.Symbols: data AlgebraicInvEncapsulation
+ CAS.Dumb.Symbols: fixateAlgebraEncaps :: (RenderableEncapsulations c, SymbolClass σ, SCConstraint σ c) => CAS' γ (Infix c) (Encapsulation c) (SymbolD σ c) -> CAS' γ (Infix c) (Encapsulation c) (SymbolD σ c)
+ CAS.Dumb.Symbols: instance CAS.Dumb.Symbols.RenderableEncapsulations GHC.Base.String
+ CAS.Dumb.Symbols: instance GHC.Classes.Eq CAS.Dumb.Symbols.AlgebraicInvEncapsulation
+ CAS.Dumb.Symbols: instance GHC.Show.Show CAS.Dumb.Symbols.AlgebraicInvEncapsulation
+ CAS.Dumb.Symbols.ASCII: instance (CAS.Dumb.Symbols.ASCIISymbols c, CAS.Dumb.Symbols.RenderableEncapsulations c) => GHC.Show.Show (CAS.Dumb.Tree.CAS (CAS.Dumb.Symbols.Infix c) (CAS.Dumb.Symbols.Encapsulation c) (CAS.Dumb.Symbols.ASCII.Symbol c))
+ CAS.Dumb.Symbols.ASCII: instance (CAS.Dumb.Symbols.ASCIISymbols c, CAS.Dumb.Symbols.RenderableEncapsulations c, GHC.Base.Monoid c) => GHC.Show.Show (CAS.Dumb.Tree.CAS' CAS.Dumb.Tree.GapId (CAS.Dumb.Symbols.Infix c) (CAS.Dumb.Symbols.Encapsulation c) (CAS.Dumb.Symbols.ASCII.Symbol c))
+ CAS.Dumb.Symbols.ASCII: instance CAS.Dumb.Tree.Unwieldy c => CAS.Dumb.Tree.Unwieldy (CAS.Dumb.Symbols.ASCII.Symbol c)
+ CAS.Dumb.Symbols.Unicode.MathLatin_RomanGreek__BopomofoGaps: instance (CAS.Dumb.Symbols.UnicodeSymbols c, CAS.Dumb.Symbols.RenderableEncapsulations c) => GHC.Show.Show (CAS.Dumb.Symbols.Unicode.MathLatin_RomanGreek__BopomofoGaps.Expression c)
+ CAS.Dumb.Symbols.Unicode.MathLatin_RomanGreek__BopomofoGaps: instance (CAS.Dumb.Symbols.UnicodeSymbols c, CAS.Dumb.Symbols.RenderableEncapsulations c) => GHC.Show.Show (CAS.Dumb.Symbols.Unicode.MathLatin_RomanGreek__BopomofoGaps.Pattern c)
+ CAS.Dumb.Symbols.Unicode.MathLatin_RomanGreek__BopomofoGaps: instance CAS.Dumb.Tree.Unwieldy c => CAS.Dumb.Tree.Unwieldy (CAS.Dumb.Symbols.Unicode.MathLatin_RomanGreek__BopomofoGaps.Symbol c)
+ CAS.Dumb.Tree: bigFirstPreference :: Unwieldiness
+ CAS.Dumb.Tree: class Unwieldy e
+ CAS.Dumb.Tree: instance (CAS.Dumb.Tree.Unwieldy s², CAS.Dumb.Tree.Unwieldy s¹, CAS.Dumb.Tree.Unwieldy s⁰) => CAS.Dumb.Tree.Unwieldy (CAS.Dumb.Tree.CAS s² s¹ s⁰)
+ CAS.Dumb.Tree: type Unwieldiness = Double
+ CAS.Dumb.Tree: unwieldiness :: Unwieldy e => e -> Unwieldiness
- CAS.Dumb.Symbols: class SymbolClass σ where type SCConstraint σ :: * -> Constraint where {
+ CAS.Dumb.Symbols: class SymbolClass σ where {
- CAS.Dumb.Symbols: renderSymbolExpression :: forall σ c r. (SymbolClass σ, SCConstraint σ c) => ContextFixity -> RenderingCombinator σ c r -> AlgebraExpr σ c -> r
+ CAS.Dumb.Symbols: renderSymbolExpression :: forall σ c r. (SymbolClass σ, SCConstraint σ c, HasCallStack) => ContextFixity -> RenderingCombinator σ c r -> AlgebraExpr σ c -> r

Files

CAS/Dumb/Symbols.hs view
@@ -30,6 +30,7 @@ import Data.String (IsString)  import GHC.Exts (Constraint)+import GHC.Stack (HasCallStack)  import Data.Ratio (denominator, numerator) import Numeric.Literals.Decimal@@ -47,10 +48,13 @@ instance Eq s => Eq (Infix s) where   Infix _ o == Infix _ p = o==p +type family SpecialEncapsulation s+ data Encapsulation s = Encapsulation {       needInnerParens, haveOuterparens :: !Bool     , leftEncaps, rightEncaps :: !s     }+  | SpecialEncapsulation (SpecialEncapsulation s)  instance Eq (Encapsulation String) where   Encapsulation _ _ l r == Encapsulation _ _ l' r'@@ -59,6 +63,8 @@          dropParens (' ':lr) rr = dropParens lr rr          dropParens lr (' ':rr) = dropParens lr rr          dropParens lr rr = (lr,rr)+  SpecialEncapsulation e == SpecialEncapsulation e' = e==e'+  _ == _ = False  type AlgebraExpr σ l = CAS (Infix l) (Encapsulation l) (SymbolD σ l) type AlgebraExpr' γ σ l = CAS' γ (Infix l) (Encapsulation l) (SymbolD σ l)@@ -82,6 +88,14 @@   -> CAS' γ (Infix s²) (Encapsulation s¹) s⁰ symbolFunction f a = Function (Encapsulation True False f mempty) a +++data AlgebraicInvEncapsulation+       = Negation | Reciprocal+ deriving (Eq, Show)++type instance SpecialEncapsulation String = AlgebraicInvEncapsulation+ instance ∀ σ γ . (SymbolClass σ, SCConstraint σ String)           => Num (AlgebraExpr' γ σ String) where   fromInteger n@@ -93,27 +107,23 @@   (*) = chainableInfixL (==mulOp) mulOp    where fcs = fromCharSymbol ([]::[σ])          mulOp = Infix (Hs.Fixity 7 Hs.InfixL) $ fcs '*'-  (-) = symbolInfix (Infix (Hs.Fixity 6 Hs.InfixL) $ fcs '-')-   where fcs = fromCharSymbol ([]::[σ])   abs = symbolFunction "abs "   signum = symbolFunction "signum "-  negate = Operator (Infix (Hs.Fixity 6 Hs.InfixL) $ fcs '-')-             . Symbol $ StringSymbol " "-   where fcs = fromCharSymbol ([]::[σ])+  negate = Function $ SpecialEncapsulation Negation  instance ∀ σ γ . (SymbolClass σ, SCConstraint σ String)           => Fractional (AlgebraExpr' γ σ String) where   fromRational n = case fromRational n of      n:%d -> fromIntegral n / fromIntegral d      nSci -> Symbol (StringSymbol $ show nSci)-  (/) = symbolInfix (Infix (Hs.Fixity 7 Hs.InfixL) $ fcs '/')-   where fcs = fromCharSymbol ([]::[σ])+  recip = Function $ SpecialEncapsulation Reciprocal  instance ∀ σ γ . (SymbolClass σ, SCConstraint σ String)           => Floating (AlgebraExpr' γ σ String) where   pi = Symbol $ StringSymbol "pi"-  (**) = symbolInfix (Infix (Hs.Fixity 6 Hs.InfixL) "**")+  (**) = symbolInfix (Infix (Hs.Fixity 8 Hs.InfixL) "**")   logBase = symbolInfix (Infix (Hs.Fixity 10 Hs.InfixL) "`logBase`")+  sqrt = symbolFunction $ "sqrt "   exp = symbolFunction $ "exp "   log = symbolFunction $ "log "   sin = symbolFunction $ "sin "@@ -138,6 +148,43 @@   toASCIISymbols = id  +class Eq (SpecialEncapsulation c) => RenderableEncapsulations c where+  fixateAlgebraEncaps :: (SymbolClass σ, SCConstraint σ c)+      => CAS' γ (Infix c) (Encapsulation c) (SymbolD σ c)+                         -> CAS' γ (Infix c) (Encapsulation c) (SymbolD σ c)++instance RenderableEncapsulations String where+  fixateAlgebraEncaps (OperatorChain x+                         ((o,Function (SpecialEncapsulation ι) z):ys))+     | (Infix (Hs.Fixity 6 Hs.InfixL) "+", Negation) <- (o,ι)+           = case fixateAlgebraEncaps $ OperatorChain x ys of+               x' -> Operator (Infix (Hs.Fixity 6 Hs.InfixL) "-") x' z'+     | (Infix (Hs.Fixity 7 Hs.InfixL) "*", Reciprocal) <- (o,ι)+           = case fixateAlgebraEncaps $ OperatorChain x ys of+               x' -> Operator (Infix (Hs.Fixity 7 Hs.InfixL) "/") x' z'+   where z' = fixateAlgebraEncaps z+  fixateAlgebraEncaps (OperatorChain x []) = fixateAlgebraEncaps x+  fixateAlgebraEncaps (OperatorChain x ((o@(Infix (Hs.Fixity _ Hs.InfixL) _), z):ys))+      = Operator o (fixateAlgebraEncaps $ OperatorChain x ys) (fixateAlgebraEncaps z)+  fixateAlgebraEncaps (Operator o x (Function (SpecialEncapsulation ι) y))+     | (Infix (Hs.Fixity 6 Hs.InfixL) "+", Negation) <- (o,ι)+           = Operator (Infix (Hs.Fixity 6 Hs.InfixL) "-") x' y'+     | (Infix (Hs.Fixity 7 Hs.InfixL) "*", Reciprocal) <- (o,ι)+           = Operator (Infix (Hs.Fixity 7 Hs.InfixL) "/") x' y'+   where [x',y'] = fixateAlgebraEncaps<$>[x,y]+  fixateAlgebraEncaps (Function (SpecialEncapsulation Negation) e)+            = Operator (Infix (Hs.Fixity 6 Hs.InfixL) "-")+                (Symbol $ StringSymbol " ") $ fixateAlgebraEncaps e+  fixateAlgebraEncaps (Function (SpecialEncapsulation Reciprocal) e)+            = Operator (Infix (Hs.Fixity 7 Hs.InfixL) "/")+                (Symbol $ NatSymbol 1) $ fixateAlgebraEncaps e+  fixateAlgebraEncaps (Function f e) = Function f $ fixateAlgebraEncaps e+  fixateAlgebraEncaps (Operator o x y)+        = Operator o (fixateAlgebraEncaps x) (fixateAlgebraEncaps y)+  fixateAlgebraEncaps (OperatorChain x₀ oys)+        = OperatorChain (fixateAlgebraEncaps x₀) (second fixateAlgebraEncaps <$> oys)+  fixateAlgebraEncaps e = e+ type RenderingCombinator σ c r         = Bool        -- ^ Should the result be parenthesised?        -> Maybe r     -- ^ Left context@@ -158,7 +205,7 @@ expressionFixity (OperatorChain x₀ []) = expressionFixity x₀ expressionFixity (Gap _) = Nothing -renderSymbolExpression :: ∀ σ c r . (SymbolClass σ, SCConstraint σ c)+renderSymbolExpression :: ∀ σ c r . (SymbolClass σ, SCConstraint σ c, HasCallStack)          => ContextFixity -> RenderingCombinator σ c r                     -> AlgebraExpr σ c -> r renderSymbolExpression _ ρ (Symbol s) = ρ False Nothing s Nothing@@ -201,6 +248,8 @@          AtRHS (Hs.Fixity pfxty _)         | Hs.Fixity lfxty _ <- fxty                                            , lfxty==pfxty                       -> True          AtRHS _                                                                -> False+renderSymbolExpression _ _ (Function (SpecialEncapsulation _) _) = error+ "`renderSymbolExpression` cannot handle `SpecialEncapsulation`; please pre-process accordingly."   showsPrecASCIISymbol :: (ASCIISymbols c, SymbolClass σ, SCConstraint σ c)@@ -264,11 +313,14 @@ -- @ -- (map succ%$> 𝑎+𝑝) * 𝑥  ≡  (𝑏+𝑞) * 𝑥 -- @+-- +--   Note that this can /not/ be used with number literals. (%$>) :: ∀ σ c c' γ s² s¹ . (SymbolClass σ, SCConstraint σ c)          => (c -> c') -> CAS' γ s² s¹ (SymbolD σ c) -> CAS' γ s² s¹ (SymbolD σ c') f %$> Symbol (PrimitiveSymbol c) = case fromCharSymbol ([]::[σ]) of          fcs -> Symbol . StringSymbol . f $ fcs c f %$> Symbol (StringSymbol s) = Symbol . StringSymbol $ f s+_ %$> Symbol (NatSymbol _) = error "`%$>` cannot be used with number literals." f %$> Function g q = Function g $ f %$> q f %$> Operator o p q = Operator o (f%$>p) (f%$>q) f %$> OperatorChain p qs = OperatorChain (f%$>p) (second (f%$>)<$>qs)
CAS/Dumb/Symbols/ASCII.hs view
@@ -57,6 +57,17 @@ type Expression c = Expression' Void (Infix c) (Encapsulation c) c type Pattern c = Expression' GapId (Infix c) (Encapsulation c) c ++instance Unwieldy c => Unwieldy (Symbol c) where+  unwieldiness (NatSymbol i) = 0.24127 + fromInteger (abs i)+  unwieldiness (PrimitiveSymbol c)+    | c>='a' && c<='z'  = 1.17236 + fromIntegral (fromEnum 'z' - ucp)/49.4530+    | c>='A' && c<='Z'  = 1.17211 + fromIntegral (fromEnum 'Z' - ucp)/49.4571+    | otherwise         = 1.24551 + fromIntegral ucp / 52792.42+                                  + fromIntegral (ucp`mod`136)/9722.3+   where ucp = fromEnum c+  unwieldiness (StringSymbol s) = unwieldiness s+ makeSymbols ''Expression' ['a'..'z']  _a,_b,_c,_d,_e,_f,_g,_h,_i,_j,_k,_l,_m,_n,_o,_p,_q,_r,_s,_t,_u,_v,_w,_x,_y,_z@@ -77,11 +88,13 @@ makeSymbols ''Expression' ['A'..'Z'] #endif -instance ASCIISymbols c => Show (CAS (Infix c) (Encapsulation c) (Symbol c)) where-  showsPrec = showsPrecASCIISymbol-instance ∀ c . (ASCIISymbols c, Monoid c)+instance (ASCIISymbols c, RenderableEncapsulations c)+      => Show (CAS (Infix c) (Encapsulation c) (Symbol c)) where+  showsPrec p = showsPrecASCIISymbol p . fixateAlgebraEncaps+   where +instance ∀ c . (ASCIISymbols c, RenderableEncapsulations c, Monoid c)        => Show (CAS' GapId (Infix c) (Encapsulation c) (Symbol c)) where-  showsPrec p = showsPrecASCIISymbol p . purgeGaps+  showsPrec p = showsPrecASCIISymbol p . purgeGaps . fixateAlgebraEncaps    where purgeGaps (Symbol s) = Symbol s          purgeGaps (Function f e) = Function f $ purgeGaps e          purgeGaps (Operator o x y) = Operator o (purgeGaps x) (purgeGaps y)
CAS/Dumb/Symbols/Unicode/MathLatin_RomanGreek__BopomofoGaps.hs view
@@ -78,6 +78,27 @@   type SCConstraint Unicode_MathLatin_RomanGreek__BopomofoGaps = UnicodeSymbols   fromCharSymbol _ = fromUnicodeSymbol +instance Unwieldy c => Unwieldy (Symbol c) where+  unwieldiness (NatSymbol i) = 0.24127 + fromInteger (abs i)+  unwieldiness (PrimitiveSymbol c)+    | c>='a' && c<='z'  = 1.17236 + fromIntegral (fromEnum 'z' - ucp)/49.4530+    | c>='𝑎' && c<='𝑧'  = 1.17249 + fromIntegral (fromEnum '𝑧' - ucp)/49.4564+    | c=='ℎ'            = 1.17249 + fromIntegral (fromEnum 'z' - fromEnum 'h')/49.4564+    | c>='A' && c<='Z'  = 1.17211 + fromIntegral (fromEnum 'Z' - ucp)/49.4571+    | c>='𝐴' && c<='𝑍'  = 1.17213 + fromIntegral (fromEnum '𝑍' - ucp)/49.4511+    | c>='𝐚' && c<='𝐳'  = 1.17228 + fromIntegral (fromEnum '𝐳' - ucp)/49.4572+    | c>='𝐀' && c<='𝐙'  = 1.17210 + fromIntegral (fromEnum '𝐙' - ucp)/49.4518+    | c>='𝓐' && c<='𝓩'  = 1.17212 + fromIntegral (fromEnum '𝓩' - ucp)/49.4528+    | c>='α' && c<='ω'  = 1.03627 + fromIntegral (fromEnum 'ω' - ucp)/342.637+    | c=='ϑ'            = 1.03628 + fromIntegral (fromEnum 'ω' - fromEnum 'θ')/342.637+    | c=='ϕ'            = 1.03628 + fromIntegral (fromEnum 'ω' - fromEnum 'φ')/342.637+    | c>='Α' && c<='Ω'  = 1.03625 + fromIntegral (fromEnum 'Ω' - ucp)/342.642+    | otherwise         = 1.24551 + fromIntegral ucp / 52792.42+                                  + fromIntegral (ucp`mod`136)/9722.3+   where ucp = fromEnum c+  unwieldiness (StringSymbol s) = unwieldiness s++ type Symbol = SymbolD Unicode_MathLatin_RomanGreek__BopomofoGaps type Expression' γ s² s¹ c = CAS' γ s² s¹ (Symbol c) type Expression c = Expression' Void (Infix c) (Encapsulation c) c@@ -138,10 +159,11 @@   ,ㄠ,ㄡ,ㄢ,ㄣ,ㄤ,ㄥ,ㄦ,ㄧ,ㄨ,ㄩ,ㄪ,ㄫ,ㄬ]     = Gap . fromEnum <$> ['ㄅ'..'ㄬ'] -instance UnicodeSymbols c => Show (Expression c) where-  showsPrec = showsPrecUnicodeSymbol-instance ∀ c . UnicodeSymbols c => Show (Pattern c) where-  showsPrec p = showsPrecUnicodeSymbol p . purgeGaps+instance (UnicodeSymbols c, RenderableEncapsulations c) => Show (Expression c) where+  showsPrec p = showsPrecUnicodeSymbol p . fixateAlgebraEncaps+instance ∀ c . (UnicodeSymbols c, RenderableEncapsulations c)+                   => Show (Pattern c) where+  showsPrec p = showsPrecUnicodeSymbol p . purgeGaps . fixateAlgebraEncaps    where purgeGaps (Symbol s) = Symbol s          purgeGaps (Function f e) = Function f $ purgeGaps e          purgeGaps (Operator o x y) = Operator o (purgeGaps x) (purgeGaps y)
CAS/Dumb/Tree.hs view
@@ -11,6 +11,7 @@ {-# LANGUAGE DeriveFunctor, DeriveGeneric       #-} {-# LANGUAGE TupleSections                      #-} {-# LANGUAGE PatternSynonyms                    #-}+{-# LANGUAGE FlexibleInstances                  #-} {-# LANGUAGE FlexibleContexts                   #-} {-# LANGUAGE ScopedTypeVariables, UnicodeSyntax #-} @@ -223,3 +224,24 @@        go (Operator _ x y) = ('(':) . go x . (")`υ`("++) . go y . (")"++)        go (OperatorChain x ys) = ("χ ["++) . go x                               . flip (foldr $ ((", "++).) . go . snd) (reverse ys) . (']':)++++type Unwieldiness = Double++class Unwieldy e where+  unwieldiness :: e -> Unwieldiness++instance (Unwieldy s², Unwieldy s¹, Unwieldy s⁰) => Unwieldy (CAS s² s¹ s⁰) where+  unwieldiness (Symbol s) = unwieldiness s+  unwieldiness (Function f x) = unwieldiness f + unwieldiness x+  unwieldiness (Operator o x y)+      = unwieldiness o + unwieldiness x + bigFirstPreference*unwieldiness y+  unwieldiness (OperatorChain x ys)+      = unwieldiness x + sum [ q * (unwieldiness o + unwieldiness y)+                             | (q,(o,y)) <- zip [1, bigFirstPreference ..] $ reverse ys ]++-- | How much it is preferred to start an operator-chain with the most complex+--   subexpression (e.g. with the highest-order monomial).+bigFirstPreference :: Unwieldiness+bigFirstPreference = 1 + 1e-6
dumb-cas.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                dumb-cas-version:             0.1.2.0+version:             0.2.0.0 synopsis:            A computer “algebra” system that knows nothing about algebra, at the core. description:         This is a framework for untyped, symbolic computations like a CAS                      does, without any baked-in rules whatsoever but the ability to@@ -32,7 +32,7 @@   other-modules:       CAS.Dumb.Util.These                        CAS.Dumb.Symbols.PatternGenerator   other-extensions:    DeriveFunctor-  build-depends:       base >=4.8 && <4.11, hashable >=1.2 && <1.3+  build-depends:       base >=4.8 && <4.14, hashable >=1.2 && <1.3                      , containers                      , unordered-containers >=0.2 && <0.3                      , decimal-literals >= 0.1 && < 0.2
test/tasty/test.hs view
@@ -7,11 +7,13 @@ -- Stability   : experimental -- Portability : portable -- -{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ConstraintKinds  #-}-{-# LANGUAGE TypeFamilies     #-}-{-# LANGUAGE LambdaCase       #-}-{-# LANGUAGE CPP              #-}+{-# LANGUAGE FlexibleContexts        #-}+{-# LANGUAGE ConstraintKinds         #-}+{-# LANGUAGE TypeFamilies            #-}+{-# LANGUAGE LambdaCase              #-}+{-# LANGUAGE FunctionalDependencies  #-}+{-# LANGUAGE FlexibleInstances       #-}+{-# LANGUAGE CPP                     #-}  module Main where @@ -31,17 +33,17 @@ tests = testGroup "Tests"   [ testGroup "Explicit transformations"      [ testCase "𝑎 + 𝑏 * 𝑐  &~:  ㄖ+ㄈ :=: ㄈ+ㄖ" $-      (𝑎 + 𝑏 * 𝑐 &~: ㄖ+ㄈ :=: ㄈ+ㄖ) @?= (𝑏 * 𝑐 + 𝑎 :: Expr)+      (𝑎 + 𝑏 * 𝑐 &~: ㄖ+ㄈ :=: ㄈ+ㄖ) %@?= (𝑏 * 𝑐 + 𝑎 :: Expr)      , testCase "(𝑎+𝑏) * 𝑐  &~:  ㄖ+ㄈ :=: ㄈ+ㄖ" $-      ((𝑎+𝑏) * 𝑐 &~: ㄖ+ㄈ :=: ㄈ+ㄖ) @?= ((𝑏+𝑎) * 𝑐 :: Expr)+      ((𝑎+𝑏) * 𝑐 &~: ㄖ+ㄈ :=: ㄈ+ㄖ) %@?= ((𝑏+𝑎) * 𝑐 :: Expr)      , testCase "𝑎*𝑏 - 𝑐*𝑑  &~:  ㄖ*ㄈ :=: ㄈ*ㄖ" $-      (𝑎*𝑏 - 𝑐*𝑑 &~: ㄖ*ㄈ :=: ㄈ*ㄖ) @?= (𝑏*𝑎 - 𝑑*𝑐 :: Expr)+      (𝑎*𝑏 - 𝑐*𝑑 &~: ㄖ*ㄈ :=: ㄈ*ㄖ) %@?= (𝑏*𝑎 - 𝑑*𝑐 :: Expr)      , testCase "𝑎*𝑏 - 𝑐*𝑑  &~?  ㄖ*ㄈ :=: ㄈ*ㄖ" $       (𝑎*𝑏 - 𝑐*𝑑 &~? ㄖ*ㄈ :=: ㄈ*ㄖ) @?= [𝑏*𝑎 - 𝑐*𝑑, 𝑎*𝑏 - 𝑑*𝑐 :: Expr]      , testCase "𝑎 + 𝑏 + 𝑐 + 𝑑  &~:  ㄜ+ㄑ :=: ㄑ+ㄜ" $-      (𝑎 + 𝑏 + 𝑐 + 𝑑 &~: ㄜ+ㄑ :=: ㄑ+ㄜ) @?= (𝑏 + 𝑎 + 𝑑 + 𝑐 :: Expr)+      (𝑎 + 𝑏 + 𝑐 + 𝑑 &~: ㄜ+ㄑ :=: ㄑ+ㄜ) %@?= (𝑏 + 𝑎 + 𝑑 + 𝑐 :: Expr)      , testCase "𝑎 + 𝑏 + 𝑐 + 𝑑  &~:  𝑏+𝑐 :=: 𝑐+𝑏" $-      (𝑎 + 𝑏 + 𝑐 + 𝑑 &~: 𝑏+𝑐 :=: 𝑐+𝑏) @?= (𝑎 + 𝑐 + 𝑏 + 𝑑 :: Expr)+      (𝑎 + 𝑏 + 𝑐 + 𝑑 &~: 𝑏+𝑐 :=: 𝑐+𝑏) %@?= (𝑎 + 𝑐 + 𝑏 + 𝑑 :: Expr)      , testCase "𝑎 + 𝑏 + 𝑐 + 𝑑  &~?  ㄜ+ㄑ :=: ㄑ+ㄜ" $       (𝑎 + 𝑏 + 𝑐 + 𝑑 &~? ㄜ+ㄑ :=: ㄑ+ㄜ) @?= [ 𝑏 + 𝑎 + 𝑐 + 𝑑                                               , 𝑎 + 𝑐 + 𝑏 + 𝑑@@ -52,39 +54,66 @@       ((𝑎 + 𝑏 + 𝑐  &~? 𝑏+𝑐:=:𝑐+𝑏) >>= (&~? 𝑎+𝑐:=:ξ) )                @?= [ ξ+𝑏 :: Expr]      , testCase "𝑎*𝑥 + 𝑏*𝑥 + 𝑐  &~: ㄏ*ㄘ+ㄐ*ㄘ :=: (ㄏ+ㄐ)*ㄘ" $-      (𝑎*𝑥 + 𝑏*𝑥 + 𝑐 &~: ㄏ*ㄘ+ㄐ*ㄘ :=: (ㄏ+ㄐ)*ㄘ) @?= ((𝑎+𝑏)*𝑥 + 𝑐 :: Expr)+      (𝑎*𝑥 + 𝑏*𝑥 + 𝑐 &~: ㄏ*ㄘ+ㄐ*ㄘ :=: (ㄏ+ㄐ)*ㄘ) %@?= ((𝑎+𝑏)*𝑥 + 𝑐 :: Expr)      , testCase "(𝑎+𝑏)*𝑥 + 𝑐  &~: (ㄏ+ㄐ)*ㄘ :=: ㄏ*ㄘ+ㄐ*ㄘ" $-      ((𝑎+𝑏)*𝑥 + 𝑐 &~: (ㄏ+ㄐ)*ㄘ :=: ㄏ*ㄘ+ㄐ*ㄘ) @?= (𝑎*𝑥 + 𝑏*𝑥 + 𝑐 :: Expr)+      ((𝑎+𝑏)*𝑥 + 𝑐 &~: (ㄏ+ㄐ)*ㄘ :=: ㄏ*ㄘ+ㄐ*ㄘ) %@?= (𝑎*𝑥 + 𝑏*𝑥 + 𝑐 :: Expr)+     , testCase "𝑎*𝑏*𝑐*𝑑 &~: 𝑎*𝑏 :=: 𝑏*𝑎" $+      (𝑎*𝑏*𝑐*𝑑  &~: 𝑎*𝑏 :=: 𝑏*𝑎) %@?= (𝑏*𝑎*𝑐*𝑑 :: Expr)+     , testCase "𝑎*𝑏*𝑐*𝑑 &~: 𝑏*𝑐 :=: 𝑐*𝑏" $+      (𝑎*𝑏*𝑐*𝑑  &~: 𝑏*𝑐 :=: 𝑐*𝑏) %@?= (𝑎*𝑐*𝑏*𝑑 :: Expr)+     , testCase "𝑎*𝑏*𝑐*𝑑 &~: 𝑐*𝑑 :=: 𝑑*𝑐" $+      (𝑎*𝑏*𝑐*𝑑  &~: 𝑐*𝑑 :=: 𝑑*𝑐) %@?= (𝑎*𝑏*𝑑*𝑐 :: Expr)+     , testCase "𝑎 + 𝑏 - 𝑐 &~: 𝑏-𝑐 :=: (-𝑐)+𝑏" $+      (𝑎 + 𝑏 - 𝑐 &~: 𝑏-𝑐 :=: (-𝑐)+𝑏) %@?= (𝑎 + (-𝑐) + 𝑏 :: Expr)      , testCase "Rename local symbols" $-      (map succ%$> 𝑎+𝑝) * 𝑥  @?=  ((𝑏+𝑞) * 𝑥 :: Expr)+      (map succ%$> 𝑎+𝑝) * 𝑥  %@?=  ((𝑏+𝑞) * 𝑥 :: Expr)      ]   , testGroup "Show instance"      [ testCase "𝑎+𝑏+𝑐" $-      show (𝑎+𝑏+𝑐 :: Expr) @?= "𝑎+𝑏+𝑐"+      𝑎+𝑏+𝑐 %@?= "𝑎+𝑏+𝑐"+     , testCase "𝑎-𝑏+𝑐" $+      𝑎-𝑏+𝑐 %@?= "𝑎-𝑏+𝑐"      , testCase "𝑎+(𝑏+𝑐)" $-      show (𝑎+(𝑏+𝑐) :: Expr) @?= "𝑎+(𝑏+𝑐)"+      𝑎+(𝑏+𝑐) %@?= "𝑎+(𝑏+𝑐)"      , testCase "𝑎+𝑏*𝑐" $-      show (𝑎+𝑏*𝑐 :: Expr) @?= "𝑎+𝑏*𝑐"+      𝑎+𝑏*𝑐 %@?= "𝑎+𝑏*𝑐"+     , testCase "3*𝑧-1" $+      3*𝑧-1 %@?= "3*𝑧-1"      , testCase "(𝑎+𝑏)*𝑐" $-      show ((𝑎+𝑏)*𝑐 :: Expr) @?= "(𝑎+𝑏)*𝑐"+      (𝑎+𝑏)*𝑐 %@?= "(𝑎+𝑏)*𝑐"      , testCase "abs (𝑎+𝑏)" $-      show (abs (𝑎+𝑏) :: Expr) @?= "abs (𝑎+𝑏)"+      abs (𝑎+𝑏) %@?= "abs (𝑎+𝑏)"      , testCase "abs 3" $-      show (abs 3 :: Expr) @?= "abs 3"+      abs 3 %@?= "abs 3"      , testCase "𝑎 + -3" $-      show (𝑎+(-3) :: Expr) @?= "𝑎+( -3)"+      𝑎+(-3) %@?= "𝑎-3"      , testCase "𝑎 / signum π" $-      show (𝑎/signum π :: Expr) @?= "𝑎/signum π"+      𝑎/signum π %@?= "𝑎/signum π"      , testCase "logBase 2 32 ** atan pi" $-      show (logBase 2 32 ** atan pi :: Expr) @?= "2`logBase`32**atan pi"+      logBase 2 32 ** atan pi %@?= "2`logBase`32**atan pi"      , testCase "37.84" $-      show (37.84 :: Expr) @?= "37.84"+      37.84 %@?= "37.84"      , testCase "5e-23" $-      show (5e-23 :: Expr) @?= "5e-23"+      5e-23 %@?= "5e-23"      , testCase "-5.3e7" $-      show (-5.3e8 :: Expr) @?= " -5.3e8"+      -5.3e8 %@?= " -5.3e8"      ]   ] +infix 1 %@?=+class ComparableExpressions e f | f -> e where+  (%@?=) :: HasCallStack => e -> f -> Assertion+   +instance ComparableExpressions Expr Expr where+  e %@?= f+   | e==f       = return ()+   | otherwise  = assertFailure+                   $ "Expected "++show f++" 『structure: "++showStructure f++"』,"+                     ++ "\nbut got " ++show e++" 『structure: "++showStructure e++"』," +instance ComparableExpressions Expr String where+  e %@?= f+   | show e==f  = return ()+   | otherwise  = assertFailure $ "Expected \""++f++"\""+                     ++ "\nbut got \"" ++show e++"\" 『structure: "++showStructure e++"』,"