diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -5,8 +5,54 @@
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
-## [Unreleased]
+## [0.4.0.0] -- 2024-01-08
 
+### Added
+
+- Added wrappers for state transformers. ([#132](https://github.com/lsrcz/grisette/pull/132))
+- Added `toGuardList` function. ([#137](https://github.com/lsrcz/grisette/pull/137))
+- Exported some previously hidden API (`BVSignConversion`, `runFreshTFromIndex`) that we found useful or forgot to export. ([#138](https://github.com/lsrcz/grisette/pull/138), [#139](https://github.com/lsrcz/grisette/pull/139))
+- Provided `mrgRunFreshT` to run `FreshT` with merging. ([#140](https://github.com/lsrcz/grisette/pull/140))
+- Added `Grisette.Data.Class.SignConversion.SignConversion` for types from `Data.Int` and `Data.Word`. ([#142](https://github.com/lsrcz/grisette/pull/142))
+- Added shift functions by symbolic shift amounts. ([#151](https://github.com/lsrcz/grisette/pull/151))
+- Added `apply` for uninterpreted functions. ([#155](https://github.com/lsrcz/grisette/pull/155))
+- Added `liftFresh` to lift a `Fresh` into `MonadFresh`. ([#156](https://github.com/lsrcz/grisette/pull/156))
+- Added a handle types for SBV solvers. This allows users to use SBV solvers without the need to wrap everything in the SBV monads. ([#159](https://github.com/lsrcz/grisette/pull/159))
+- Added a new generic CEGIS interface. This allows any verifier/fuzzer to be used in the CEGIS loop. ([#159](https://github.com/lsrcz/grisette/pull/159))
+
+### Removed
+
+- [Breaking] Removed the `Grisette.Lib.Mtl` module. ([#132](https://github.com/lsrcz/grisette/pull/132))
+- [Breaking] Removed `SymBoolOp` and `SymIntegerOp`. ([#146](https://github.com/lsrcz/grisette/pull/146))
+- [Breaking] Removed `ExtractSymbolics` instance for `SymbolSet`. ([#146](https://github.com/lsrcz/grisette/pull/146))
+
+### Fixed
+
+- Removed the quotation marks around the pretty printed results for string-like data types. ([#127](https://github.com/lsrcz/grisette/pull/127))
+- Fixed the `SOrd` instance for `VerificationConditions`. ([#131](https://github.com/lsrcz/grisette/pull/131))
+- Fixed the missing `SubstituteSym` instance for `UnionM`. ([#131](https://github.com/lsrcz/grisette/pull/131))
+- Fixed the symbolic generation order for `Maybe`. ([#131](https://github.com/lsrcz/grisette/pull/131))
+- Fixed the `toInteger` function for `IntN 1`. ([#143](https://github.com/lsrcz/grisette/pull/143))
+- Fixed the `abs` function for `WordN`. ([#144](https://github.com/lsrcz/grisette/pull/143))
+- Fixed the QuickCheck shrink function for `WordN 1` and `IntN 1`. ([#149](https://github.com/lsrcz/grisette/pull/149))
+- Fixed the heap overflow bug for `shiftL` for `WordN` and `IntN` by large numbers. ([#150](https://github.com/lsrcz/grisette/pull/150))
+
+### Changed
+
+- Reorganized the files for `MonadTrans`. ([#132](https://github.com/lsrcz/grisette/pull/132))
+- [Breaking] Changed the name of `Union` constructors and patterns. ([#133](https://github.com/lsrcz/grisette/pull/133))
+- The `Union` patterns, when used as constructors, now merges the result. ([#133](https://github.com/lsrcz/grisette/pull/133))
+- Changed the symbolic identifier type from `String` to `Data.Text.Text`. ([#141](https://github.com/lsrcz/grisette/pull/141))
+- [Breaking] `Grisette.Data.Class.BitVector.BVSignConversion` is now `Grisette.Data.Class.SignConversion.SignConversion`. ([#142](https://github.com/lsrcz/grisette/pull/142))
+- [Breaking] Moved the `ITEOp`, `LogicalOp`, and `SEq` type classes to dedicated modules. ([#146](https://github.com/lsrcz/grisette/pull/146))
+- [Breaking] Moved `Grisette.Data.Class.Evaluate` to `Grisette.Data.Class.EvaluateSym`. ([#146](https://github.com/lsrcz/grisette/pull/146))
+- [Breaking] Moved `Grisette.Data.Class.Substitute` to `Grisette.Data.Class.SubstituteSym`. ([#146](https://github.com/lsrcz/grisette/pull/146))
+- [Breaking] Split the `Grisette.Data.Class.SafeArith` module to `Grisette.Data.Class.SafeDivision` and `Grisette.Data.Class.SafeLinearArith`. ([#146](https://github.com/lsrcz/grisette/pull/146))
+- [Breaking] Changed the API to `MonadFresh`. ([#156](https://github.com/lsrcz/grisette/pull/156))
+- [Breaking] Renamed multiple symbolic operators. ([#158](https://github.com/lsrcz/grisette/pull/158))
+- [Breaking] Changed the solver interface. ([#159](https://github.com/lsrcz/grisette/pull/159))
+- [Breaking] Changed the CEGIS solver interface. ([#159](https://github.com/lsrcz/grisette/pull/159))
+
 ## [0.3.1.1] -- 2023-09-29
 
 No user-facing changes.
@@ -14,17 +60,20 @@
 ## [0.3.1.0] -- 2023-07-19
 
 ### Added
+
 - Added support to `Data.Text`. ([#95](https://github.com/lsrcz/grisette/pull/95))
 - Added `Arbitrary` instances for bit vectors. ([#97](https://github.com/lsrcz/grisette/pull/97))
 - Added pretty printers for Grisette data types. ([#101](https://github.com/lsrcz/grisette/pull/101))
 - Added `ExtractSymbolics` instances for tuples longer than 2. ([#103](https://github.com/lsrcz/grisette/pull/103))
 
 ### Fixed
+
 - Fixed the `Read` instance for bit vectors. ([#99](https://github.com/lsrcz/grisette/pull/99), [#100](https://github.com/lsrcz/grisette/pull/100))
 
 ## [0.3.0.0] -- 2023-07-07
 
 ### Added
+
 - Added the conversion between signed and unsigned bit vectors. ([#69](https://github.com/lsrcz/grisette/pull/69))
 - Added the generation of `SomeSymIntN` and `SomeSymWordN` from a single `Int` for bit width. ([#73](https://github.com/lsrcz/grisette/pull/73))
 - Added the `FiniteBits` instance for `SomeSymIntN` and `SomeSymWordN`. ([#83](https://github.com/lsrcz/grisette/pull/83))
@@ -32,10 +81,12 @@
 - Added an experimental `GenSymConstrained` type class. ([#89](https://github.com/lsrcz/grisette/pull/89))
 
 ### Changed
+
 - Changed the operations for `SomeIntN` and `SomeWordN` to accepting dynamic runtime integers rather than compile-time integers. ([#71](https://github.com/lsrcz/grisette/pull/71))
 - Comparing the equality of `SomeIntN`/`SomeWordN`/`SomeSymIntN`/`SomeSymWordN` with different bit widths returns false rather than crash now. ([#74](https://github.com/lsrcz/grisette/pull/74))
 
 ### Fixed
+
 - Fixed the compatibility issue with sbv 10+. ([#66](https://github.com/lsrcz/grisette/pull/66))
 - Fixed build error with newer GHC. ([#70](https://github.com/lsrcz/grisette/pull/70))
 - Fixed the merging for `SomeSymIntN` and `SomeSymWordN`. ([#72](https://github.com/lsrcz/grisette/pull/72))
@@ -43,6 +94,7 @@
 ## [0.2.0.0] - 2023-04-13
 
 ### Added
+
 - Add term size count API. ([#48](https://github.com/lsrcz/grisette/pull/48), [#53](https://github.com/lsrcz/grisette/pull/53))
 - Add timeout to solver interface. ([#49](https://github.com/lsrcz/grisette/pull/49), [#50](https://github.com/lsrcz/grisette/pull/50))
 - Add parallel do-notation for parallel symbolic compilation. ([#51](https://github.com/lsrcz/grisette/pull/51))
@@ -50,15 +102,18 @@
 - Add missing instances for `MonadFresh` and `FreshT`. ([#59](https://github.com/lsrcz/grisette/pull/59))
 
 ### Changed
+
 - New safe operator interfaces. ([#56](https://github.com/lsrcz/grisette/pull/56))
 - Redesigned symbolic value interface.
   - `Sym Bool`/`Sym Integer`, etc., are no longer available and are replaced with `SymBool` and `SymInteger`. ([#41](https://github.com/lsrcz/grisette/pull/41))
   - New symbolic bit vector interface. Added unsized bit vector. ([#41](https://github.com/lsrcz/grisette/pull/41))
 
 ### Removed
+
 - Dropped merging cache for `UnionM`. This fixed some segmentation fault errors. ([#43](https://github.com/lsrcz/grisette/pull/43))
 
 ### Fixed
+
 - Fix CEGIS when no symbolic input is present. ([#52](https://github.com/lsrcz/grisette/pull/52))
 - Fix overlapping `ToSym` and `ToCon` instances. ([#54](https://github.com/lsrcz/grisette/pull/54))
 - Fix uninterpreted function lowering. ([#57](https://github.com/lsrcz/grisette/pull/57), [#58](https://github.com/lsrcz/grisette/pull/58))
@@ -67,9 +122,10 @@
 ## [0.1.0.0] - 2023-01-20
 
 ### Added
+
 - Initial release for Grisette.
 
-[Unreleased]: https://github.com/lsrcz/grisette/compare/v0.3.1.0...HEAD
+[0.4.0.0]: https://github.com/lsrcz/grisette/compare/v0.4.0.0...v0.3.1.0
 [0.3.1.1]: https://github.com/lsrcz/grisette/compare/v0.3.1.0...v0.3.1.1
 [0.3.1.0]: https://github.com/lsrcz/grisette/compare/v0.3.0.0...v0.3.1.0
 [0.3.0.0]: https://github.com/lsrcz/grisette/compare/v0.2.0.0...v0.3.0.0
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright (c) 2021-2023, Sirui Lu (siruilu@cs.washington.edu)
+Copyright (c) 2021-2024, Sirui Lu (siruilu@cs.washington.edu)
 
 All rights reserved.
 
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -12,10 +12,10 @@
 ## Features
 
 - **Multi-path** symbolic evaluation with efficient (customizable) state merging.
-- Symbolic evaluation is **purely functional**. The propagated symbolic value includes the assertion / error state of the execution, yet it is just a data structure. As a result, Grisette is a library that does not modify the Haskell compiler.  
-- The separation of symbolic and concrete values is enforced with **static types**. These types help discover opportunities for partial evaluation as well as safe use of Haskell libraries. 
+- Symbolic evaluation is **purely functional**. The propagated symbolic value includes the assertion / error state of the execution, yet it is just a data structure. As a result, Grisette is a library that does not modify the Haskell compiler.
+- The separation of symbolic and concrete values is enforced with **static types**. These types help discover opportunities for partial evaluation as well as safe use of Haskell libraries.
 
-## Design and Benefits 
+## Design and Benefits
 
 - Modular purely functional design, with a focus on composability.
   - Allows for symbolic evaluation of user-defined data structures / data
@@ -47,7 +47,7 @@
 ```cabal
 library
   ...
-  build-depends: grisette >= 0.3 < 0.4
+  build-depends: grisette >= 0.4 < 0.5
 ```
 
 #### Quick start template with `stack new`
@@ -79,7 +79,7 @@
 
 ### Install SMT Solvers
 
-To run the examples, you also need to install an SMT solver and make it 
+To run the examples, you also need to install an SMT solver and make it
 available through `PATH`. We recommend that you start with
 [Z3](https://github.com/Z3Prover/z3), as it supports all our examples and is
 usually easier to install.
@@ -114,17 +114,17 @@
 
 ## Example
 
-The following example uses Grisette to build a synthesizer of arithmetic programs. Given the input-output pair (2,5), the synthesizer may output the program (\x -> x+3).  The example is adapted from [this blog
+The following example uses Grisette to build a synthesizer of arithmetic programs. Given the input-output pair (2,5), the synthesizer may output the program (\x -> x+3). The example is adapted from [this blog
 post](https://www.cs.utexas.edu/~bornholt/post/building-synthesizer.html) by
 James Bornholt.
 
-
 The example has three parts:
+
 - We define the arithmetic language. The language is _symbolic_:
   - its syntax tree represents a set of concrete syntax trees, and
-  - its interpreter accepts such symbolic syntax trees, and interprete at once all represented concrete syntax trees. 
-- We define the candidate program space of the synthesizer by creating a particular symbolic syntax tree. The synthesizer will search the space of concrete trees for a solution. 
-- We interpret the symbolic syntax tree and pass the resulting constraints to the solver. If a solution exists, the solver returns a concrete tree that agrees with the input-out example. 
+  - its interpreter accepts such symbolic syntax trees, and interprete at once all represented concrete syntax trees.
+- We define the candidate program space of the synthesizer by creating a particular symbolic syntax tree. The synthesizer will search the space of concrete trees for a solution.
+- We interpret the symbolic syntax tree and pass the resulting constraints to the solver. If a solution exists, the solver returns a concrete tree that agrees with the input-out example.
 
 ### Defining the Arithmetic Language
 
@@ -183,6 +183,7 @@
 -- UMrg (Single (SConst 1))
 $(makeUnionWrapper "mrg" ''SExpr)
 ```
+
 Then we can define the program space.
 The following code defines a program space `\x -> x + {x, c}`. Some example
 programs in this space are `\x -> x + x`, `\x -> x + 1`, and `\x -> x + 2`.
@@ -239,15 +240,17 @@
 
 ## Documentation
 
-- Haddock documentation at  [grisette](https://hackage.haskell.org/package/grisette).
+- Haddock documentation at [grisette](https://hackage.haskell.org/package/grisette).
 - Grisette essentials (WIP).
 - Grisette tutorials (WIP).
 
 ## License
+
 The Grisette library is distributed under the terms of the BSD3 license. The
 [LICENSE](LICENSE) file contains the full license text.
 
 ## Citing Grisette
+
 If you use Grisette in your research, please use the following bibtex entry:
 
 ```bibtex
diff --git a/grisette.cabal b/grisette.cabal
--- a/grisette.cabal
+++ b/grisette.cabal
@@ -1,11 +1,11 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.2.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack
 
 name:           grisette
-version:        0.3.1.1
+version:        0.4.0.0
 synopsis:       Symbolic evaluation as a library
 description:    Grisette is a reusable symbolic evaluation library for Haskell. By
                 translating programs into constraints, Grisette can help the development of
@@ -20,7 +20,7 @@
 bug-reports:    https://github.com/lsrcz/grisette/issues
 author:         Sirui Lu, Rastislav Bodík
 maintainer:     Sirui Lu (siruilu@cs.washington.edu)
-copyright:      2021-2023 Sirui Lu
+copyright:      2021-2024 Sirui Lu
 license:        BSD3
 license-file:   LICENSE
 build-type:     Simple
@@ -28,8 +28,8 @@
     GHC == 8.10.7
   , GHC == 9.0.2
   , GHC == 9.2.8
-  , GHC == 9.4.6
-  , GHC == 9.6.2
+  , GHC == 9.4.8
+  , GHC == 9.6.3
 extra-source-files:
     CHANGELOG.md
     README.md
@@ -38,7 +38,7 @@
   type: git
   location: https://github.com/lsrcz/grisette
 
-flag fast
+flag optimize
   description: Compile with O2 optimization
   manual: False
   default: True
@@ -59,22 +59,30 @@
       Grisette.Core.Control.Monad.UnionM
       Grisette.Core.Data.BV
       Grisette.Core.Data.Class.BitVector
-      Grisette.Core.Data.Class.Bool
       Grisette.Core.Data.Class.CEGISSolver
       Grisette.Core.Data.Class.Error
-      Grisette.Core.Data.Class.Evaluate
+      Grisette.Core.Data.Class.EvaluateSym
       Grisette.Core.Data.Class.ExtractSymbolics
       Grisette.Core.Data.Class.Function
       Grisette.Core.Data.Class.GenSym
       Grisette.Core.Data.Class.GPretty
+      Grisette.Core.Data.Class.ITEOp
+      Grisette.Core.Data.Class.LogicalOp
       Grisette.Core.Data.Class.Mergeable
       Grisette.Core.Data.Class.ModelOps
-      Grisette.Core.Data.Class.SafeArith
+      Grisette.Core.Data.Class.SafeDivision
+      Grisette.Core.Data.Class.SafeLinearArith
+      Grisette.Core.Data.Class.SafeSymRotate
+      Grisette.Core.Data.Class.SafeSymShift
+      Grisette.Core.Data.Class.SEq
+      Grisette.Core.Data.Class.SignConversion
       Grisette.Core.Data.Class.SimpleMergeable
       Grisette.Core.Data.Class.Solvable
       Grisette.Core.Data.Class.Solver
       Grisette.Core.Data.Class.SOrd
-      Grisette.Core.Data.Class.Substitute
+      Grisette.Core.Data.Class.SubstituteSym
+      Grisette.Core.Data.Class.SymRotate
+      Grisette.Core.Data.Class.SymShift
       Grisette.Core.Data.Class.ToCon
       Grisette.Core.Data.Class.ToSym
       Grisette.Core.Data.FileLocation
@@ -113,12 +121,16 @@
       Grisette.Lib.Base
       Grisette.Lib.Control.Monad
       Grisette.Lib.Control.Monad.Except
+      Grisette.Lib.Control.Monad.State.Class
       Grisette.Lib.Control.Monad.Trans
+      Grisette.Lib.Control.Monad.Trans.Class
       Grisette.Lib.Control.Monad.Trans.Cont
+      Grisette.Lib.Control.Monad.Trans.State
+      Grisette.Lib.Control.Monad.Trans.State.Lazy
+      Grisette.Lib.Control.Monad.Trans.State.Strict
       Grisette.Lib.Data.Foldable
       Grisette.Lib.Data.List
       Grisette.Lib.Data.Traversable
-      Grisette.Lib.Mtl
       Grisette.Qualified.ParallelUnionDo
       Grisette.Utils
       Grisette.Utils.Parameterized
@@ -128,8 +140,9 @@
       src
   ghc-options: -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wmissing-export-lists -Wmissing-home-modules -Wmissing-import-lists -Wpartial-fields -Wunused-type-patterns
   build-depends:
-      QuickCheck >=2.13.2 && <2.15
+      QuickCheck ==2.14.*
     , array >=0.5.4 && <0.6
+    , async >=2.2.2 && <2.3
     , base >=4.14 && <5
     , bytestring >=0.10.12 && <0.13
     , deepseq >=1.4.4 && <1.6
@@ -141,14 +154,15 @@
     , mtl >=2.2.2 && <2.4
     , parallel >=3.2.2.0 && <3.3
     , prettyprinter >=1.5.0 && <1.8
-    , sbv >=8.11 && <10.3
-    , template-haskell >=2.16 && <2.21
+    , sbv >=8.11 && <10.4
+    , stm ==2.5.*
+    , template-haskell >=2.16 && <2.22
     , text >=1.2.4.1 && <2.2
     , th-compat >=0.1.2 && <0.2
     , transformers >=0.5.6 && <0.7
     , unordered-containers >=0.2.11 && <0.3
   default-language: Haskell2010
-  if flag(fast)
+  if flag(optimize)
     ghc-options: -O2
   else
     ghc-options: -O0
@@ -163,8 +177,9 @@
   ghc-options: -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wmissing-export-lists -Wmissing-home-modules -Wmissing-import-lists -Wpartial-fields -Wunused-type-patterns -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       Glob
-    , QuickCheck >=2.13.2 && <2.15
+    , QuickCheck ==2.14.*
     , array >=0.5.4 && <0.6
+    , async >=2.2.2 && <2.3
     , base >=4.14 && <5
     , bytestring >=0.10.12 && <0.13
     , deepseq >=1.4.4 && <1.6
@@ -178,14 +193,15 @@
     , mtl >=2.2.2 && <2.4
     , parallel >=3.2.2.0 && <3.3
     , prettyprinter >=1.5.0 && <1.8
-    , sbv >=8.11 && <10.3
-    , template-haskell >=2.16 && <2.21
+    , sbv >=8.11 && <10.4
+    , stm ==2.5.*
+    , template-haskell >=2.16 && <2.22
     , text >=1.2.4.1 && <2.2
     , th-compat >=0.1.2 && <0.2
     , transformers >=0.5.6 && <0.7
     , unordered-containers >=0.2.11 && <0.3
   default-language: Haskell2010
-  if flag(fast)
+  if flag(optimize)
     ghc-options: -O2
   else
     ghc-options: -O0
@@ -198,9 +214,28 @@
       Grisette.Backend.SBV.Data.SMT.LoweringTests
       Grisette.Backend.SBV.Data.SMT.TermRewritingGen
       Grisette.Backend.SBV.Data.SMT.TermRewritingTests
+      Grisette.Core.Control.ExceptionTests
       Grisette.Core.Control.Monad.UnionMTests
+      Grisette.Core.Control.Monad.UnionTests
       Grisette.Core.Data.BVTests
+      Grisette.Core.Data.Class.BoolTests
+      Grisette.Core.Data.Class.EvaluateSymTests
+      Grisette.Core.Data.Class.ExtractSymbolicsTests
+      Grisette.Core.Data.Class.GenSymTests
       Grisette.Core.Data.Class.GPrettyTests
+      Grisette.Core.Data.Class.MergeableTests
+      Grisette.Core.Data.Class.SafeSymRotateTests
+      Grisette.Core.Data.Class.SafeSymShiftTests
+      Grisette.Core.Data.Class.SEqTests
+      Grisette.Core.Data.Class.SimpleMergeableTests
+      Grisette.Core.Data.Class.SOrdTests
+      Grisette.Core.Data.Class.SubstituteSymTests
+      Grisette.Core.Data.Class.SymRotateTests
+      Grisette.Core.Data.Class.SymShiftTests
+      Grisette.Core.Data.Class.TestValues
+      Grisette.Core.Data.Class.ToConTests
+      Grisette.Core.Data.Class.ToSymTests
+      Grisette.Core.Data.Class.UnionLikeTests
       Grisette.IR.SymPrim.Data.Prim.BitsTests
       Grisette.IR.SymPrim.Data.Prim.BoolTests
       Grisette.IR.SymPrim.Data.Prim.BVTests
@@ -210,14 +245,25 @@
       Grisette.IR.SymPrim.Data.Prim.TabularFunTests
       Grisette.IR.SymPrim.Data.SymPrimTests
       Grisette.IR.SymPrim.Data.TabularFunTests
+      Grisette.Lib.Control.Monad.ExceptTests
+      Grisette.Lib.Control.Monad.State.ClassTests
+      Grisette.Lib.Control.Monad.Trans.ClassTests
+      Grisette.Lib.Control.Monad.Trans.State.Common
+      Grisette.Lib.Control.Monad.Trans.State.LazyTests
+      Grisette.Lib.Control.Monad.Trans.State.StrictTests
+      Grisette.Lib.Control.MonadTests
+      Grisette.Lib.Data.FoldableTests
+      Grisette.Lib.Data.TraversableTests
+      Grisette.TestUtil.SymbolicAssertion
       Paths_grisette
   hs-source-dirs:
       test
   ghc-options: -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wmissing-export-lists -Wmissing-home-modules -Wmissing-import-lists -Wpartial-fields -Wunused-type-patterns -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       HUnit ==1.6.*
-    , QuickCheck >=2.13.2 && <2.15
+    , QuickCheck ==2.14.*
     , array >=0.5.4 && <0.6
+    , async >=2.2.2 && <2.3
     , base >=4.14 && <5
     , bytestring >=0.10.12 && <0.13
     , deepseq >=1.4.4 && <1.6
@@ -230,8 +276,9 @@
     , mtl >=2.2.2 && <2.4
     , parallel >=3.2.2.0 && <3.3
     , prettyprinter >=1.5.0 && <1.8
-    , sbv >=8.11 && <10.3
-    , template-haskell >=2.16 && <2.21
+    , sbv >=8.11 && <10.4
+    , stm ==2.5.*
+    , template-haskell >=2.16 && <2.22
     , test-framework >=0.8.2 && <0.9
     , test-framework-hunit >=0.3.0.2 && <0.4
     , test-framework-quickcheck2 >=0.3.0.5 && <0.4
@@ -240,7 +287,7 @@
     , transformers >=0.5.6 && <0.7
     , unordered-containers >=0.2.11 && <0.3
   default-language: Haskell2010
-  if flag(fast)
+  if flag(optimize)
     ghc-options: -O2
   else
     ghc-options: -O0
diff --git a/src/Grisette.hs b/src/Grisette.hs
--- a/src/Grisette.hs
+++ b/src/Grisette.hs
@@ -15,7 +15,6 @@
 
     -- * Core libraries
     module Grisette.Lib.Base,
-    module Grisette.Lib.Mtl,
 
     -- * Symbolic primitives
     module Grisette.IR.SymPrim,
@@ -32,5 +31,4 @@
 import Grisette.Core
 import Grisette.IR.SymPrim
 import Grisette.Lib.Base
-import Grisette.Lib.Mtl
 import Grisette.Utils
diff --git a/src/Grisette/Backend/SBV.hs b/src/Grisette/Backend/SBV.hs
--- a/src/Grisette/Backend/SBV.hs
+++ b/src/Grisette/Backend/SBV.hs
@@ -20,7 +20,6 @@
     withApprox,
     clearApprox,
     GrisetteSMTConfig (..),
-    SolvingFailure (..),
 
     -- * SBV backend solver configuration
     SBV.SMTConfig (..),
@@ -40,7 +39,6 @@
   ( ApproximationConfig (..),
     ExtraConfig (..),
     GrisetteSMTConfig (..),
-    SolvingFailure (..),
     approx,
     clearApprox,
     clearTimeout,
diff --git a/src/Grisette/Backend/SBV/Data/SMT/Lowering.hs b/src/Grisette/Backend/SBV/Data/SMT/Lowering.hs
--- a/src/Grisette/Backend/SBV/Data/SMT/Lowering.hs
+++ b/src/Grisette/Backend/SBV/Data/SMT/Lowering.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE QuantifiedConstraints #-}
@@ -32,17 +33,22 @@
   )
 where
 
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.Reader (MonadTrans (lift), ReaderT)
+import Control.Monad.State (StateT)
 import Data.Bifunctor (Bifunctor (bimap, first, second))
 import Data.Bits
-  ( Bits (complement, rotate, shift, xor, (.&.), (.|.)),
+  ( Bits (complement, xor, (.&.), (.|.)),
   )
 import Data.Dynamic (Typeable, fromDyn, toDyn)
 import Data.Foldable (Foldable (foldl'), asum)
 import Data.Kind (Type)
 import Data.Maybe (fromMaybe)
+import Data.SBV (SIntegral, sRotateLeft, sRotateRight, sShiftLeft, sShiftRight)
 import qualified Data.SBV as SBV
-import qualified Data.SBV.Control as SBVC
 import qualified Data.SBV.Internals as SBVI
+import qualified Data.SBV.Trans as SBVT
+import qualified Data.SBV.Trans.Control as SBVTC
 import Data.Type.Equality (type (~~))
 import Data.Typeable (Proxy (Proxy), type (:~:) (Refl))
 import GHC.Exts (sortWith)
@@ -92,8 +98,6 @@
         BVConcatTerm,
         BVExtendTerm,
         BVSelectTerm,
-        BVToSignedTerm,
-        BVToUnsignedTerm,
         BinaryTerm,
         ComplementBitsTerm,
         ConTerm,
@@ -113,13 +117,17 @@
         QuotIntegralTerm,
         RemBoundedIntegralTerm,
         RemIntegralTerm,
-        RotateBitsTerm,
-        ShiftBitsTerm,
+        RotateLeftTerm,
+        RotateRightTerm,
+        ShiftLeftTerm,
+        ShiftRightTerm,
         SignumNumTerm,
         SymTerm,
         TabularFunApplyTerm,
         TernaryTerm,
         TimesNumTerm,
+        ToSignedTerm,
+        ToUnsignedTerm,
         UMinusNumTerm,
         UnaryTerm,
         XorBitsTerm
@@ -620,12 +628,18 @@
 class (Monad m) => SBVFreshMonad m where
   sbvFresh :: (SBV.SymVal a) => String -> m (SBV.SBV a)
 
-instance SBVFreshMonad SBV.Symbolic where
-  sbvFresh = SBV.free
+instance (MonadIO m) => SBVFreshMonad (SBVT.SymbolicT m) where
+  sbvFresh = SBVT.free
 
-instance SBVFreshMonad SBVC.Query where
-  sbvFresh = SBVC.freshVar
+instance (MonadIO m) => SBVFreshMonad (SBVTC.QueryT m) where
+  sbvFresh = SBVTC.freshVar
 
+instance (SBVFreshMonad m) => SBVFreshMonad (ReaderT r m) where
+  sbvFresh = lift . sbvFresh
+
+instance (SBVFreshMonad m) => SBVFreshMonad (StateT s m) where
+  sbvFresh = lift . sbvFresh
+
 lowerUnaryTerm ::
   forall integerBitWidth a a1 x x1 m.
   (Typeable x1, a1 ~ TermTy integerBitWidth a, SupportedPrim x, HasCallStack, SBVFreshMonad m) =>
@@ -774,30 +788,67 @@
   case (config, R.typeRep @a) of
     ResolvedBitsType -> lowerUnaryTerm config t arg complement m
     _ -> translateUnaryError "complement" (R.typeRep @a) (R.typeRep @a)
-lowerSinglePrimImpl config t@(ShiftBitsTerm _ arg n) m =
+lowerSinglePrimImpl config t@(ShiftLeftTerm _ arg n) m =
   case (config, R.typeRep @a) of
-    ResolvedBitsType -> lowerUnaryTerm config t arg (`shift` n) m
-    _ -> translateBinaryError "shift" (R.typeRep @a) (R.typeRep @Int) (R.typeRep @a)
-lowerSinglePrimImpl config t@(RotateBitsTerm _ arg n) m =
+    ResolvedBitsType -> lowerBinaryTerm config t arg n sShiftLeft m
+    _ -> translateBinaryError "shiftLeft" (R.typeRep @a) (R.typeRep @Int) (R.typeRep @a)
+lowerSinglePrimImpl config t@(ShiftRightTerm _ arg n) m =
   case (config, R.typeRep @a) of
-    ResolvedBitsType -> lowerUnaryTerm config t arg (`rotate` n) m
-    _ -> translateBinaryError "rotate" (R.typeRep @a) (R.typeRep @Int) (R.typeRep @a)
-lowerSinglePrimImpl config t@(BVToSignedTerm _ (bv :: Term x)) m =
+    ResolvedBitsType -> lowerBinaryTerm config t arg n sShiftRight m
+    _ -> translateBinaryError "shiftRight" (R.typeRep @a) (R.typeRep @Int) (R.typeRep @a)
+-- SBV's rotateLeft and rotateRight are broken for signed values, so we have to
+-- do this
+-- https://github.com/LeventErkok/sbv/issues/673
+lowerSinglePrimImpl config t@(RotateLeftTerm _ arg n) m =
+  case (config, R.typeRep @a) of
+    (_, SignedBVType (Proxy :: Proxy n)) ->
+      lowerBinaryTerm
+        config
+        t
+        arg
+        n
+        ( \x y ->
+            SBV.sFromIntegral $
+              sRotateLeft
+                (SBV.sFromIntegral x :: SBV.SWord n)
+                (SBV.sFromIntegral y :: SBV.SWord n)
+        )
+        m
+    ResolvedBitsType -> lowerBinaryTerm config t arg n sRotateLeft m
+    _ -> translateBinaryError "rotateLeft" (R.typeRep @a) (R.typeRep @Int) (R.typeRep @a)
+lowerSinglePrimImpl config t@(RotateRightTerm _ arg n) m =
+  case (config, R.typeRep @a) of
+    (_, SignedBVType (Proxy :: Proxy n)) ->
+      lowerBinaryTerm
+        config
+        t
+        arg
+        n
+        ( \x y ->
+            SBV.sFromIntegral $
+              sRotateRight
+                (SBV.sFromIntegral x :: SBV.SWord n)
+                (SBV.sFromIntegral y :: SBV.SWord n)
+        )
+        m
+    ResolvedBitsType -> lowerBinaryTerm config t arg n sRotateRight m
+    _ -> translateBinaryError "rotateRight" (R.typeRep @a) (R.typeRep @Int) (R.typeRep @a)
+lowerSinglePrimImpl config t@(ToSignedTerm _ (bv :: Term x)) m =
   case (R.typeRep @a, R.typeRep @x) of
     (SignedBVType (_ :: Proxy na), UnsignedBVType (_ :: Proxy nx)) ->
       case R.eqTypeRep (R.typeRep @na) (R.typeRep @nx) of
         Just R.HRefl ->
           lowerUnaryTerm config t bv SBV.sFromIntegral m
-        _ -> translateUnaryError "bvu2s" (R.typeRep @x) (R.typeRep @a)
-    _ -> translateUnaryError "bvu2s" (R.typeRep @x) (R.typeRep @a)
-lowerSinglePrimImpl config t@(BVToUnsignedTerm _ (bv :: Term x)) m =
+        _ -> translateUnaryError "u2s" (R.typeRep @x) (R.typeRep @a)
+    _ -> translateUnaryError "u2s" (R.typeRep @x) (R.typeRep @a)
+lowerSinglePrimImpl config t@(ToUnsignedTerm _ (bv :: Term x)) m =
   case (R.typeRep @a, R.typeRep @x) of
     (UnsignedBVType (_ :: Proxy na), SignedBVType (_ :: Proxy nx)) ->
       case R.eqTypeRep (R.typeRep @na) (R.typeRep @nx) of
         Just R.HRefl ->
           lowerUnaryTerm config t bv SBV.sFromIntegral m
-        _ -> translateUnaryError "bvs2u" (R.typeRep @x) (R.typeRep @a)
-    _ -> translateUnaryError "bvs2u" (R.typeRep @x) (R.typeRep @a)
+        _ -> translateUnaryError "s2u" (R.typeRep @x) (R.typeRep @a)
+    _ -> translateUnaryError "s2u" (R.typeRep @x) (R.typeRep @a)
 lowerSinglePrimImpl config t@(BVConcatTerm _ (bv1 :: Term x) (bv2 :: Term y)) m =
   case (R.typeRep @a, R.typeRep @x, R.typeRep @y) of
     (UnsignedBVType (_ :: Proxy na), UnsignedBVType (_ :: Proxy nx), UnsignedBVType (_ :: Proxy ny)) ->
@@ -915,8 +966,17 @@
 bvIsNonZeroFromGEq1 r1 = case unsafeAxiom :: w :~: 1 of
   Refl -> r1
 
-#if MIN_VERSION_sbv(10,0,0)
+#if MIN_VERSION_sbv(10,3,0)
 preprocessUIFuncs ::
+  [(String, (Bool, SBVI.SBVType, Either String ([([SBVI.CV], SBVI.CV)], SBVI.CV)))] ->
+  Maybe [(String, (SBVI.SBVType, ([([SBVI.CV], SBVI.CV)], SBVI.CV)))]
+preprocessUIFuncs =
+  traverse
+    (\case
+      (a, (_, b, Right c)) -> Just (a, (b, c))
+      _ -> Nothing)
+#elif MIN_VERSION_sbv(10,0,0)
+preprocessUIFuncs ::
   [(String, (SBVI.SBVType, Either String ([([SBVI.CV], SBVI.CV)], SBVI.CV)))] ->
   Maybe [(String, (SBVI.SBVType, ([([SBVI.CV], SBVI.CV)], SBVI.CV)))]
 preprocessUIFuncs =
@@ -1795,7 +1855,9 @@
   ( SimpleTypeConstraint integerBitWidth s s',
     Bits (SBV.SBV s'),
     Bits s',
-    Bits s
+    Bits s,
+    SIntegral s',
+    Integral s
   )
 
 data DictBitsType integerBitWidth s where
diff --git a/src/Grisette/Backend/SBV/Data/SMT/Solving.hs b/src/Grisette/Backend/SBV/Data/SMT/Solving.hs
--- a/src/Grisette/Backend/SBV/Data/SMT/Solving.hs
+++ b/src/Grisette/Backend/SBV/Data/SMT/Solving.hs
@@ -1,13 +1,11 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneKindSignatures #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -23,7 +21,11 @@
 -- Stability   :   Experimental
 -- Portability :   GHC only
 module Grisette.Backend.SBV.Data.SMT.Solving
-  ( ApproximationConfig (..),
+  ( -- * Term type computation
+    TermTy,
+
+    -- * SBV backend configuration
+    ApproximationConfig (..),
     ExtraConfig (..),
     precise,
     approx,
@@ -32,65 +34,76 @@
     withApprox,
     clearApprox,
     GrisetteSMTConfig (..),
-    SolvingFailure (..),
-    TermTy,
+
+    -- * SBV monadic solver interface
+    SBVIncrementalT,
+    SBVIncremental,
+    runSBVIncrementalT,
+    runSBVIncremental,
+
+    -- * SBV solver handle
+    SBVSolverHandle,
   )
 where
 
-import Control.DeepSeq (NFData)
-import Control.Exception (handle)
-import Control.Monad.IO.Class (liftIO)
-import qualified Data.HashSet as S
-import Data.Hashable (Hashable)
+import Control.Concurrent.Async (Async (asyncThreadId), async, wait)
+import Control.Concurrent.STM
+  ( TMVar,
+    atomically,
+    newTMVarIO,
+    putTMVar,
+    takeTMVar,
+    tryReadTMVar,
+    tryTakeTMVar,
+  )
+import Control.Concurrent.STM.TChan (TChan, newTChan, readTChan, writeTChan)
+import Control.Exception (handle, throwTo)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.Reader
+  ( MonadReader (ask),
+    MonadTrans (lift),
+    ReaderT (runReaderT),
+  )
+import Control.Monad.STM (STM)
+import Control.Monad.State (MonadState (get, put), StateT, evalStateT)
 import Data.Kind (Type)
-import Data.List (partition)
-import Data.Maybe (fromJust)
 import qualified Data.SBV as SBV
-import Data.SBV.Control (Query)
 import qualified Data.SBV.Control as SBVC
+import qualified Data.SBV.Trans as SBVT
+import qualified Data.SBV.Trans.Control as SBVTC
+import GHC.IO.Exception (ExitCode (ExitSuccess))
 import GHC.TypeNats (KnownNat, Nat)
 import Grisette.Backend.SBV.Data.SMT.Lowering
   ( SymBiMap,
-    lowerSinglePrim,
     lowerSinglePrimCached,
     parseModel,
   )
+import Grisette.Backend.SBV.Data.SMT.SymBiMap (emptySymBiMap)
 import Grisette.Core.Data.BV (IntN, WordN)
-import Grisette.Core.Data.Class.Bool (LogicalOp (nots, (&&~)))
-import Grisette.Core.Data.Class.CEGISSolver
-  ( CEGISCondition (CEGISCondition),
-    CEGISSolver (cegisMultiInputs),
-  )
-import Grisette.Core.Data.Class.Evaluate (EvaluateSym (evaluateSym))
-import Grisette.Core.Data.Class.ExtractSymbolics
-  ( ExtractSymbolics (extractSymbolics),
-  )
-import Grisette.Core.Data.Class.ModelOps
-  ( ModelOps (exact, exceptFor),
-    SymbolSetOps (isEmptySet),
-  )
-import Grisette.Core.Data.Class.Solvable (Solvable (con))
-import Grisette.Core.Data.Class.Solver (Solver (solve, solveAll, solveMulti))
-import Grisette.IR.SymPrim.Data.Prim.InternedTerm.InternedCtors
-  ( conTerm,
+import Grisette.Core.Data.Class.Solver
+  ( ConfigurableSolver (newSolver),
+    MonadicSolver
+      ( monadicSolverPop,
+        monadicSolverPush,
+        monadicSolverSolve
+      ),
+    Solver
+      ( solverForceTerminate,
+        solverRunCommand,
+        solverSolve,
+        solverTerminate
+      ),
+    SolverCommand (SolverPop, SolverPush, SolverSolve, SolverTerminate),
+    SolvingFailure (SolvingError, Terminated, Unk, Unsat),
   )
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
-  ( SomeTypedSymbol (SomeTypedSymbol),
-    Term,
-    type (-->),
+  ( type (-->),
   )
 import Grisette.IR.SymPrim.Data.Prim.Model as PM
   ( Model,
-    SymbolSet (unSymbolSet),
-    equation,
   )
-import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bool
-  ( pevalNotTerm,
-    pevalOrTerm,
-  )
 import Grisette.IR.SymPrim.Data.SymPrim (SymBool (SymBool))
 import Grisette.IR.SymPrim.Data.TabularFun (type (=->))
-import Language.Haskell.TH.Syntax (Lift)
 
 -- $setup
 -- >>> import Grisette.Core
@@ -120,8 +133,8 @@
 
 -- | Configures how to approximate unbounded values.
 --
--- For example, if we use @'Approx' ('Data.Proxy' :: 'Data.Proxy' 4)@ to approximate the
--- following unbounded integer:
+-- For example, if we use @'Approx' ('Data.Proxy' :: 'Data.Proxy' 4)@ to
+-- approximate the following unbounded integer:
 --
 -- > (+ a 9)
 --
@@ -136,8 +149,12 @@
 -- more details.
 data ApproximationConfig (n :: Nat) where
   NoApprox :: ApproximationConfig 0
-  Approx :: (KnownNat n, IsZero n ~ 'False, SBV.BVIsNonZero n) => p n -> ApproximationConfig n
+  Approx ::
+    (KnownNat n, IsZero n ~ 'False, SBV.BVIsNonZero n) =>
+    p n ->
+    ApproximationConfig n
 
+-- | Grisette specific extra configurations for the SBV backend.
 data ExtraConfig (i :: Nat) = ExtraConfig
   { -- | Timeout in milliseconds for each solver call. CEGIS may call the
     -- solver multiple times and each call has its own timeout.
@@ -203,31 +220,36 @@
 -- one, and should work well when no overflow is possible, in which case the
 -- performance can be improved with almost no cost.
 --
--- We must note that the bounded translation is an approximation and is __/not/__
--- __/sound/__. As the approximation happens only during the final translation,
--- the symbolic evaluation may aggressively optimize the term based on the
--- properties of mathematical integer arithmetic. This may cause the solver yield
--- results that is incorrect under both unbounded or bounded semantics.
+-- We must note that the bounded translation is an approximation and is
+-- __/not sound/__. As the approximation happens only during the final
+-- translation, the symbolic evaluation may aggressively optimize the term based
+-- on the properties of mathematical integer arithmetic. This may cause the
+-- solver yield results that is incorrect under both unbounded or bounded
+-- semantics.
 --
 -- The following is an example that is correct under bounded semantics, while is
 -- incorrect under the unbounded semantics:
 --
 -- >>> :set -XTypeApplications -XOverloadedStrings -XDataKinds
 -- >>> let a = "a" :: SymInteger
--- >>> solve (precise z3) $ a >~ 7 &&~ a <~ 9
+-- >>> solve (precise z3) $ a .> 7 .&& a .< 9
 -- Right (Model {a -> 8 :: Integer})
--- >>> solve (approx (Proxy @4) z3) $ a >~ 7 &&~ a <~ 9
+-- >>> solve (approx (Proxy @4) z3) $ a .> 7 .&& a .< 9
 -- Left Unsat
 --
 -- This may be avoided by setting an large enough reasoning precision to prevent
 -- overflows.
-data GrisetteSMTConfig (i :: Nat) = GrisetteSMTConfig {sbvConfig :: SBV.SMTConfig, extraConfig :: ExtraConfig i}
+data GrisetteSMTConfig (i :: Nat) = GrisetteSMTConfig
+  { sbvConfig :: SBV.SMTConfig,
+    extraConfig :: ExtraConfig i
+  }
 
 -- | A precise reasoning configuration with the given SBV solver configuration.
 precise :: SBV.SMTConfig -> GrisetteSMTConfig 0
 precise config = GrisetteSMTConfig config preciseExtraConfig
 
--- | An approximate reasoning configuration with the given SBV solver configuration.
+-- | An approximate reasoning configuration with the given SBV solver
+-- configuration.
 approx ::
   forall p n.
   (KnownNat n, IsZero n ~ 'False, SBV.BVIsNonZero n) =>
@@ -238,228 +260,159 @@
 
 -- | Set the timeout for the solver configuration.
 withTimeout :: Int -> GrisetteSMTConfig i -> GrisetteSMTConfig i
-withTimeout t config = config {extraConfig = (extraConfig config) {timeout = Just t}}
+withTimeout t config =
+  config {extraConfig = (extraConfig config) {timeout = Just t}}
 
 -- | Clear the timeout for the solver configuration.
 clearTimeout :: GrisetteSMTConfig i -> GrisetteSMTConfig i
-clearTimeout config = config {extraConfig = (extraConfig config) {timeout = Nothing}}
+clearTimeout config =
+  config {extraConfig = (extraConfig config) {timeout = Nothing}}
 
 -- | Set the reasoning precision for the solver configuration.
-withApprox :: (KnownNat n, IsZero n ~ 'False, SBV.BVIsNonZero n) => p n -> GrisetteSMTConfig i -> GrisetteSMTConfig n
-withApprox p config = config {extraConfig = (extraConfig config) {integerApprox = Approx p}}
+withApprox ::
+  (KnownNat n, IsZero n ~ 'False, SBV.BVIsNonZero n) =>
+  p n ->
+  GrisetteSMTConfig i ->
+  GrisetteSMTConfig n
+withApprox p config =
+  config {extraConfig = (extraConfig config) {integerApprox = Approx p}}
 
 -- | Clear the reasoning precision and perform precise reasoning with the
 -- solver configuration.
 clearApprox :: GrisetteSMTConfig i -> GrisetteSMTConfig 0
-clearApprox config = config {extraConfig = (extraConfig config) {integerApprox = NoApprox}}
-
-data SolvingFailure
-  = DSat (Maybe String)
-  | Unsat
-  | Unk
-  | ResultNumLimitReached
-  | SolvingError SBV.SBVException
-  deriving (Show)
+clearApprox config =
+  config {extraConfig = (extraConfig config) {integerApprox = NoApprox}}
 
 sbvCheckSatResult :: SBVC.CheckSatResult -> SolvingFailure
 sbvCheckSatResult SBVC.Sat = error "Should not happen"
-sbvCheckSatResult (SBVC.DSat msg) = DSat msg
+sbvCheckSatResult (SBVC.DSat _) = error "DSat is currently not supported"
 sbvCheckSatResult SBVC.Unsat = Unsat
 sbvCheckSatResult SBVC.Unk = Unk
 
-applyTimeout :: GrisetteSMTConfig i -> Query a -> Query a
+-- | Apply the timeout to the configuration.
+applyTimeout ::
+  (MonadIO m, SBVTC.MonadQuery m) => GrisetteSMTConfig i -> m a -> m a
 applyTimeout config q = case timeout (extraConfig config) of
   Nothing -> q
-  Just t -> SBVC.timeout t q
+  Just t -> SBVTC.timeout t q
 
-solveTermWith ::
-  forall integerBitWidth.
-  GrisetteSMTConfig integerBitWidth ->
-  Term Bool ->
-  IO (Either SolvingFailure PM.Model)
-solveTermWith config term =
-  handle (return . Left . SolvingError) $
-    SBV.runSMTWith (sbvConfig config) $ do
-      (m, a) <- lowerSinglePrim config term
-      SBVC.query $ applyTimeout config $ do
-        SBV.constrain a
-        r <- SBVC.checkSat
-        case r of
-          SBVC.Sat -> do
-            md <- SBVC.getModel
-            return (Right $ parseModel config md m)
-          _ -> return (Left $ sbvCheckSatResult r)
+-- | Incremental solver monad transformer with the SBV backend.
+type SBVIncrementalT n m =
+  ReaderT (GrisetteSMTConfig n) (StateT SymBiMap (SBVTC.QueryT m))
 
-instance Solver (GrisetteSMTConfig n) SolvingFailure where
-  solve config (SymBool t) = solveTermWith config t
-  solveMulti config n s@(SymBool t)
-    | n > 0 =
-        handle
-          ( \(x :: SBV.SBVException) -> do
-              print "An SBV Exception occurred:"
-              print x
-              print $
-                "Warning: Note that solveMulti do not fully support "
-                  ++ "timeouts, and will return an empty list if the solver"
-                  ++ "timeouts in any iteration."
-              return ([], SolvingError x)
-          )
-          $ SBV.runSMTWith (sbvConfig config)
-          $ do
-            (newm, a) <- lowerSinglePrim config t
-            SBVC.query $ applyTimeout config $ do
-              SBV.constrain a
-              r <- SBVC.checkSat
-              case r of
-                SBVC.Sat -> do
-                  md <- SBVC.getModel
-                  let model = parseModel config md newm
-                  remainingModels n model newm
-                _ -> return ([], sbvCheckSatResult r)
-    | otherwise = return ([], ResultNumLimitReached)
-    where
-      allSymbols = extractSymbolics s :: SymbolSet
-      next :: PM.Model -> SymBiMap -> Query (SymBiMap, Either SBVC.CheckSatResult PM.Model)
-      next md origm = do
-        let newtm =
-              S.foldl'
-                (\acc (SomeTypedSymbol _ v) -> pevalOrTerm acc (pevalNotTerm (fromJust $ equation v md)))
-                (conTerm False)
-                (unSymbolSet allSymbols)
-        (newm, lowered) <- lowerSinglePrimCached config newtm origm
-        SBV.constrain lowered
-        r <- SBVC.checkSat
-        case r of
-          SBVC.Sat -> do
-            md1 <- SBVC.getModel
-            let model = parseModel config md1 newm
-            return (newm, Right model)
-          _ -> return (newm, Left r)
-      remainingModels :: Int -> PM.Model -> SymBiMap -> Query ([PM.Model], SolvingFailure)
-      remainingModels n1 md origm
-        | n1 > 1 = do
-            (newm, r) <- next md origm
-            case r of
-              Left r -> return ([md], sbvCheckSatResult r)
-              Right mo -> do
-                (rmmd, e) <- remainingModels (n1 - 1) mo newm
-                return (md : rmmd, e)
-        | otherwise = return ([md], ResultNumLimitReached)
-  solveAll = undefined
+-- | Incremental solver monad with the SBV backend.
+type SBVIncremental n = SBVIncrementalT n IO
 
-instance CEGISSolver (GrisetteSMTConfig n) SolvingFailure where
-  cegisMultiInputs ::
-    forall inputs.
-    (ExtractSymbolics inputs, EvaluateSym inputs) =>
-    GrisetteSMTConfig n ->
-    [inputs] ->
-    (inputs -> CEGISCondition) ->
-    IO ([inputs], Either SolvingFailure PM.Model)
-  cegisMultiInputs config inputs func =
-    case symInputs of
-      [] -> do
-        m <- solve config (cexesAssertFun conInputs)
-        return (conInputs, m)
-      _ ->
-        handle
-          ( \(x :: SBV.SBVException) -> do
-              print "An SBV Exception occurred:"
-              print x
-              print $
-                "Warning: Note that CEGIS procedures do not fully support "
-                  ++ "timeouts, and will return an empty counter example list if "
-                  ++ "the solver timeouts during guessing phase."
-              return ([], Left $ SolvingError x)
-          )
-          $ go1 (cexesAssertFun conInputs) conInputs (error "Should have at least one gen") [] (con True) (con True) symInputs
-    where
-      (conInputs, symInputs) = partition (isEmptySet . extractSymbolics) inputs
-      go1 :: SymBool -> [inputs] -> PM.Model -> [inputs] -> SymBool -> SymBool -> [inputs] -> IO ([inputs], Either SolvingFailure PM.Model)
-      go1 cexFormula cexes previousModel inputs pre post remainingSymInputs = do
-        case remainingSymInputs of
-          [] -> return (cexes, Right previousModel)
-          newInput : vs -> do
-            let CEGISCondition nextPre nextPost = func newInput
-            let finalPre = pre &&~ nextPre
-            let finalPost = post &&~ nextPost
-            r <- go cexFormula newInput (newInput : inputs) finalPre finalPost
-            case r of
-              (newCexes, Left failure) -> return (cexes ++ newCexes, Left failure)
-              (newCexes, Right mo) -> do
-                go1
-                  (cexFormula &&~ cexesAssertFun newCexes)
-                  (cexes ++ newCexes)
-                  mo
-                  (newInput : inputs)
-                  finalPre
-                  finalPost
-                  vs
-      cexAssertFun input =
-        let CEGISCondition pre post = func input in pre &&~ post
-      cexesAssertFun :: [inputs] -> SymBool
-      cexesAssertFun = foldl (\acc x -> acc &&~ cexAssertFun x) (con True)
-      go ::
-        SymBool ->
-        inputs ->
-        [inputs] ->
-        SymBool ->
-        SymBool ->
-        IO ([inputs], Either SolvingFailure PM.Model)
-      go cexFormula inputs allInputs pre post =
-        SBV.runSMTWith (sbvConfig config) $ do
-          let SymBool t = phi &&~ cexFormula
-          (newm, a) <- lowerSinglePrim config t
-          SBVC.query $
-            applyTimeout config $
-              snd <$> do
-                SBV.constrain a
-                r <- SBVC.checkSat
-                mr <- case r of
-                  SBVC.Sat -> do
-                    md <- SBVC.getModel
-                    return $ Right $ parseModel config md newm
-                  _ -> return $ Left $ sbvCheckSatResult r
-                loop ((forallSymbols `exceptFor`) <$> mr) [] newm
-        where
-          forallSymbols :: SymbolSet
-          forallSymbols = extractSymbolics allInputs
-          phi = pre &&~ post
-          negphi = pre &&~ nots post
-          check :: Model -> IO (Either SolvingFailure (inputs, PM.Model))
-          check candidate = do
-            let evaluated = evaluateSym False candidate negphi
-            r <- solve config evaluated
-            return $ do
-              m <- r
-              let newm = exact forallSymbols m
-              return (evaluateSym False newm inputs, newm)
-          guess :: Model -> SymBiMap -> Query (SymBiMap, Either SolvingFailure PM.Model)
-          guess candidate origm = do
-            let SymBool evaluated = evaluateSym False candidate phi
-            (newm, lowered) <- lowerSinglePrimCached config evaluated origm
-            SBV.constrain lowered
-            r <- SBVC.checkSat
-            case r of
-              SBVC.Sat -> do
-                md <- SBVC.getModel
-                let model = parseModel config md newm
-                return (newm, Right $ exceptFor forallSymbols model)
-              _ -> return (newm, Left $ sbvCheckSatResult r)
-          loop ::
-            Either SolvingFailure PM.Model ->
-            [inputs] ->
-            SymBiMap ->
-            Query (SymBiMap, ([inputs], Either SolvingFailure PM.Model))
-          loop (Right mo) cexes origm = do
-            r <- liftIO $ check mo
-            case r of
-              Left Unsat -> return (origm, (cexes, Right mo))
-              Left v -> return (origm, (cexes, Left v))
-              Right (cex, cexm) -> do
-                (newm, res) <- guess cexm origm
-                loop res (cex : cexes) newm
-          loop (Left v) cexes origm = return (origm, (cexes, Left v))
+-- | Run the incremental solver monad with a given configuration.
+runSBVIncremental :: GrisetteSMTConfig n -> SBVIncremental n a -> IO a
+runSBVIncremental = runSBVIncrementalT
 
-newtype CegisInternal = CegisInternal Int
-  deriving (Eq, Show, Ord, Lift)
-  deriving newtype (Hashable, NFData)
+-- | Run the incremental solver monad transformer with a given configuration.
+runSBVIncrementalT ::
+  (SBVTC.ExtractIO m) =>
+  GrisetteSMTConfig n ->
+  SBVIncrementalT n m a ->
+  m a
+runSBVIncrementalT config sbvIncrementalT =
+  SBVT.runSMTWith (sbvConfig config) $
+    SBVTC.query $
+      applyTimeout config $
+        flip evalStateT emptySymBiMap $
+          runReaderT sbvIncrementalT config
+
+instance (MonadIO m) => MonadicSolver (SBVIncrementalT n m) where
+  monadicSolverSolve (SymBool formula) = do
+    symBiMap <- get
+    config <- ask
+    (newSymBiMap, lowered) <- lowerSinglePrimCached config formula symBiMap
+    lift $ lift $ SBV.constrain lowered
+    put newSymBiMap
+    checkSatResult <- SBVTC.checkSat
+    case checkSatResult of
+      SBVC.Sat -> do
+        sbvModel <- SBVTC.getModel
+        let model = parseModel config sbvModel newSymBiMap
+        return $ Right model
+      r -> return $ Left $ sbvCheckSatResult r
+  monadicSolverPush = SBVTC.push
+  monadicSolverPop = SBVTC.pop
+
+data SBVSolverStatus = SBVSolverNormal | SBVSolverTerminated
+
+-- | The handle type for the SBV solver.
+--
+-- See 'ConfigurableSolver' and 'Solver' for the interfaces.
+data SBVSolverHandle = SBVSolverHandle
+  { sbvSolverHandleMonad :: Async (),
+    sbvSolverHandleStatus :: TMVar SBVSolverStatus,
+    sbvSolverHandleInChan :: TChan SolverCommand,
+    sbvSolverHandleOutChan :: TChan (Either SolvingFailure Model)
+  }
+
+setTerminated :: TMVar SBVSolverStatus -> STM ()
+setTerminated status = do
+  _ <- tryTakeTMVar status
+  putTMVar status SBVSolverTerminated
+
+instance ConfigurableSolver (GrisetteSMTConfig n) SBVSolverHandle where
+  newSolver config = do
+    sbvSolverHandleInChan <- atomically newTChan
+    sbvSolverHandleOutChan <- atomically newTChan
+    sbvSolverHandleStatus <- newTMVarIO SBVSolverNormal
+    sbvSolverHandleMonad <- async $ do
+      let handler e =
+            liftIO $
+              atomically $ do
+                setTerminated sbvSolverHandleStatus
+                writeTChan sbvSolverHandleOutChan (Left (SolvingError e))
+      handle handler $ runSBVIncremental config $ do
+        let loop = do
+              nextFormula <- liftIO $ atomically $ readTChan sbvSolverHandleInChan
+              case nextFormula of
+                SolverPush n -> monadicSolverPush n >> loop
+                SolverPop n -> monadicSolverPop n >> loop
+                SolverTerminate -> return ()
+                SolverSolve formula -> do
+                  r <- monadicSolverSolve formula
+                  liftIO $ atomically $ writeTChan sbvSolverHandleOutChan r
+                  loop
+        loop
+        liftIO $ atomically $ do
+          setTerminated sbvSolverHandleStatus
+          writeTChan sbvSolverHandleOutChan $ Left Terminated
+    return $ SBVSolverHandle {..}
+
+instance Solver SBVSolverHandle where
+  solverRunCommand f handle@(SBVSolverHandle _ status inChan _) command = do
+    st <- liftIO $ atomically $ takeTMVar status
+    case st of
+      SBVSolverNormal -> do
+        liftIO $ atomically $ writeTChan inChan command
+        r <- f handle
+        liftIO $ atomically $ do
+          currStatus <- tryReadTMVar status
+          case currStatus of
+            Nothing -> putTMVar status SBVSolverNormal
+            Just _ -> return ()
+        return r
+      SBVSolverTerminated -> do
+        liftIO $ atomically $ setTerminated status
+        return $ Left Terminated
+  solverSolve handle nextFormula =
+    solverRunCommand
+      ( \(SBVSolverHandle _ _ _ outChan) ->
+          liftIO $ atomically $ readTChan outChan
+      )
+      handle
+      $ SolverSolve nextFormula
+  solverTerminate (SBVSolverHandle thread status inChan _) = do
+    liftIO $ atomically $ do
+      setTerminated status
+      writeTChan inChan SolverTerminate
+    wait thread
+  solverForceTerminate (SBVSolverHandle thread status _ outChan) = do
+    liftIO $ atomically $ do
+      setTerminated status
+      writeTChan outChan (Left Terminated)
+    throwTo (asyncThreadId thread) ExitSuccess
+    wait thread
diff --git a/src/Grisette/Core.hs b/src/Grisette/Core.hs
--- a/src/Grisette/Core.hs
+++ b/src/Grisette/Core.hs
@@ -166,7 +166,7 @@
     --
     -- >>> let a = "a" :: SymInteger
     -- >>> let b = "b" :: SymInteger
-    -- >>> a ==~ b
+    -- >>> a .== b
     -- (= a b)
 
     -- *** Creation of solvable type values
@@ -181,16 +181,16 @@
     LogicalOp (..),
     ITEOp (..),
     SEq (..),
-    SymBoolOp,
     SOrd (..),
     BV (..),
     bvExtract,
     SizedBV (..),
     sizedBVExtract,
+    SignConversion (..),
     SafeDivision (..),
     SafeLinearArith (..),
-    SymIntegerOp,
     Function (..),
+    Apply (..),
 
     -- ** Unsolvable types
 
@@ -600,8 +600,8 @@
     merge,
     mrgSingle,
     UnionPrjOp (..),
-    pattern SingleU,
-    pattern IfU,
+    pattern Single,
+    pattern If,
     MonadUnion,
     MonadParallelUnion (..),
     simpleMerge,
@@ -609,7 +609,7 @@
     onUnion2,
     onUnion3,
     onUnion4,
-    (#~),
+    (.#),
 
     -- * Conversion between Concrete and Symbolic values
     ToCon (..),
@@ -711,10 +711,13 @@
 
     -- ** Symbolic Generation Monad
     MonadFresh (..),
+    nextFreshIndex,
+    liftFresh,
     Fresh,
-    FreshT,
+    FreshT (..),
     runFresh,
     runFreshT,
+    mrgRunFreshT,
 
     -- ** Symbolic Generation Class
     GenSym (..),
@@ -749,7 +752,7 @@
     -- for example, 'Grisette.Lib.Control.Monad.Except.mrgThrowError'.
     --
     -- >>> import Control.Monad.Except
-    -- >>> import Grisette.Lib.Mtl
+    -- >>> import Grisette.Lib.Control.Monad.Except
     -- >>> mrgThrowError AssertionError :: ExceptT AssertionError UnionM ()
     -- ExceptT {Left AssertionError}
     --
@@ -839,9 +842,9 @@
     -- >>> import Grisette.Backend.SBV
     -- >>> let x = "x" :: SymInteger
     -- >>> let y = "y" :: SymInteger
-    -- >>> solve (precise z3) (x + y ==~ 6 &&~ x - y ==~ 20)
+    -- >>> solve (precise z3) (x + y .== 6 .&& x - y .== 20)
     -- Right (Model {x -> 13 :: Integer, y -> -7 :: Integer})
-    -- >>> solve (precise z3) (x + y ==~ 6 &&~ x - y ==~ 19)
+    -- >>> solve (precise z3) (x + y .== 6 .&& x - y .== 19)
     -- Left Unsat
     --
     -- The first parameter of 'solve' is the solver configuration.
@@ -860,7 +863,7 @@
     -- evaluate symbolic values. The following code evaluates the product of
     -- x and y under the solution of the equation system.
     --
-    -- >>> Right m <- solve (precise z3) (x + y ==~ 6 &&~ x - y ==~ 20)
+    -- >>> Right m <- solve (precise z3) (x + y .== 6 .&& x - y .== 20)
     -- >>> evaluateSym False m (x * y)
     -- -91
     --
@@ -918,7 +921,7 @@
     --   res :: ExceptT Error UnionM ()
     --   res = do
     --     z <- x `sdiv` y
-    --     mrgIf (z >~ 0) (assert (x >=~ y)) (return ())
+    --     mrgIf (z .> 0) (assert (x .>= y)) (return ())
     -- :}
     --
     -- Then we can ask the solver to find a counter-example that would lead to
@@ -930,22 +933,38 @@
     -- >>> res
     -- ExceptT {If (|| (= y 0) (&& (< 0 (div x y)) (! (<= y x)))) (If (= y 0) (Left Arith) (Left Assert)) (Right ())}
     --
-    -- > >>> solveExcept (UnboundedReasoning z3) (==~ Left Assert) res
+    -- > >>> solveExcept (UnboundedReasoning z3) (.== Left Assert) res
     -- > Right (Model {x -> -6 :: Integer, y -> -3 :: Integer}) -- possible output
     --
     -- Grisette also provide implementation for counter-example guided inductive
     -- synthesis (CEGIS) algorithm. See the documentation for 'CEGISSolver' for
     -- more details.
 
-    -- ** Solver interface
+    -- ** Solver interfaces
+    SolvingFailure (..),
+    MonadicSolver (..),
+    SolverCommand (..),
+    ConfigurableSolver (..),
     Solver (..),
+    withSolver,
+    solve,
+    solveMulti,
+
+    -- ** Union with exceptions
     UnionWithExcept (..),
     solveExcept,
     solveMultiExcept,
 
-    -- ** Counter-example Guided Inductive Synthesis (CEGIS)
-    CEGISSolver (..),
+    -- ** Generic Counter-example Guided Inductive Synthesis (CEGIS) interface
+    SynthesisConstraintFun,
+    VerifierResult (..),
+    StatefulVerifierFun,
+    CEGISResult (..),
+    genericCEGIS,
+
+    -- ** CEGIS interfaces with pre/post conditions
     CEGISCondition (..),
+    cegisMultiInputs,
     cegisPostCond,
     cegisPrePost,
     cegis,
@@ -1030,8 +1049,6 @@
 import Grisette.Core.Control.Exception
   ( AssertionError (..),
     VerificationConditions (..),
-    symAssert,
-    symAssume,
   )
 import Grisette.Core.Control.Monad.CBMCExcept
   ( CBMCEither (..),
@@ -1049,7 +1066,7 @@
     UnionM,
     liftToMonadUnion,
     unionSize,
-    (#~),
+    (.#),
   )
 import Grisette.Core.Data.Class.BitVector
   ( BV (..),
@@ -1057,15 +1074,12 @@
     bvExtract,
     sizedBVExtract,
   )
-import Grisette.Core.Data.Class.Bool
-  ( ITEOp (..),
-    LogicalOp (..),
-    SEq (..),
-    SymBoolOp,
-  )
 import Grisette.Core.Data.Class.CEGISSolver
   ( CEGISCondition (..),
-    CEGISSolver (..),
+    CEGISResult (..),
+    StatefulVerifierFun,
+    SynthesisConstraintFun,
+    VerifierResult (..),
     cegis,
     cegisExcept,
     cegisExceptMultiInputs,
@@ -1073,23 +1087,27 @@
     cegisExceptStdVCMultiInputs,
     cegisExceptVC,
     cegisExceptVCMultiInputs,
+    cegisMultiInputs,
     cegisPostCond,
     cegisPrePost,
+    genericCEGIS,
   )
 import Grisette.Core.Data.Class.Error
   ( TransformError (..),
+    symAssert,
     symAssertTransformableError,
     symAssertWith,
+    symAssume,
     symThrowTransformableError,
   )
-import Grisette.Core.Data.Class.Evaluate
+import Grisette.Core.Data.Class.EvaluateSym
   ( EvaluateSym (..),
     evaluateSymToCon,
   )
 import Grisette.Core.Data.Class.ExtractSymbolics
   ( ExtractSymbolics (..),
   )
-import Grisette.Core.Data.Class.Function (Function (..))
+import Grisette.Core.Data.Class.Function (Apply (..), Function (..))
 import Grisette.Core.Data.Class.GPretty (GPretty (..))
 import Grisette.Core.Data.Class.GenSym
   ( EnumGenBound (..),
@@ -1097,7 +1115,7 @@
     Fresh,
     FreshIdent (..),
     FreshIndex (..),
-    FreshT,
+    FreshT (..),
     GenSym (..),
     GenSymSimple (..),
     ListSpec (..),
@@ -1114,11 +1132,16 @@
     derivedSameShapeSimpleFresh,
     genSym,
     genSymSimple,
+    liftFresh,
+    mrgRunFreshT,
     name,
     nameWithInfo,
+    nextFreshIndex,
     runFresh,
     runFreshT,
   )
+import Grisette.Core.Data.Class.ITEOp (ITEOp (..))
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (..))
 import Grisette.Core.Data.Class.Mergeable
   ( DynamicSortedIdx (..),
     Mergeable (..),
@@ -1143,12 +1166,11 @@
     SymbolSetOps (..),
     SymbolSetRep (..),
   )
+import Grisette.Core.Data.Class.SEq (SEq (..))
 import Grisette.Core.Data.Class.SOrd (SOrd (..))
-import Grisette.Core.Data.Class.SafeArith
-  ( SafeDivision (..),
-    SafeLinearArith (..),
-    SymIntegerOp,
-  )
+import Grisette.Core.Data.Class.SafeDivision (SafeDivision (..))
+import Grisette.Core.Data.Class.SafeLinearArith (SafeLinearArith (..))
+import Grisette.Core.Data.Class.SignConversion (SignConversion (..))
 import Grisette.Core.Data.Class.SimpleMergeable
   ( SimpleMergeable (..),
     SimpleMergeable1 (..),
@@ -1165,17 +1187,24 @@
     onUnion3,
     onUnion4,
     simpleMerge,
-    pattern IfU,
-    pattern SingleU,
+    pattern If,
+    pattern Single,
   )
 import Grisette.Core.Data.Class.Solvable (Solvable (..), pattern Con)
 import Grisette.Core.Data.Class.Solver
-  ( Solver (..),
+  ( ConfigurableSolver (..),
+    MonadicSolver (..),
+    Solver (..),
+    SolverCommand (..),
+    SolvingFailure (..),
     UnionWithExcept (..),
+    solve,
     solveExcept,
+    solveMulti,
     solveMultiExcept,
+    withSolver,
   )
-import Grisette.Core.Data.Class.Substitute
+import Grisette.Core.Data.Class.SubstituteSym
   ( SubstituteSym (..),
     SubstituteSym' (..),
   )
diff --git a/src/Grisette/Core/Control/Exception.hs b/src/Grisette/Core/Control/Exception.hs
--- a/src/Grisette/Core/Control/Exception.hs
+++ b/src/Grisette/Core/Control/Exception.hs
@@ -4,7 +4,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE Trustworthy #-}
 
 -- |
@@ -19,39 +18,17 @@
   ( -- * Predefined exceptions
     AssertionError (..),
     VerificationConditions (..),
-    symAssert,
-    symAssume,
   )
 where
 
 import Control.DeepSeq (NFData)
-import Control.Exception (ArithException, ArrayException)
-import Control.Monad.Except (MonadError)
 import GHC.Generics (Generic)
-import Generics.Deriving (Default (Default))
-import Grisette.Core.Control.Monad.Union (MonadUnion)
-import Grisette.Core.Data.Class.Bool (SEq)
-import Grisette.Core.Data.Class.Error
-  ( TransformError (transformError),
-    symAssertTransformableError,
-  )
-import Grisette.Core.Data.Class.Evaluate (EvaluateSym)
-import Grisette.Core.Data.Class.ExtractSymbolics
-  ( ExtractSymbolics,
-  )
-import Grisette.Core.Data.Class.Mergeable (Mergeable)
-import Grisette.Core.Data.Class.SOrd
-  ( SOrd (symCompare, (<=~), (<~), (>=~), (>~)),
-  )
-import Grisette.Core.Data.Class.SimpleMergeable
-  ( SimpleMergeable,
-    mrgSingle,
-  )
-import Grisette.Core.Data.Class.Solvable (Solvable (con))
-import Grisette.Core.Data.Class.ToCon (ToCon)
-import Grisette.Core.Data.Class.ToSym (ToSym)
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim (SymBool)
 
+-- import Grisette.Core.Data.Class.Mergeable (Mergeable)
+-- import Grisette.Core.Data.Class.SimpleMergeable
+--   ( SimpleMergeable,
+--   )
+
 -- $setup
 -- >>> import Grisette.Core
 -- >>> import Grisette.Lib.Base
@@ -61,122 +38,10 @@
 -- | Assertion error.
 data AssertionError = AssertionError
   deriving (Show, Eq, Ord, Generic, NFData)
-  deriving (ToCon AssertionError, ToSym AssertionError) via (Default AssertionError)
 
-deriving via (Default AssertionError) instance Mergeable AssertionError
-
-deriving via (Default AssertionError) instance SimpleMergeable AssertionError
-
-deriving via (Default AssertionError) instance SEq AssertionError
-
-instance SOrd AssertionError where
-  _ <=~ _ = con True
-  _ <~ _ = con False
-  _ >=~ _ = con True
-  _ >~ _ = con False
-  _ `symCompare` _ = mrgSingle EQ
-
-deriving via (Default AssertionError) instance EvaluateSym AssertionError
-
-deriving via (Default AssertionError) instance ExtractSymbolics AssertionError
-
 -- | Verification conditions.
 -- A crashed program path can terminate with either assertion violation errors or assumption violation errors.
 data VerificationConditions
   = AssertionViolation
   | AssumptionViolation
   deriving (Show, Eq, Ord, Generic, NFData)
-  deriving (ToCon VerificationConditions, ToSym VerificationConditions) via (Default VerificationConditions)
-
-deriving via (Default VerificationConditions) instance Mergeable VerificationConditions
-
-deriving via (Default VerificationConditions) instance SEq VerificationConditions
-
-instance SOrd VerificationConditions where
-  l >=~ r = con $ l <= r
-  l >~ r = con $ l < r
-  l <=~ r = con $ l >= r
-  l <~ r = con $ l > r
-  l `symCompare` r = mrgSingle $ l `compare` r
-
-deriving via (Default VerificationConditions) instance EvaluateSym VerificationConditions
-
-deriving via (Default VerificationConditions) instance ExtractSymbolics VerificationConditions
-
-instance TransformError VerificationConditions VerificationConditions where
-  transformError = id
-
-instance TransformError AssertionError VerificationConditions where
-  transformError _ = AssertionViolation
-
-instance TransformError ArithException AssertionError where
-  transformError _ = AssertionError
-
-instance TransformError ArrayException AssertionError where
-  transformError _ = AssertionError
-
-instance TransformError AssertionError AssertionError where
-  transformError = id
-
--- | Used within a monadic multi path computation to begin exception processing.
---
--- Checks the condition passed to the function.
--- The current execution path will be terminated with assertion error if the condition is false.
---
--- If the condition is symbolic, Grisette will split the execution into two paths based on the condition.
--- The symbolic execution will continue on the then-branch, where the condition is true.
--- For the else branch, where the condition is false, the execution will be terminated.
---
--- The resulting monadic environment should be compatible with the 'AssertionError'
--- error type. See 'TransformError' type class for details.
---
--- __/Examples/__:
---
--- Terminates the execution if the condition is false.
--- Note that we may lose the 'Mergeable' knowledge here if no possible execution
--- path is viable. This may affect the efficiency in theory, but in practice this
--- should not be a problem as all paths are terminated and no further evaluation
--- would be performed.
---
--- >>> symAssert (con False) :: ExceptT AssertionError UnionM ()
--- ExceptT {Left AssertionError}
--- >>> do; symAssert (con False); mrgReturn 1 :: ExceptT AssertionError UnionM Integer
--- ExceptT <Left AssertionError>
---
--- No effect if the condition is true:
---
--- >>> symAssert (con True) :: ExceptT AssertionError UnionM ()
--- ExceptT {Right ()}
--- >>> do; symAssert (con True); mrgReturn 1 :: ExceptT AssertionError UnionM Integer
--- ExceptT {Right 1}
---
--- Splitting the path and terminate one of them when the condition is symbolic.
---
--- >>> symAssert (ssym "a") :: ExceptT AssertionError UnionM ()
--- ExceptT {If (! a) (Left AssertionError) (Right ())}
--- >>> do; symAssert (ssym "a"); mrgReturn 1 :: ExceptT AssertionError UnionM Integer
--- ExceptT {If (! a) (Left AssertionError) (Right 1)}
---
--- 'AssertionError' is compatible with 'VerificationConditions':
---
--- >>> symAssert (ssym "a") :: ExceptT VerificationConditions UnionM ()
--- ExceptT {If (! a) (Left AssertionViolation) (Right ())}
-symAssert ::
-  (TransformError AssertionError to, Mergeable to, MonadError to erm, MonadUnion erm) =>
-  SymBool ->
-  erm ()
-symAssert = symAssertTransformableError AssertionError
-
--- | Used within a monadic multi path computation to begin exception processing.
---
--- Similar to 'symAssert', but terminates the execution path with 'AssumptionViolation' error.
---
--- /Examples/:
---
--- >>> symAssume (ssym "a") :: ExceptT VerificationConditions UnionM ()
--- ExceptT {If (! a) (Left AssumptionViolation) (Right ())}
-symAssume ::
-  (TransformError VerificationConditions to, Mergeable to, MonadError to erm, MonadUnion erm) =>
-  SymBool ->
-  erm ()
-symAssume = symAssertTransformableError AssumptionViolation
diff --git a/src/Grisette/Core/Control/Monad/CBMCExcept.hs b/src/Grisette/Core/Control/Monad/CBMCExcept.hs
--- a/src/Grisette/Core/Control/Monad/CBMCExcept.hs
+++ b/src/Grisette/Core/Control/Monad/CBMCExcept.hs
@@ -64,8 +64,8 @@
 import Data.Functor.Contravariant (Contravariant (contramap))
 import Data.Hashable (Hashable)
 import GHC.Generics (Generic, Generic1)
-import Grisette.Core.Data.Class.Bool (SEq ((==~)))
-import Grisette.Core.Data.Class.Evaluate (EvaluateSym (evaluateSym))
+import Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Data.Class.EvaluateSym (EvaluateSym (evaluateSym))
 import Grisette.Core.Data.Class.ExtractSymbolics
   ( ExtractSymbolics (extractSymbolics),
   )
@@ -82,7 +82,8 @@
     rootStrategy1,
     wrapStrategy,
   )
-import Grisette.Core.Data.Class.SOrd (SOrd (symCompare, (<=~), (<~), (>=~), (>~)))
+import Grisette.Core.Data.Class.SEq (SEq ((.==)))
+import Grisette.Core.Data.Class.SOrd (SOrd (symCompare, (.<), (.<=), (.>), (.>=)))
 import Grisette.Core.Data.Class.SimpleMergeable
   ( SimpleMergeable (mrgIte),
     SimpleMergeable1 (liftMrgIte),
@@ -350,8 +351,8 @@
   {-# INLINE catchError #-}
 
 instance (SEq (m (CBMCEither e a))) => SEq (CBMCExceptT e m a) where
-  (CBMCExceptT a) ==~ (CBMCExceptT b) = a ==~ b
-  {-# INLINE (==~) #-}
+  (CBMCExceptT a) .== (CBMCExceptT b) = a .== b
+  {-# INLINE (.==) #-}
 
 instance (EvaluateSym (m (CBMCEither e a))) => EvaluateSym (CBMCExceptT e m a) where
   evaluateSym fillDefault model (CBMCExceptT v) = CBMCExceptT $ evaluateSym fillDefault model v
@@ -440,10 +441,10 @@
   {-# INLINE unionIf #-}
 
 instance (SOrd (m (CBMCEither e a))) => SOrd (CBMCExceptT e m a) where
-  (CBMCExceptT l) <=~ (CBMCExceptT r) = l <=~ r
-  (CBMCExceptT l) <~ (CBMCExceptT r) = l <~ r
-  (CBMCExceptT l) >=~ (CBMCExceptT r) = l >=~ r
-  (CBMCExceptT l) >~ (CBMCExceptT r) = l >~ r
+  (CBMCExceptT l) .<= (CBMCExceptT r) = l .<= r
+  (CBMCExceptT l) .< (CBMCExceptT r) = l .< r
+  (CBMCExceptT l) .>= (CBMCExceptT r) = l .>= r
+  (CBMCExceptT l) .> (CBMCExceptT r) = l .> r
   symCompare (CBMCExceptT l) (CBMCExceptT r) = symCompare l r
 
 instance
@@ -469,3 +470,6 @@
   UnionWithExcept (CBMCExceptT e u v) u e v
   where
   extractUnionExcept = merge . fmap runCBMCEither . runCBMCExceptT
+
+instance UnionWithExcept (UnionM (CBMCEither e v)) UnionM e v where
+  extractUnionExcept = fmap runCBMCEither
diff --git a/src/Grisette/Core/Control/Monad/UnionM.hs b/src/Grisette/Core/Control/Monad/UnionM.hs
--- a/src/Grisette/Core/Control/Monad/UnionM.hs
+++ b/src/Grisette/Core/Control/Monad/UnionM.hs
@@ -33,7 +33,7 @@
     liftToMonadUnion,
     underlyingUnion,
     isMerged,
-    (#~),
+    (.#),
     IsConcrete,
     unionSize,
   )
@@ -50,20 +50,12 @@
 import Data.Hashable (Hashable (hashWithSalt))
 import Data.String (IsString (fromString))
 import GHC.TypeNats (KnownNat, type (<=))
-import Grisette.Core.Control.Monad.CBMCExcept
-  ( CBMCEither (runCBMCEither),
-  )
 import Grisette.Core.Control.Monad.Class.MonadParallelUnion
   ( MonadParallelUnion (parBindUnion),
   )
 import Grisette.Core.Control.Monad.Union (MonadUnion)
 import Grisette.Core.Data.BV (IntN, WordN)
-import Grisette.Core.Data.Class.Bool
-  ( ITEOp (ites),
-    LogicalOp (implies, nots, xors, (&&~), (||~)),
-    SEq ((==~)),
-  )
-import Grisette.Core.Data.Class.Evaluate (EvaluateSym (evaluateSym))
+import Grisette.Core.Data.Class.EvaluateSym (EvaluateSym (evaluateSym))
 import Grisette.Core.Data.Class.ExtractSymbolics
   ( ExtractSymbolics (extractSymbolics),
   )
@@ -72,18 +64,16 @@
   ( GPretty (gpretty),
     groupedEnclose,
   )
-import Grisette.Core.Data.Class.GenSym
-  ( GenSym (fresh),
-    GenSymSimple (simpleFresh),
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.LogicalOp
+  ( LogicalOp (symImplies, symNot, symXor, (.&&), (.||)),
   )
 import Grisette.Core.Data.Class.Mergeable
   ( Mergeable (rootStrategy),
     Mergeable1 (liftRootStrategy),
     MergingStrategy (SimpleStrategy),
   )
-import Grisette.Core.Data.Class.SOrd
-  ( SOrd (symCompare, (<=~), (<~), (>=~), (>~)),
-  )
+import Grisette.Core.Data.Class.SEq (SEq ((.==)))
 import Grisette.Core.Data.Class.SimpleMergeable
   ( SimpleMergeable (mrgIte),
     SimpleMergeable1 (liftMrgIte),
@@ -93,17 +83,18 @@
     mrgIf,
     mrgSingle,
     simpleMerge,
-    (#~),
+    (.#),
   )
 import Grisette.Core.Data.Class.Solvable
   ( Solvable (con, conView, iinfosym, isym, sinfosym, ssym),
     pattern Con,
   )
 import Grisette.Core.Data.Class.Solver (UnionWithExcept (extractUnionExcept))
+import Grisette.Core.Data.Class.SubstituteSym (SubstituteSym (substituteSym))
 import Grisette.Core.Data.Class.ToCon (ToCon (toCon))
 import Grisette.Core.Data.Class.ToSym (ToSym (toSym))
 import Grisette.Core.Data.Union
-  ( Union (If, Single),
+  ( Union (UnionIf, UnionSingle),
     fullReconstruct,
     ifWithStrategy,
   )
@@ -267,8 +258,8 @@
   Int ->
   Union a ->
   ShowS
-liftShowsPrecUnion sp _ i (Single a) = sp i a
-liftShowsPrecUnion sp sl i (If _ _ cond t f) =
+liftShowsPrecUnion sp _ i (UnionSingle a) = sp i a
+liftShowsPrecUnion sp sl i (UnionIf _ _ cond t f) =
   showParen (i > 10) $
     showString "If"
       . showChar ' '
@@ -334,8 +325,8 @@
   {-# INLINE (<*>) #-}
 
 bindUnion :: Union a -> (a -> UnionM b) -> UnionM b
-bindUnion (Single a') f' = f' a'
-bindUnion (If _ _ cond ifTrue ifFalse) f' =
+bindUnion (UnionSingle a') f' = f' a'
+bindUnion (UnionIf _ _ cond ifTrue ifFalse) f' =
   unionIf cond (bindUnion ifTrue f') (bindUnion ifFalse f')
 {-# INLINE bindUnion #-}
 
@@ -344,12 +335,12 @@
   {-# INLINE (>>=) #-}
 
 parBindUnion'' :: (Mergeable b, NFData b) => Union a -> (a -> UnionM b) -> UnionM b
-parBindUnion'' (Single a) f = merge $ f a
+parBindUnion'' (UnionSingle a) f = merge $ f a
 parBindUnion'' u f = parBindUnion' u f
 
 parBindUnion' :: (Mergeable b, NFData b) => Union a -> (a -> UnionM b) -> UnionM b
-parBindUnion' (Single a') f' = f' a'
-parBindUnion' (If _ _ cond ifTrue ifFalse) f' = runEval $ do
+parBindUnion' (UnionSingle a') f' = f' a'
+parBindUnion' (UnionIf _ _ cond ifTrue ifFalse) f' = runEval $ do
   l <- rpar $ force $ parBindUnion' ifTrue f'
   r <- rpar $ force $ parBindUnion' ifFalse f'
   l' <- rseq l
@@ -370,7 +361,8 @@
   {-# INLINE mrgIte #-}
 
 instance Mergeable1 UnionM where
-  liftRootStrategy m = SimpleStrategy $ \cond t f -> unionIf cond t f >>= (UMrg m . Single)
+  liftRootStrategy m = SimpleStrategy $
+    \cond t f -> unionIf cond t f >>= (UMrg m . UnionSingle)
   {-# INLINE liftRootStrategy #-}
 
 instance SimpleMergeable1 UnionM where
@@ -393,39 +385,17 @@
   {-# INLINE unionIf #-}
 
 instance (SEq a) => SEq (UnionM a) where
-  x ==~ y = simpleMerge $ do
+  x .== y = simpleMerge $ do
     x1 <- x
     y1 <- y
-    mrgSingle $ x1 ==~ y1
+    mrgSingle $ x1 .== y1
 
 -- | Lift the 'UnionM' to any 'MonadUnion'.
 liftToMonadUnion :: (Mergeable a, MonadUnion u) => UnionM a -> u a
 liftToMonadUnion u = go (underlyingUnion u)
   where
-    go (Single v) = mrgSingle v
-    go (If _ _ c t f) = mrgIf c (go t) (go f)
-
-instance (SOrd a) => SOrd (UnionM a) where
-  x <=~ y = simpleMerge $ do
-    x1 <- x
-    y1 <- y
-    mrgSingle $ x1 <=~ y1
-  x <~ y = simpleMerge $ do
-    x1 <- x
-    y1 <- y
-    mrgSingle $ x1 <~ y1
-  x >=~ y = simpleMerge $ do
-    x1 <- x
-    y1 <- y
-    mrgSingle $ x1 >=~ y1
-  x >~ y = simpleMerge $ do
-    x1 <- x
-    y1 <- y
-    mrgSingle $ x1 >~ y1
-  x `symCompare` y = liftToMonadUnion $ do
-    x1 <- x
-    y1 <- y
-    x1 `symCompare` y1
+    go (UnionSingle v) = mrgSingle v
+    go (UnionIf _ _ c t f) = mrgIf c (go t) (go f)
 
 instance {-# INCOHERENT #-} (ToSym a b, Mergeable b) => ToSym a (UnionM b) where
   toSym = mrgSingle . toSym
@@ -461,16 +431,16 @@
 instance {-# INCOHERENT #-} (ToCon a b) => ToCon (UnionM a) b where
   toCon v = go $ underlyingUnion v
     where
-      go (Single x) = toCon x
+      go (UnionSingle x) = toCon x
       go _ = Nothing
 
 instance (ToCon a b, Mergeable b) => ToCon (UnionM a) (UnionM b) where
   toCon v = go $ underlyingUnion v
     where
-      go (Single x) = case toCon x of
+      go (UnionSingle x) = case toCon x of
         Nothing -> Nothing
         Just v -> Just $ mrgSingle v
-      go (If _ _ c t f) = do
+      go (UnionIf _ _ c t f) = do
         t' <- go t
         f' <- go f
         return $ mrgIf c t' f'
@@ -479,25 +449,23 @@
   evaluateSym fillDefault model x = go $ underlyingUnion x
     where
       go :: Union a -> UnionM a
-      go (Single v) = mrgSingle $ evaluateSym fillDefault model v
-      go (If _ _ cond t f) =
+      go (UnionSingle v) = mrgSingle $ evaluateSym fillDefault model v
+      go (UnionIf _ _ cond t f) =
         mrgIf
           (evaluateSym fillDefault model cond)
           (go t)
           (go f)
 
-{-
 instance (Mergeable a, SubstituteSym a) => SubstituteSym (UnionM a) where
   substituteSym sym val x = go $ underlyingUnion x
     where
       go :: Union a -> UnionM a
-      go (Single v) = mrgSingle $ substituteSym sym val v
-      go (If _ _ cond t f) =
+      go (UnionSingle v) = mrgSingle $ substituteSym sym val v
+      go (UnionIf _ _ cond t f) =
         mrgIf
           (substituteSym sym val cond)
           (go t)
           (go f)
-          -}
 
 instance
   (ExtractSymbolics a) =>
@@ -505,8 +473,8 @@
   where
   extractSymbolics v = go $ underlyingUnion v
     where
-      go (Single x) = extractSymbolics x
-      go (If _ _ cond t f) = extractSymbolics cond <> go t <> go f
+      go (UnionSingle x) = extractSymbolics x
+      go (UnionIf _ _ cond t f) = extractSymbolics cond <> go t <> go f
 
 instance (Hashable a) => Hashable (UnionM a) where
   s `hashWithSalt` (UAny u) = s `hashWithSalt` (0 :: Int) `hashWithSalt` u
@@ -530,28 +498,28 @@
   signum x = x >>= mrgSingle . signum
 
 instance (ITEOp a, Mergeable a) => ITEOp (UnionM a) where
-  ites = mrgIf
+  symIte = mrgIf
 
 instance (LogicalOp a, Mergeable a) => LogicalOp (UnionM a) where
-  a ||~ b = do
+  a .|| b = do
     a1 <- a
     b1 <- b
-    mrgSingle $ a1 ||~ b1
-  a &&~ b = do
+    mrgSingle $ a1 .|| b1
+  a .&& b = do
     a1 <- a
     b1 <- b
-    mrgSingle $ a1 &&~ b1
-  nots x = do
+    mrgSingle $ a1 .&& b1
+  symNot x = do
     x1 <- x
-    mrgSingle $ nots x1
-  xors a b = do
+    mrgSingle $ symNot x1
+  symXor a b = do
     a1 <- a
     b1 <- b
-    mrgSingle $ a1 `xors` b1
-  implies a b = do
+    mrgSingle $ a1 `symXor` b1
+  symImplies a b = do
     a1 <- a
     b1 <- b
-    mrgSingle $ a1 `implies` b1
+    mrgSingle $ a1 `symImplies` b1
 
 instance (Solvable c t, Mergeable t) => Solvable c (UnionM t) where
   con = mrgSingle . con
@@ -582,23 +550,6 @@
 instance (IsString a, Mergeable a) => IsString (UnionM a) where
   fromString = mrgSingle . fromString
 
--- GenSym
-instance (GenSym spec a, Mergeable a) => GenSym spec (UnionM a)
-
-instance (GenSym spec a) => GenSymSimple spec (UnionM a) where
-  simpleFresh spec = do
-    res <- fresh spec
-    if not (isMerged res) then error "Not merged" else return res
-
-instance
-  (GenSym a a, Mergeable a) =>
-  GenSym (UnionM a) a
-  where
-  fresh spec = go (underlyingUnion $ merge spec)
-    where
-      go (Single x) = fresh x
-      go (If _ _ _ t f) = mrgIf <$> simpleFresh () <*> go t <*> go f
-
 -- AllSyms
 instance (AllSyms a) => AllSyms (UnionM a) where
   allSymsS = allSymsS . underlyingUnion
@@ -641,9 +592,6 @@
 instance UnionWithExcept (UnionM (Either e v)) UnionM e v where
   extractUnionExcept = id
 
-instance UnionWithExcept (UnionM (CBMCEither e v)) UnionM e v where
-  extractUnionExcept = fmap runCBMCEither
-
 -- | The size of a union is defined as the number of branches.
 -- For example,
 --
@@ -656,5 +604,5 @@
 unionSize :: UnionM a -> Int
 unionSize = unionSize' . underlyingUnion
   where
-    unionSize' (Single _) = 1
-    unionSize' (If _ _ _ l r) = unionSize' l + unionSize' r
+    unionSize' (UnionSingle _) = 1
+    unionSize' (UnionIf _ _ _ l r) = unionSize' l + unionSize' r
diff --git a/src/Grisette/Core/Control/Monad/UnionM.hs-boot b/src/Grisette/Core/Control/Monad/UnionM.hs-boot
deleted file mode 100644
--- a/src/Grisette/Core/Control/Monad/UnionM.hs-boot
+++ /dev/null
@@ -1,31 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-
-module Grisette.Core.Control.Monad.UnionM (UnionM (..)) where
-
-import Grisette.Core.Data.Class.Mergeable (MergingStrategy)
-import Grisette.Core.Data.Class.SimpleMergeable (UnionLike)
-import Grisette.Core.Data.Union (Union)
-
-data UnionM a where
-  -- | 'UnionM' with no 'Mergeable' knowledge.
-  UAny ::
-    -- | Original 'Union'.
-    Union a ->
-    UnionM a
-  -- | 'UnionM' with 'Mergeable' knowledge.
-  UMrg ::
-    -- | Cached merging strategy.
-    MergingStrategy a ->
-    -- | Merged Union
-    Union a ->
-    UnionM a
-
-instance UnionLike UnionM
-
-instance Functor UnionM
-
-instance Applicative UnionM
-
-instance Monad UnionM
diff --git a/src/Grisette/Core/Data/BV.hs b/src/Grisette/Core/Data/BV.hs
--- a/src/Grisette/Core/Data/BV.hs
+++ b/src/Grisette/Core/Data/BV.hs
@@ -11,6 +11,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskellQuotes #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
@@ -108,9 +109,25 @@
   )
 import Grisette.Core.Data.Class.BitVector
   ( BV (bvConcat, bvExt, bvSelect, bvSext, bvZext),
-    BVSignConversion (toSigned, toUnsigned),
-    SizedBV (sizedBVConcat, sizedBVExt, sizedBVSelect, sizedBVSext, sizedBVZext),
+    SizedBV
+      ( sizedBVConcat,
+        sizedBVExt,
+        sizedBVSelect,
+        sizedBVSext,
+        sizedBVZext
+      ),
   )
+import Grisette.Core.Data.Class.SignConversion
+  ( SignConversion (toSigned, toUnsigned),
+  )
+import Grisette.Core.Data.Class.SymRotate
+  ( DefaultFiniteBitsSymRotate (DefaultFiniteBitsSymRotate),
+    SymRotate,
+  )
+import Grisette.Core.Data.Class.SymShift
+  ( DefaultFiniteBitsSymShift (DefaultFiniteBitsSymShift),
+    SymShift,
+  )
 import Grisette.Utils.Parameterized
   ( KnownProof (KnownProof),
     LeqProof (LeqProof),
@@ -372,9 +389,11 @@
   bitSizeMaybe = Just . finiteBitSize
   bitSize = finiteBitSize
   isSigned _ = False
+  shiftL w i | i >= finiteBitSize w = 0
   shiftL (WordN a) i = WordN (a `shiftL` i) .&. maxBound
 
   -- unsafeShiftL use default implementation
+  shiftR w i | i >= finiteBitSize w = 0
   shiftR (WordN a) i = WordN (a `shiftR` i)
 
   -- unsafeShiftR use default implementation
@@ -506,8 +525,14 @@
 
 instance (KnownNat n, 1 <= n) => QC.Arbitrary (WordN n) where
   arbitrary = QC.arbitrarySizedBoundedIntegral
-  shrink = QC.shrinkIntegral
 
+  -- QC.shrinkIntegral assumes that 2 is representable by the number, which is
+  -- not the case for 1-bit bit vector.
+  shrink i
+    | i == 0 = []
+    | i == 1 = [0]
+    | otherwise = QC.shrinkIntegral i
+
 minusOneIntN :: forall proxy n. (KnownNat n) => proxy n -> IntN n
 minusOneIntN _ = IntN (1 `shiftL` fromIntegral (natVal (Proxy :: Proxy n)) - 1)
 
@@ -634,10 +659,10 @@
         (q, r) -> (fromInteger q, fromInteger r)
   toInteger i@(IntN n) = case signum i of
     0 -> 0
-    1 -> n
     -1 ->
       let x = negate i
        in if signum x == -1 then -n else negate (toInteger x)
+    1 -> n
     _ -> undefined
 
 instance Integral SomeIntN where
@@ -687,8 +712,14 @@
 
 instance (KnownNat n, 1 <= n) => QC.Arbitrary (IntN n) where
   arbitrary = QC.arbitrarySizedBoundedIntegral
-  shrink = QC.shrinkIntegral
 
+  -- QC.shrinkIntegral assumes that 2 is representable by the number, which is
+  -- not the case for 1-bit bit vector.
+  shrink i
+    | i == 0 = []
+    | i == 1 = [0]
+    | otherwise = QC.shrinkIntegral i
+
 instance SizedBV WordN where
   sizedBVConcat :: forall l r. (KnownNat l, KnownNat r, 1 <= l, 1 <= r) => WordN l -> WordN r -> WordN (l + r)
   sizedBVConcat (WordN a) (WordN b) = WordN ((a `shiftL` fromIntegral (natVal (Proxy :: Proxy r))) .|. b)
@@ -784,10 +815,30 @@
   bvSelect ix w = toSigned . bvSelect ix w . toUnsigned
   {-# INLINE bvSelect #-}
 
-instance (KnownNat n, 1 <= n) => BVSignConversion (WordN n) (IntN n) where
+instance (KnownNat n, 1 <= n) => SignConversion (WordN n) (IntN n) where
   toSigned (WordN i) = IntN i
   toUnsigned (IntN i) = WordN i
 
-instance BVSignConversion SomeWordN SomeIntN where
+instance SignConversion SomeWordN SomeIntN where
   toSigned (SomeWordN i) = SomeIntN $ toSigned i
   toUnsigned (SomeIntN i) = SomeWordN $ toUnsigned i
+
+deriving via
+  (DefaultFiniteBitsSymShift (IntN n))
+  instance
+    (KnownNat n, 1 <= n) => SymShift (IntN n)
+
+deriving via
+  (DefaultFiniteBitsSymShift (WordN n))
+  instance
+    (KnownNat n, 1 <= n) => SymShift (WordN n)
+
+deriving via
+  (DefaultFiniteBitsSymRotate (IntN n))
+  instance
+    (KnownNat n, 1 <= n) => SymRotate (IntN n)
+
+deriving via
+  (DefaultFiniteBitsSymRotate (WordN n))
+  instance
+    (KnownNat n, 1 <= n) => SymRotate (WordN n)
diff --git a/src/Grisette/Core/Data/Class/BitVector.hs b/src/Grisette/Core/Data/Class/BitVector.hs
--- a/src/Grisette/Core/Data/Class/BitVector.hs
+++ b/src/Grisette/Core/Data/Class/BitVector.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE RankNTypes #-}
@@ -24,7 +23,6 @@
     bvExtract,
     SizedBV (..),
     sizedBVExtract,
-    BVSignConversion (..),
   )
 where
 
@@ -234,11 +232,3 @@
     (KnownProof, LeqProof, LeqProof) ->
       sizedBVSelect (Proxy @j) (Proxy @(i - j + 1))
 {-# INLINE sizedBVExtract #-}
-
--- | Convert bitvectors from and to signed
-class BVSignConversion ubv sbv | ubv -> sbv, sbv -> ubv where
-  -- | Convert unsigned bitvector to signed
-  toSigned :: ubv -> sbv
-
-  -- | Convert signed bitvector to unsigned
-  toUnsigned :: sbv -> ubv
diff --git a/src/Grisette/Core/Data/Class/Bool.hs b/src/Grisette/Core/Data/Class/Bool.hs
deleted file mode 100644
--- a/src/Grisette/Core/Data/Class/Bool.hs
+++ /dev/null
@@ -1,413 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-
--- |
--- Module      :   Grisette.Core.Data.Class.Bool
--- Copyright   :   (c) Sirui Lu 2021-2023
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Core.Data.Class.Bool
-  ( -- * Symbolic equality
-    SEq (..),
-    SEq' (..),
-
-    -- * Symbolic Boolean operations
-    LogicalOp (..),
-    SymBoolOp,
-    ITEOp (..),
-  )
-where
-
-import Control.Monad.Except (ExceptT (ExceptT))
-import Control.Monad.Identity
-  ( Identity (Identity),
-    IdentityT (IdentityT),
-  )
-import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
-import qualified Control.Monad.Writer.Lazy as WriterLazy
-import qualified Control.Monad.Writer.Strict as WriterStrict
-import qualified Data.ByteString as B
-import Data.Functor.Sum (Sum)
-import Data.Int (Int16, Int32, Int64, Int8)
-import qualified Data.Text as T
-import Data.Word (Word16, Word32, Word64, Word8)
-import GHC.TypeNats (KnownNat, type (<=))
-import Generics.Deriving
-  ( Default (Default),
-    Generic (Rep, from),
-    K1 (K1),
-    M1 (M1),
-    U1,
-    V1,
-    type (:*:) ((:*:)),
-    type (:+:) (L1, R1),
-  )
-import Grisette.Core.Data.BV (IntN, SomeIntN, SomeWordN, WordN)
-import {-# SOURCE #-} Grisette.Core.Data.Class.SimpleMergeable
-  ( SimpleMergeable,
-  )
-import Grisette.Core.Data.Class.Solvable (Solvable (con))
-import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
-  ( LinkedRep,
-    SupportedPrim,
-  )
-import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bool
-  ( pevalAndTerm,
-    pevalITETerm,
-    pevalImplyTerm,
-    pevalNotTerm,
-    pevalOrTerm,
-    pevalXorTerm,
-  )
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim
-  ( SomeSymIntN,
-    SomeSymWordN,
-    SymBool (SymBool),
-    SymIntN (SymIntN),
-    SymInteger (SymInteger),
-    SymWordN (SymWordN),
-    binSomeSymIntNR1,
-    binSomeSymWordNR1,
-    type (-~>) (SymGeneralFun),
-    type (=~>) (SymTabularFun),
-  )
-
--- $setup
--- >>> import Grisette.Core
--- >>> import Grisette.IR.SymPrim
--- >>> :set -XDataKinds
--- >>> :set -XBinaryLiterals
--- >>> :set -XFlexibleContexts
--- >>> :set -XFlexibleInstances
--- >>> :set -XFunctionalDependencies
-
--- | Auxiliary class for 'SEq' instance derivation
-class SEq' f where
-  -- | Auxiliary function for '(==~~) derivation
-  (==~~) :: f a -> f a -> SymBool
-
-  infix 4 ==~~
-
-instance SEq' U1 where
-  _ ==~~ _ = con True
-  {-# INLINE (==~~) #-}
-
-instance SEq' V1 where
-  _ ==~~ _ = con True
-  {-# INLINE (==~~) #-}
-
-instance (SEq c) => SEq' (K1 i c) where
-  (K1 a) ==~~ (K1 b) = a ==~ b
-  {-# INLINE (==~~) #-}
-
-instance (SEq' a) => SEq' (M1 i c a) where
-  (M1 a) ==~~ (M1 b) = a ==~~ b
-  {-# INLINE (==~~) #-}
-
-instance (SEq' a, SEq' b) => SEq' (a :+: b) where
-  (L1 a) ==~~ (L1 b) = a ==~~ b
-  (R1 a) ==~~ (R1 b) = a ==~~ b
-  _ ==~~ _ = con False
-  {-# INLINE (==~~) #-}
-
-instance (SEq' a, SEq' b) => SEq' (a :*: b) where
-  (a1 :*: b1) ==~~ (a2 :*: b2) = (a1 ==~~ a2) &&~ (b1 ==~~ b2)
-  {-# INLINE (==~~) #-}
-
--- | Symbolic equality. Note that we can't use Haskell's 'Eq' class since
--- symbolic comparison won't necessarily return a concrete 'Bool' value.
---
--- >>> let a = 1 :: SymInteger
--- >>> let b = 2 :: SymInteger
--- >>> a ==~ b
--- false
--- >>> a /=~ b
--- true
---
--- >>> let a = "a" :: SymInteger
--- >>> let b = "b" :: SymInteger
--- >>> a /=~ b
--- (! (= a b))
--- >>> a /=~ b
--- (! (= a b))
---
--- __Note:__ This type class can be derived for algebraic data types.
--- You may need the @DerivingVia@ and @DerivingStrategies@ extensions.
---
--- > data X = ... deriving Generic deriving SEq via (Default X)
-class SEq a where
-  (==~) :: a -> a -> SymBool
-  a ==~ b = nots $ a /=~ b
-  {-# INLINE (==~) #-}
-  infix 4 ==~
-
-  (/=~) :: a -> a -> SymBool
-  a /=~ b = nots $ a ==~ b
-  {-# INLINE (/=~) #-}
-  infix 4 /=~
-  {-# MINIMAL (==~) | (/=~) #-}
-
-instance (Generic a, SEq' (Rep a)) => SEq (Default a) where
-  Default l ==~ Default r = from l ==~~ from r
-  {-# INLINE (==~) #-}
-
--- | Symbolic logical operators for symbolic booleans.
---
--- >>> let t = con True :: SymBool
--- >>> let f = con False :: SymBool
--- >>> let a = "a" :: SymBool
--- >>> let b = "b" :: SymBool
--- >>> t ||~ f
--- true
--- >>> a ||~ t
--- true
--- >>> a ||~ f
--- a
--- >>> a ||~ b
--- (|| a b)
--- >>> t &&~ f
--- false
--- >>> a &&~ t
--- a
--- >>> a &&~ f
--- false
--- >>> a &&~ b
--- (&& a b)
--- >>> nots t
--- false
--- >>> nots f
--- true
--- >>> nots a
--- (! a)
--- >>> t `xors` f
--- true
--- >>> t `xors` t
--- false
--- >>> a `xors` t
--- (! a)
--- >>> a `xors` f
--- a
--- >>> a `xors` b
--- (|| (&& (! a) b) (&& a (! b)))
-class LogicalOp b where
-  -- | Symbolic disjunction
-  (||~) :: b -> b -> b
-  a ||~ b = nots $ nots a &&~ nots b
-  {-# INLINE (||~) #-}
-
-  infixr 2 ||~
-
-  -- | Symbolic conjunction
-  (&&~) :: b -> b -> b
-  a &&~ b = nots $ nots a ||~ nots b
-  {-# INLINE (&&~) #-}
-
-  infixr 3 &&~
-
-  -- | Symbolic negation
-  nots :: b -> b
-
-  -- | Symbolic exclusive disjunction
-  xors :: b -> b -> b
-  a `xors` b = (a &&~ nots b) ||~ (nots a &&~ b)
-  {-# INLINE xors #-}
-
-  -- | Symbolic implication
-  implies :: b -> b -> b
-  a `implies` b = nots a ||~ b
-  {-# INLINE implies #-}
-
-  {-# MINIMAL (||~), nots | (&&~), nots #-}
-
-instance LogicalOp Bool where
-  (||~) = (||)
-  {-# INLINE (||~) #-}
-  (&&~) = (&&)
-  {-# INLINE (&&~) #-}
-  nots = not
-  {-# INLINE nots #-}
-
--- | ITE operator for solvable (see "Grisette.Core#solvable")s, including symbolic boolean, integer, etc.
---
--- >>> let a = "a" :: SymBool
--- >>> let b = "b" :: SymBool
--- >>> let c = "c" :: SymBool
--- >>> ites a b c
--- (ite a b c)
-class ITEOp v where
-  ites :: SymBool -> v -> v -> v
-
--- | Aggregation for the operations on symbolic boolean types
-class (SimpleMergeable b, SEq b, Eq b, LogicalOp b, Solvable Bool b, ITEOp b) => SymBoolOp b
-
-#define CONCRETE_SEQ(type) \
-instance SEq type where \
-  l ==~ r = con $ l == r; \
-  {-# INLINE (==~) #-}
-
-#define CONCRETE_SEQ_BV(type) \
-instance (KnownNat n, 1 <= n) => SEq (type n) where \
-  l ==~ r = con $ l == r; \
-  {-# INLINE (==~) #-}
-
-#if 1
-CONCRETE_SEQ(Bool)
-CONCRETE_SEQ(Integer)
-CONCRETE_SEQ(Char)
-CONCRETE_SEQ(Int)
-CONCRETE_SEQ(Int8)
-CONCRETE_SEQ(Int16)
-CONCRETE_SEQ(Int32)
-CONCRETE_SEQ(Int64)
-CONCRETE_SEQ(Word)
-CONCRETE_SEQ(Word8)
-CONCRETE_SEQ(Word16)
-CONCRETE_SEQ(Word32)
-CONCRETE_SEQ(Word64)
-CONCRETE_SEQ(B.ByteString)
-CONCRETE_SEQ(T.Text)
-CONCRETE_SEQ_BV(WordN)
-CONCRETE_SEQ_BV(IntN)
-CONCRETE_SEQ(SomeWordN)
-CONCRETE_SEQ(SomeIntN)
-#endif
-
--- List
-deriving via (Default [a]) instance (SEq a) => SEq [a]
-
--- Maybe
-deriving via (Default (Maybe a)) instance (SEq a) => SEq (Maybe a)
-
--- Either
-deriving via (Default (Either e a)) instance (SEq e, SEq a) => SEq (Either e a)
-
--- ExceptT
-instance (SEq (m (Either e a))) => SEq (ExceptT e m a) where
-  (ExceptT a) ==~ (ExceptT b) = a ==~ b
-  {-# INLINE (==~) #-}
-
--- MaybeT
-instance (SEq (m (Maybe a))) => SEq (MaybeT m a) where
-  (MaybeT a) ==~ (MaybeT b) = a ==~ b
-  {-# INLINE (==~) #-}
-
--- ()
-instance SEq () where
-  _ ==~ _ = con True
-  {-# INLINE (==~) #-}
-
--- (,)
-deriving via (Default (a, b)) instance (SEq a, SEq b) => SEq (a, b)
-
--- (,,)
-deriving via (Default (a, b, c)) instance (SEq a, SEq b, SEq c) => SEq (a, b, c)
-
--- (,,,)
-deriving via
-  (Default (a, b, c, d))
-  instance
-    (SEq a, SEq b, SEq c, SEq d) =>
-    SEq (a, b, c, d)
-
--- (,,,,)
-deriving via
-  (Default (a, b, c, d, e))
-  instance
-    (SEq a, SEq b, SEq c, SEq d, SEq e) =>
-    SEq (a, b, c, d, e)
-
--- (,,,,,)
-deriving via
-  (Default (a, b, c, d, e, f))
-  instance
-    (SEq a, SEq b, SEq c, SEq d, SEq e, SEq f) =>
-    SEq (a, b, c, d, e, f)
-
--- (,,,,,,)
-deriving via
-  (Default (a, b, c, d, e, f, g))
-  instance
-    (SEq a, SEq b, SEq c, SEq d, SEq e, SEq f, SEq g) =>
-    SEq (a, b, c, d, e, f, g)
-
--- (,,,,,,,)
-deriving via
-  (Default (a, b, c, d, e, f, g, h))
-  instance
-    (SEq a, SEq b, SEq c, SEq d, SEq e, SEq f, SEq g, SEq h) =>
-    SEq (a, b, c, d, e, f, g, h)
-
--- Sum
-deriving via
-  (Default (Sum f g a))
-  instance
-    (SEq (f a), SEq (g a)) => SEq (Sum f g a)
-
--- Writer
-instance (SEq (m (a, s))) => SEq (WriterLazy.WriterT s m a) where
-  (WriterLazy.WriterT l) ==~ (WriterLazy.WriterT r) = l ==~ r
-  {-# INLINE (==~) #-}
-
-instance (SEq (m (a, s))) => SEq (WriterStrict.WriterT s m a) where
-  (WriterStrict.WriterT l) ==~ (WriterStrict.WriterT r) = l ==~ r
-  {-# INLINE (==~) #-}
-
--- Identity
-instance (SEq a) => SEq (Identity a) where
-  (Identity l) ==~ (Identity r) = l ==~ r
-  {-# INLINE (==~) #-}
-
--- IdentityT
-instance (SEq (m a)) => SEq (IdentityT m a) where
-  (IdentityT l) ==~ (IdentityT r) = l ==~ r
-  {-# INLINE (==~) #-}
-
-#define ITEOP_SIMPLE(type) \
-instance ITEOp type where \
-  ites (SymBool c) (type t) (type f) = type $ pevalITETerm c t f; \
-  {-# INLINE ites #-}
-
-#define ITEOP_BV(type) \
-instance (KnownNat n, 1 <= n) => ITEOp (type n) where \
-  ites (SymBool c) (type t) (type f) = type $ pevalITETerm c t f; \
-  {-# INLINE ites #-}
-
-#define ITEOP_BV_SOME(symtype, bf) \
-instance ITEOp symtype where \
-  ites c = bf (ites c) "ites"; \
-  {-# INLINE ites #-}
-
-#define ITEOP_FUN(op, cons) \
-instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => ITEOp (sa op sb) where \
-  ites (SymBool c) (cons t) (cons f) = cons $ pevalITETerm c t f; \
-  {-# INLINE ites #-}
-
-#if 1
-ITEOP_SIMPLE(SymBool)
-ITEOP_SIMPLE(SymInteger)
-ITEOP_BV(SymIntN)
-ITEOP_BV(SymWordN)
-ITEOP_BV_SOME(SomeSymIntN, binSomeSymIntNR1)
-ITEOP_BV_SOME(SomeSymWordN, binSomeSymWordNR1)
-ITEOP_FUN(=~>, SymTabularFun)
-ITEOP_FUN(-~>, SymGeneralFun)
-#endif
-
-instance LogicalOp SymBool where
-  (SymBool l) ||~ (SymBool r) = SymBool $ pevalOrTerm l r
-  (SymBool l) &&~ (SymBool r) = SymBool $ pevalAndTerm l r
-  nots (SymBool v) = SymBool $ pevalNotTerm v
-  (SymBool l) `xors` (SymBool r) = SymBool $ pevalXorTerm l r
-  (SymBool l) `implies` (SymBool r) = SymBool $ pevalImplyTerm l r
diff --git a/src/Grisette/Core/Data/Class/Bool.hs-boot b/src/Grisette/Core/Data/Class/Bool.hs-boot
deleted file mode 100644
--- a/src/Grisette/Core/Data/Class/Bool.hs-boot
+++ /dev/null
@@ -1,36 +0,0 @@
-module Grisette.Core.Data.Class.Bool (LogicalOp (..), ITEOp (..)) where
-
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim (SymBool)
-
-class LogicalOp b where
-  -- | Symbolic disjunction
-  (||~) :: b -> b -> b
-  a ||~ b = nots $ nots a &&~ nots b
-  {-# INLINE (||~) #-}
-
-  infixr 2 ||~
-
-  -- | Symbolic conjunction
-  (&&~) :: b -> b -> b
-  a &&~ b = nots $ nots a ||~ nots b
-  {-# INLINE (&&~) #-}
-
-  infixr 3 &&~
-
-  -- | Symbolic negation
-  nots :: b -> b
-
-  -- | Symbolic exclusive disjunction
-  xors :: b -> b -> b
-  a `xors` b = (a &&~ nots b) ||~ (nots a &&~ b)
-  {-# INLINE xors #-}
-
-  -- | Symbolic implication
-  implies :: b -> b -> b
-  a `implies` b = nots a ||~ b
-  {-# INLINE implies #-}
-
-  {-# MINIMAL (||~), nots | (&&~), nots #-}
-
-class ITEOp v where
-  ites :: SymBool -> v -> v -> v
diff --git a/src/Grisette/Core/Data/Class/CEGISSolver.hs b/src/Grisette/Core/Data/Class/CEGISSolver.hs
--- a/src/Grisette/Core/Data/Class/CEGISSolver.hs
+++ b/src/Grisette/Core/Data/Class/CEGISSolver.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -22,11 +21,19 @@
 
     --
 
-    -- | The examples assumes a [z3](https://github.com/Z3Prover/z3) solver available in @PATH@.
+    -- | The examples assumes that the [z3](https://github.com/Z3Prover/z3)
+    -- solver is available in @PATH@.
 
-    -- * CEGIS solver interfaces
-    CEGISSolver (..),
+    -- * Generic CEGIS interface
+    SynthesisConstraintFun,
+    VerifierResult (..),
+    StatefulVerifierFun,
+    CEGISResult (..),
+    genericCEGIS,
+
+    -- * CEGIS interfaces with pre/post conditions
     CEGISCondition (..),
+    cegisMultiInputs,
     cegisPostCond,
     cegisPrePost,
     cegis,
@@ -39,23 +46,39 @@
   )
 where
 
+import Control.Monad (foldM, unless)
+import Data.List (partition)
 import GHC.Generics (Generic)
 import Generics.Deriving (Default (Default))
 import Grisette.Core.Control.Exception
   ( VerificationConditions (AssertionViolation, AssumptionViolation),
   )
-import Grisette.Core.Data.Class.Evaluate (EvaluateSym)
+import Grisette.Core.Data.Class.EvaluateSym (EvaluateSym, evaluateSym)
 import Grisette.Core.Data.Class.ExtractSymbolics
   ( ExtractSymbolics,
+    extractSymbolics,
   )
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&)))
 import Grisette.Core.Data.Class.Mergeable (Mergeable)
+import Grisette.Core.Data.Class.ModelOps
+  ( ModelOps (exact, exceptFor),
+    SymbolSetOps (isEmptySet),
+  )
+import Grisette.Core.Data.Class.SEq (SEq)
 import Grisette.Core.Data.Class.SimpleMergeable
   ( SimpleMergeable,
     UnionPrjOp,
     simpleMerge,
   )
 import Grisette.Core.Data.Class.Solvable (Solvable (con))
-import Grisette.Core.Data.Class.Solver (UnionWithExcept (extractUnionExcept))
+import Grisette.Core.Data.Class.Solver
+  ( ConfigurableSolver,
+    Solver (solverSolve),
+    SolvingFailure (Unsat),
+    UnionWithExcept (extractUnionExcept),
+    solve,
+    withSolver,
+  )
 import Grisette.IR.SymPrim.Data.Prim.Model (Model)
 import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
 
@@ -65,6 +88,83 @@
 -- >>> import Grisette.IR.SymPrim
 -- >>> import Grisette.Backend.SBV
 
+-- | Synthesis constraint function.
+--
+-- The first argument is the iteration number, for angelic programs, you can use
+-- it to instantiate the angelic variables in the program.
+--
+-- The second argument is the counter-example generated by the verifier.
+--
+-- The synthesizer will try to find a program that is true for all the synthesis
+-- constraints.
+type SynthesisConstraintFun input = Int -> input -> IO SymBool
+
+-- | The result of the verifier.
+data VerifierResult input exception
+  = CEGISVerifierFoundCex input
+  | CEGISVerifierNoCex
+  | CEGISVerifierException exception
+
+-- | The verifier function.
+--
+-- The first argument is the state of the verifier.
+--
+-- The second argument is the candidate model proposed by the synthesizer.
+type StatefulVerifierFun state input exception =
+  state -> Model -> IO (state, VerifierResult input exception)
+
+-- | The result of the CEGIS procedure.
+data CEGISResult exception
+  = CEGISSuccess Model
+  | CEGISVerifierFailure exception
+  | CEGISSolverFailure SolvingFailure
+  deriving (Show)
+
+-- | Generic CEGIS procedure.
+--
+-- The CEGIS procedure will try to find a model that satisfies the initial
+-- synthesis constraint, and satisfies all the inputs generated by the verifier.
+genericCEGIS ::
+  (ConfigurableSolver config handle) =>
+  -- | Configuration of the solver.
+  config ->
+  -- | The initial synthesis constraint.
+  SymBool ->
+  -- | The synthesis constraint function.
+  SynthesisConstraintFun input ->
+  -- | The initial state of the verifier.
+  verifierState ->
+  -- | The verifier function.
+  StatefulVerifierFun verifierState input exception ->
+  IO ([input], CEGISResult exception)
+genericCEGIS config initConstr synthConstr initVerifierState verifier =
+  withSolver config $ \solver -> do
+    firstResult <- solverSolve solver initConstr
+    case firstResult of
+      Left err -> return ([], CEGISSolverFailure err)
+      Right model -> go solver model 0 initVerifierState
+  where
+    go solver prevModel iterNum verifierState = do
+      (newVerifierState, verifierResult) <-
+        verifier verifierState prevModel
+      case verifierResult of
+        CEGISVerifierFoundCex cex -> do
+          newResult <- solverSolve solver =<< synthConstr iterNum cex
+          case newResult of
+            Left err -> return ([], CEGISSolverFailure err)
+            Right model -> do
+              (cexes, result) <- go solver model (iterNum + 1) newVerifierState
+              return (cex : cexes, result)
+        CEGISVerifierNoCex -> return ([], CEGISSuccess prevModel)
+        CEGISVerifierException exception ->
+          return ([], CEGISVerifierFailure exception)
+
+data CEGISMultiInputsState input = CEGISMultiInputsState
+  { _cegisMultiInputsRemainingSymInputs :: [input],
+    _cegisMultiInputsPre :: SymBool,
+    _cegisMultiInputsPost :: SymBool
+  }
+
 -- | The condition for CEGIS to solve.
 --
 -- The first argument is the pre-condition, and the second argument is the
@@ -82,7 +182,9 @@
 -- meets the pre-conditions on every possible inputs, and there are at least
 -- one possible input. The post-condition is used to specify the desired program
 -- behaviors.
-data CEGISCondition = CEGISCondition SymBool SymBool deriving (Generic)
+data CEGISCondition = CEGISCondition SymBool SymBool
+  deriving (Generic)
+  deriving (EvaluateSym) via (Default CEGISCondition)
 
 -- | Construct a CEGIS condition with only a post-condition. The pre-condition
 -- would be set to true, meaning that all programs in the program space are
@@ -98,56 +200,87 @@
 
 deriving via (Default CEGISCondition) instance SimpleMergeable CEGISCondition
 
--- | Counter-example guided inductive synthesis (CEGIS) solver interface.
-class
-  CEGISSolver config failure
-    | config -> failure
+-- |
+-- CEGIS with multiple (possibly symbolic) inputs. Solves the following formula
+-- (see 'CEGISCondition' for details).
+--
+-- \[
+--   \forall P. (\exists I\in\mathrm{inputs}. \mathrm{pre}(P, I)) \wedge (\forall I\in\mathrm{inputs}. \mathrm{pre}(P, I)\implies \mathrm{post}(P, I))
+-- \]
+--
+-- For simpler queries, where the inputs are representable by a single
+-- symbolic value, you may want to use 'cegis' or 'cegisExcept' instead.
+-- We have an example for the 'cegis' call.
+cegisMultiInputs ::
+  ( EvaluateSym input,
+    ExtractSymbolics input,
+    ConfigurableSolver config handle
+  ) =>
+  config ->
+  [input] ->
+  (input -> CEGISCondition) ->
+  IO ([input], CEGISResult SolvingFailure)
+cegisMultiInputs config inputs toCEGISCondition = do
+  initConstr <- cexesAssertFun conInputs
+  genericCEGIS
+    config
+    initConstr
+    synthConstr
+    (CEGISMultiInputsState symInputs (con True) (con True))
+    verifier
   where
-  -- |
-  -- CEGIS with multiple (possibly symbolic) inputs. Solves the following formula (see
-  -- 'CEGISCondition' for details).
-  --
-  -- \[
-  --   \forall P. (\exists I\in\mathrm{inputs}. \mathrm{pre}(P, I)) \wedge (\forall I\in\mathrm{inputs}. \mathrm{pre}(P, I)\implies \mathrm{post}(P, I))
-  -- \]
-  --
-  -- For simpler queries, where the inputs are representable by a single
-  -- symbolic value, you may want to use 'cegis' or 'cegisExcept' instead.
-  -- We have an example for the 'cegis' call.
-  cegisMultiInputs ::
-    (EvaluateSym inputs, ExtractSymbolics inputs) =>
-    -- | The configuration of the solver
-    config ->
-    -- | Some initial counter-examples. Providing some concrete
-    -- inputs may help the solver to find a model faster. Providing
-    -- symbolic inputs would cause the solver to find the program
-    -- that works on all the inputs representable by it (see
-    -- 'CEGISCondition').
-    [inputs] ->
-    -- | The function mapping the inputs to
-    -- the conditions for the solver to
-    -- solve.
-    (inputs -> CEGISCondition) ->
-    -- | The counter-examples generated
-    -- during the CEGIS loop, and the
-    -- model found by the solver.
-    IO ([inputs], Either failure Model)
+    (conInputs, symInputs) = partition (isEmptySet . extractSymbolics) inputs
+    forallSymbols = extractSymbolics symInputs
+    cexAssertFun input = do
+      unless (isEmptySet (extractSymbolics input)) $ error "BUG"
+      CEGISCondition pre post <- return $ toCEGISCondition input
+      return $ pre .&& post
+    cexesAssertFun = foldM (\acc x -> (acc .&&) <$> cexAssertFun x) (con True)
+    synthConstr _ = cexAssertFun
+    verifier state@(CEGISMultiInputsState [] _ _) _ =
+      return (state, CEGISVerifierNoCex)
+    verifier
+      (CEGISMultiInputsState (nextSymInput : symInputs) pre post)
+      candidate = do
+        CEGISCondition nextPre nextPost <-
+          return $ toCEGISCondition nextSymInput
+        let newPre = pre .&& nextPre
+        let newPost = post .&& nextPost
+        let evaluated =
+              evaluateSym False (exceptFor forallSymbols candidate) $
+                newPre .&& symNot newPost
+        r <- solve config evaluated
+        case r of
+          Left Unsat ->
+            verifier (CEGISMultiInputsState symInputs newPre newPost) candidate
+          Left err ->
+            return
+              ( CEGISMultiInputsState [] newPre newPost,
+                CEGISVerifierException err
+              )
+          Right model ->
+            return
+              ( CEGISMultiInputsState (nextSymInput : symInputs) newPre newPost,
+                CEGISVerifierFoundCex $
+                  evaluateSym False (exact forallSymbols model) nextSymInput
+              )
 
 -- |
 -- CEGIS with a single symbolic input to represent a set of inputs.
 --
 -- The following example tries to find the value of @c@ such that for all
--- positive @x@, @x * c < 0 && c > -2@. The @c >~ -2@ clause is used to make
+-- positive @x@, @x * c < 0 && c > -2@. The @c .> -2@ clause is used to make
 -- the solution unique.
 --
 -- >>> :set -XOverloadedStrings
 -- >>> let [x,c] = ["x","c"] :: [SymInteger]
--- >>> cegis (precise z3) x (cegisPrePost (x >~ 0) (x * c <~ 0 &&~ c >~ -2))
--- ([],Right (Model {c -> -1 :: Integer}))
+-- >>> cegis (precise z3) x (\x -> cegisPrePost (x .> 0) (x * c .< 0 .&& c .> -2))
+-- ([...],CEGISSuccess (Model {c -> -1 :: Integer}))
 cegis ::
-  ( CEGISSolver config failure,
+  ( ConfigurableSolver config handle,
     EvaluateSym inputs,
-    ExtractSymbolics inputs
+    ExtractSymbolics inputs,
+    SEq inputs
   ) =>
   -- | The configuration of the solver
   config ->
@@ -158,18 +291,18 @@
   -- | The condition for the solver to solve. All the
   -- symbolic constants that are not in the inputs will
   -- be considered as part of the symbolic program.
-  CEGISCondition ->
+  (inputs -> CEGISCondition) ->
   -- | The counter-examples generated
   -- during the CEGIS loop, and the
   -- model found by the solver.
-  IO ([inputs], Either failure Model)
-cegis config inputs cond = cegisMultiInputs config [inputs] (const cond)
+  IO ([inputs], CEGISResult SolvingFailure)
+cegis config inputs = cegisMultiInputs config [inputs]
 
 -- |
 -- CEGIS for symbolic programs with error handling, using multiple (possibly
 -- symbolic) inputs to represent a set of inputs.
 cegisExceptMultiInputs ::
-  ( CEGISSolver config failure,
+  ( ConfigurableSolver config handle,
     EvaluateSym inputs,
     ExtractSymbolics inputs,
     UnionWithExcept t u e v,
@@ -180,9 +313,12 @@
   [inputs] ->
   (Either e v -> CEGISCondition) ->
   (inputs -> t) ->
-  IO ([inputs], Either failure Model)
+  IO ([inputs], CEGISResult SolvingFailure)
 cegisExceptMultiInputs config cexes interpretFun f =
-  cegisMultiInputs config cexes (simpleMerge . (interpretFun <$>) . extractUnionExcept . f)
+  cegisMultiInputs
+    config
+    cexes
+    (simpleMerge . (interpretFun <$>) . extractUnionExcept . f)
 
 -- |
 -- CEGIS for symbolic programs with error handling, using multiple (possibly
@@ -190,7 +326,7 @@
 --
 -- The errors should be translated to assertion or assumption violations.
 cegisExceptVCMultiInputs ::
-  ( CEGISSolver config failure,
+  ( ConfigurableSolver config handle,
     EvaluateSym inputs,
     ExtractSymbolics inputs,
     UnionWithExcept t u e v,
@@ -201,7 +337,7 @@
   [inputs] ->
   (Either e v -> u (Either VerificationConditions ())) ->
   (inputs -> t) ->
-  IO ([inputs], Either failure Model)
+  IO ([inputs], CEGISResult SolvingFailure)
 cegisExceptVCMultiInputs config cexes interpretFun f =
   cegisMultiInputs
     config
@@ -227,7 +363,7 @@
 -- and translates assertion violations to failed post-conditions.
 -- The '()' result will not fail any conditions.
 cegisExceptStdVCMultiInputs ::
-  ( CEGISSolver config failure,
+  ( ConfigurableSolver config handle,
     EvaluateSym inputs,
     ExtractSymbolics inputs,
     UnionWithExcept t u VerificationConditions (),
@@ -237,7 +373,7 @@
   config ->
   [inputs] ->
   (inputs -> t) ->
-  IO ([inputs], Either failure Model)
+  IO ([inputs], CEGISResult SolvingFailure)
 cegisExceptStdVCMultiInputs config cexes =
   cegisExceptVCMultiInputs config cexes return
 
@@ -251,18 +387,18 @@
 -- readability and modularity of the code.
 --
 -- The following example tries to find the value of @c@ such that for all
--- positive @x@, @x * c < 0 && c > -2@. The @c >~ -2@ assertion is used to make
+-- positive @x@, @x * c < 0 && c > -2@. The @c .> -2@ assertion is used to make
 -- the solution unique.
 --
 -- >>> :set -XOverloadedStrings
 -- >>> let [x,c] = ["x","c"] :: [SymInteger]
 -- >>> import Control.Monad.Except
 -- >>> :{
---   res :: ExceptT VerificationConditions UnionM ()
---   res = do
---     symAssume $ x >~ 0
---     symAssert $ x * c <~ 0
---     symAssert $ c >~ -2
+--   res :: SymInteger -> ExceptT VerificationConditions UnionM ()
+--   res x = do
+--     symAssume $ x .> 0
+--     symAssert $ x * c .< 0
+--     symAssert $ c .> -2
 -- :}
 --
 -- >>> :{
@@ -272,21 +408,23 @@
 -- :}
 --
 -- >>> cegisExcept (precise z3) x translation res
--- ([],Right (Model {c -> -1 :: Integer}))
+-- ([...],CEGISSuccess (Model {c -> -1 :: Integer}))
 cegisExcept ::
   ( UnionWithExcept t u e v,
     UnionPrjOp u,
     Functor u,
     EvaluateSym inputs,
     ExtractSymbolics inputs,
-    CEGISSolver config failure
+    ConfigurableSolver config handle,
+    SEq inputs
   ) =>
   config ->
   inputs ->
   (Either e v -> CEGISCondition) ->
-  t ->
-  IO ([inputs], Either failure Model)
-cegisExcept config inputs f v = cegis config inputs $ simpleMerge $ f <$> extractUnionExcept v
+  (inputs -> t) ->
+  IO ([inputs], CEGISResult SolvingFailure)
+cegisExcept config inputs f v =
+  cegis config inputs $ \i -> simpleMerge $ f <$> extractUnionExcept (v i)
 
 -- |
 -- CEGIS for symbolic programs with error handling, using a single symbolic
@@ -299,22 +437,23 @@
     Monad u,
     EvaluateSym inputs,
     ExtractSymbolics inputs,
-    CEGISSolver config failure
+    ConfigurableSolver config handle,
+    SEq inputs
   ) =>
   config ->
   inputs ->
   (Either e v -> u (Either VerificationConditions ())) ->
-  t ->
-  IO ([inputs], Either failure Model)
-cegisExceptVC config inputs f v =
-  cegis config inputs $
+  (inputs -> t) ->
+  IO ([inputs], CEGISResult SolvingFailure)
+cegisExceptVC config inputs f v = do
+  cegis config inputs $ \i ->
     simpleMerge $
       ( \case
           Left AssumptionViolation -> cegisPrePost (con False) (con True)
           Left AssertionViolation -> cegisPostCond (con False)
           _ -> cegisPostCond (con True)
       )
-        <$> (extractUnionExcept v >>= f)
+        <$> (extractUnionExcept (v i) >>= f)
 
 -- |
 -- CEGIS for symbolic programs with error handling, using a single symbolic
@@ -327,32 +466,33 @@
 -- The '()' result will not fail any conditions.
 --
 -- The following example tries to find the value of @c@ such that for all
--- positive @x@, @x * c < 0 && c > -2@. The @c >~ -2@ assertion is used to make
+-- positive @x@, @x * c < 0 && c > -2@. The @c .> -2@ assertion is used to make
 -- the solution unique.
 --
 -- >>> :set -XOverloadedStrings
 -- >>> let [x,c] = ["x","c"] :: [SymInteger]
 -- >>> import Control.Monad.Except
 -- >>> :{
---   res :: ExceptT VerificationConditions UnionM ()
---   res = do
---     symAssume $ x >~ 0
---     symAssert $ x * c <~ 0
---     symAssert $ c >~ -2
+--   res :: SymInteger -> ExceptT VerificationConditions UnionM ()
+--   res x = do
+--     symAssume $ x .> 0
+--     symAssert $ x * c .< 0
+--     symAssert $ c .> -2
 -- :}
 --
 -- >>> cegisExceptStdVC (precise z3) x res
--- ([],Right (Model {c -> -1 :: Integer}))
+-- ([...],CEGISSuccess (Model {c -> -1 :: Integer}))
 cegisExceptStdVC ::
   ( UnionWithExcept t u VerificationConditions (),
     UnionPrjOp u,
     Monad u,
     EvaluateSym inputs,
     ExtractSymbolics inputs,
-    CEGISSolver config failure
+    ConfigurableSolver config handle,
+    SEq inputs
   ) =>
   config ->
   inputs ->
-  t ->
-  IO ([inputs], Either failure Model)
+  (inputs -> t) ->
+  IO ([inputs], CEGISResult SolvingFailure)
 cegisExceptStdVC config inputs = cegisExceptVC config inputs return
diff --git a/src/Grisette/Core/Data/Class/Error.hs b/src/Grisette/Core/Data/Class/Error.hs
--- a/src/Grisette/Core/Data/Class/Error.hs
+++ b/src/Grisette/Core/Data/Class/Error.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE Trustworthy #-}
@@ -18,19 +19,27 @@
     symAssertWith,
     symAssertTransformableError,
     symThrowTransformableError,
+    symAssert,
+    symAssume,
   )
 where
 
+import Control.Exception (ArithException, ArrayException)
 import Control.Monad.Except (MonadError (throwError))
+import Grisette.Core.Control.Exception
+  ( AssertionError (AssertionError),
+    VerificationConditions (AssertionViolation, AssumptionViolation),
+  )
 import Grisette.Core.Control.Monad.Union (MonadUnion)
 import Grisette.Core.Data.Class.Mergeable (Mergeable)
 import Grisette.Core.Data.Class.SimpleMergeable (merge, mrgIf)
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
 
 -- $setup
 -- >>> import Control.Exception
 -- >>> import Grisette.Core
 -- >>> import Grisette.IR.SymPrim
+-- >>> import Grisette.Lib.Control.Monad
 -- >>> import Control.Monad.Except
 -- >>> :set -XOverloadedStrings
 -- >>> :set -XFlexibleContexts
@@ -116,3 +125,81 @@
   erm ()
 symAssertWith err cond = mrgIf cond (return ()) (throwError err)
 {-# INLINE symAssertWith #-}
+
+instance TransformError VerificationConditions VerificationConditions where
+  transformError = id
+
+instance TransformError AssertionError VerificationConditions where
+  transformError _ = AssertionViolation
+
+instance TransformError ArithException AssertionError where
+  transformError _ = AssertionError
+
+instance TransformError ArrayException AssertionError where
+  transformError _ = AssertionError
+
+instance TransformError AssertionError AssertionError where
+  transformError = id
+
+-- | Used within a monadic multi path computation to begin exception processing.
+--
+-- Checks the condition passed to the function.
+-- The current execution path will be terminated with assertion error if the condition is false.
+--
+-- If the condition is symbolic, Grisette will split the execution into two paths based on the condition.
+-- The symbolic execution will continue on the then-branch, where the condition is true.
+-- For the else branch, where the condition is false, the execution will be terminated.
+--
+-- The resulting monadic environment should be compatible with the 'AssertionError'
+-- error type. See 'TransformError' type class for details.
+--
+-- __/Examples/__:
+--
+-- Terminates the execution if the condition is false.
+-- Note that we may lose the 'Mergeable' knowledge here if no possible execution
+-- path is viable. This may affect the efficiency in theory, but in practice this
+-- should not be a problem as all paths are terminated and no further evaluation
+-- would be performed.
+--
+-- >>> symAssert (con False) :: ExceptT AssertionError UnionM ()
+-- ExceptT {Left AssertionError}
+-- >>> do; symAssert (con False); mrgReturn 1 :: ExceptT AssertionError UnionM Integer
+-- ExceptT <Left AssertionError>
+--
+-- No effect if the condition is true:
+--
+-- >>> symAssert (con True) :: ExceptT AssertionError UnionM ()
+-- ExceptT {Right ()}
+-- >>> do; symAssert (con True); mrgReturn 1 :: ExceptT AssertionError UnionM Integer
+-- ExceptT {Right 1}
+--
+-- Splitting the path and terminate one of them when the condition is symbolic.
+--
+-- >>> symAssert (ssym "a") :: ExceptT AssertionError UnionM ()
+-- ExceptT {If (! a) (Left AssertionError) (Right ())}
+-- >>> do; symAssert (ssym "a"); mrgReturn 1 :: ExceptT AssertionError UnionM Integer
+-- ExceptT {If (! a) (Left AssertionError) (Right 1)}
+--
+-- 'AssertionError' is compatible with 'VerificationConditions':
+--
+-- >>> symAssert (ssym "a") :: ExceptT VerificationConditions UnionM ()
+-- ExceptT {If (! a) (Left AssertionViolation) (Right ())}
+symAssert ::
+  (TransformError AssertionError to, Mergeable to, MonadError to erm, MonadUnion erm) =>
+  SymBool ->
+  erm ()
+symAssert = symAssertTransformableError AssertionError
+
+-- | Used within a monadic multi path computation to begin exception processing.
+--
+-- Similar to 'symAssert', but terminates the execution path with 'AssumptionViolation' error.
+--
+-- /Examples/:
+--
+-- >>> symAssume (ssym "a") :: ExceptT VerificationConditions UnionM ()
+-- ExceptT {If (! a) (Left AssumptionViolation) (Right ())}
+symAssume ::
+  (TransformError VerificationConditions to, Mergeable to, MonadError to erm, MonadUnion erm) =>
+  SymBool ->
+  erm ()
+symAssume = symAssertTransformableError AssumptionViolation
diff --git a/src/Grisette/Core/Data/Class/Evaluate.hs b/src/Grisette/Core/Data/Class/Evaluate.hs
deleted file mode 100644
--- a/src/Grisette/Core/Data/Class/Evaluate.hs
+++ /dev/null
@@ -1,241 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-
--- |
--- Module      :   Grisette.Core.Data.Class.Evaluate
--- Copyright   :   (c) Sirui Lu 2021-2023
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Core.Data.Class.Evaluate
-  ( -- * Evaluating symbolic values with model
-    EvaluateSym (..),
-    evaluateSymToCon,
-  )
-where
-
-import Control.Monad.Except (ExceptT (ExceptT))
-import Control.Monad.Identity
-  ( Identity (Identity),
-    IdentityT (IdentityT),
-  )
-import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
-import qualified Control.Monad.Writer.Lazy as WriterLazy
-import qualified Control.Monad.Writer.Strict as WriterStrict
-import qualified Data.ByteString as B
-import Data.Functor.Sum (Sum)
-import Data.Int (Int16, Int32, Int64, Int8)
-import Data.Maybe (fromJust)
-import qualified Data.Text as T
-import Data.Word (Word16, Word32, Word64, Word8)
-import GHC.TypeNats (KnownNat, type (<=))
-import Generics.Deriving
-  ( Default (Default, unDefault),
-    Generic (Rep, from, to),
-    K1 (K1),
-    M1 (M1),
-    U1,
-    type (:*:) ((:*:)),
-    type (:+:) (L1, R1),
-  )
-import Generics.Deriving.Instances ()
-import Grisette.Core.Data.BV (IntN, SomeIntN, SomeWordN, WordN)
-import Grisette.Core.Data.Class.ToCon (ToCon (toCon))
-import Grisette.IR.SymPrim.Data.Prim.Model (Model)
-
--- $setup
--- >>> import Grisette.Core
--- >>> import Grisette.IR.SymPrim
--- >>> import Data.Proxy
--- >>> :set -XTypeApplications
-
--- | Evaluating symbolic values with some model.
---
--- >>> let model = insertValue (SimpleSymbol "a") (1 :: Integer) emptyModel :: Model
--- >>> evaluateSym False model ([ssym "a", ssym "b"] :: [SymInteger])
--- [1,b]
---
--- If we set the first argument true, the missing variables will be filled in with
--- some default values:
---
--- >>> evaluateSym True model ([ssym "a", ssym "b"] :: [SymInteger])
--- [1,0]
---
--- __Note 1:__ This type class can be derived for algebraic data types.
--- You may need the @DerivingVia@ and @DerivingStrategies@ extensions.
---
--- > data X = ... deriving Generic deriving EvaluateSym via (Default X)
-class EvaluateSym a where
-  -- | Evaluate a symbolic variable with some model, possibly fill in values for the missing variables.
-  evaluateSym :: Bool -> Model -> a -> a
-
-instance (Generic a, EvaluateSym' (Rep a)) => EvaluateSym (Default a) where
-  evaluateSym fillDefault model = Default . to . evaluateSym' fillDefault model . from . unDefault
-
-class EvaluateSym' a where
-  evaluateSym' :: Bool -> Model -> a c -> a c
-
-instance EvaluateSym' U1 where
-  evaluateSym' _ _ = id
-
-instance (EvaluateSym c) => EvaluateSym' (K1 i c) where
-  evaluateSym' fillDefault model (K1 v) = K1 $ evaluateSym fillDefault model v
-
-instance (EvaluateSym' a) => EvaluateSym' (M1 i c a) where
-  evaluateSym' fillDefault model (M1 v) = M1 $ evaluateSym' fillDefault model v
-
-instance (EvaluateSym' a, EvaluateSym' b) => EvaluateSym' (a :+: b) where
-  evaluateSym' fillDefault model (L1 l) = L1 $ evaluateSym' fillDefault model l
-  evaluateSym' fillDefault model (R1 r) = R1 $ evaluateSym' fillDefault model r
-
-instance (EvaluateSym' a, EvaluateSym' b) => EvaluateSym' (a :*: b) where
-  evaluateSym' fillDefault model (a :*: b) = evaluateSym' fillDefault model a :*: evaluateSym' fillDefault model b
-
--- | Evaluate a symbolic variable with some model, fill in values for the missing variables,
--- and transform to concrete ones
---
--- >>> let model = insertValue (SimpleSymbol "a") (1 :: Integer) emptyModel :: Model
--- >>> evaluateSymToCon model ([ssym "a", ssym "b"] :: [SymInteger]) :: [Integer]
--- [1,0]
-evaluateSymToCon :: (ToCon a b, EvaluateSym a) => Model -> a -> b
-evaluateSymToCon model a = fromJust $ toCon $ evaluateSym True model a
-
--- instances
-
-#define CONCRETE_EVALUATESYM(type) \
-instance EvaluateSym type where \
-  evaluateSym _ _ = id
-
-#define CONCRETE_EVALUATESYM_BV(type) \
-instance (KnownNat n, 1 <= n) => EvaluateSym (type n) where \
-  evaluateSym _ _ = id
-
-#if 1
-CONCRETE_EVALUATESYM(Bool)
-CONCRETE_EVALUATESYM(Integer)
-CONCRETE_EVALUATESYM(Char)
-CONCRETE_EVALUATESYM(Int)
-CONCRETE_EVALUATESYM(Int8)
-CONCRETE_EVALUATESYM(Int16)
-CONCRETE_EVALUATESYM(Int32)
-CONCRETE_EVALUATESYM(Int64)
-CONCRETE_EVALUATESYM(Word)
-CONCRETE_EVALUATESYM(Word8)
-CONCRETE_EVALUATESYM(Word16)
-CONCRETE_EVALUATESYM(Word32)
-CONCRETE_EVALUATESYM(Word64)
-CONCRETE_EVALUATESYM(SomeIntN)
-CONCRETE_EVALUATESYM(SomeWordN)
-CONCRETE_EVALUATESYM(B.ByteString)
-CONCRETE_EVALUATESYM(T.Text)
-CONCRETE_EVALUATESYM_BV(IntN)
-CONCRETE_EVALUATESYM_BV(WordN)
-#endif
-
--- ()
-instance EvaluateSym () where
-  evaluateSym _ _ = id
-
--- Either
-deriving via (Default (Either a b)) instance (EvaluateSym a, EvaluateSym b) => EvaluateSym (Either a b)
-
--- Maybe
-deriving via (Default (Maybe a)) instance (EvaluateSym a) => EvaluateSym (Maybe a)
-
--- List
-deriving via (Default [a]) instance (EvaluateSym a) => EvaluateSym [a]
-
--- (,)
-deriving via (Default (a, b)) instance (EvaluateSym a, EvaluateSym b) => EvaluateSym (a, b)
-
--- (,,)
-deriving via (Default (a, b, c)) instance (EvaluateSym a, EvaluateSym b, EvaluateSym c) => EvaluateSym (a, b, c)
-
--- (,,,)
-deriving via
-  (Default (a, b, c, d))
-  instance
-    (EvaluateSym a, EvaluateSym b, EvaluateSym c, EvaluateSym d) => EvaluateSym (a, b, c, d)
-
--- (,,,,)
-deriving via
-  (Default (a, b, c, d, e))
-  instance
-    (EvaluateSym a, EvaluateSym b, EvaluateSym c, EvaluateSym d, EvaluateSym e) =>
-    EvaluateSym (a, b, c, d, e)
-
--- (,,,,,)
-deriving via
-  (Default (a, b, c, d, e, f))
-  instance
-    (EvaluateSym a, EvaluateSym b, EvaluateSym c, EvaluateSym d, EvaluateSym e, EvaluateSym f) =>
-    EvaluateSym (a, b, c, d, e, f)
-
--- (,,,,,,)
-deriving via
-  (Default (a, b, c, d, e, f, g))
-  instance
-    ( EvaluateSym a,
-      EvaluateSym b,
-      EvaluateSym c,
-      EvaluateSym d,
-      EvaluateSym e,
-      EvaluateSym f,
-      EvaluateSym g
-    ) =>
-    EvaluateSym (a, b, c, d, e, f, g)
-
--- (,,,,,,,)
-deriving via
-  (Default (a, b, c, d, e, f, g, h))
-  instance
-    ( EvaluateSym a,
-      EvaluateSym b,
-      EvaluateSym c,
-      EvaluateSym d,
-      EvaluateSym e,
-      EvaluateSym f,
-      EvaluateSym g,
-      EvaluateSym h
-    ) =>
-    EvaluateSym ((,,,,,,,) a b c d e f g h)
-
--- MaybeT
-instance (EvaluateSym (m (Maybe a))) => EvaluateSym (MaybeT m a) where
-  evaluateSym fillDefault model (MaybeT v) = MaybeT $ evaluateSym fillDefault model v
-
--- ExceptT
-instance (EvaluateSym (m (Either e a))) => EvaluateSym (ExceptT e m a) where
-  evaluateSym fillDefault model (ExceptT v) = ExceptT $ evaluateSym fillDefault model v
-
--- Sum
-deriving via
-  (Default (Sum f g a))
-  instance
-    (EvaluateSym (f a), EvaluateSym (g a)) => EvaluateSym (Sum f g a)
-
--- WriterT
-instance (EvaluateSym (m (a, s))) => EvaluateSym (WriterLazy.WriterT s m a) where
-  evaluateSym fillDefault model (WriterLazy.WriterT v) = WriterLazy.WriterT $ evaluateSym fillDefault model v
-
-instance (EvaluateSym (m (a, s))) => EvaluateSym (WriterStrict.WriterT s m a) where
-  evaluateSym fillDefault model (WriterStrict.WriterT v) = WriterStrict.WriterT $ evaluateSym fillDefault model v
-
--- Identity
-instance (EvaluateSym a) => EvaluateSym (Identity a) where
-  evaluateSym fillDefault model (Identity a) = Identity $ evaluateSym fillDefault model a
-
--- IdentityT
-instance (EvaluateSym (m a)) => EvaluateSym (IdentityT m a) where
-  evaluateSym fillDefault model (IdentityT a) = IdentityT $ evaluateSym fillDefault model a
diff --git a/src/Grisette/Core/Data/Class/EvaluateSym.hs b/src/Grisette/Core/Data/Class/EvaluateSym.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Core/Data/Class/EvaluateSym.hs
@@ -0,0 +1,286 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- |
+-- Module      :   Grisette.Core.Data.Class.EvaluateSym
+-- Copyright   :   (c) Sirui Lu 2021-2023
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Core.Data.Class.EvaluateSym
+  ( -- * Evaluating symbolic values with model
+    EvaluateSym (..),
+    evaluateSymToCon,
+  )
+where
+
+import Control.Monad.Except (ExceptT (ExceptT))
+import Control.Monad.Identity
+  ( Identity (Identity),
+    IdentityT (IdentityT),
+  )
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import qualified Control.Monad.Writer.Lazy as WriterLazy
+import qualified Control.Monad.Writer.Strict as WriterStrict
+import qualified Data.ByteString as B
+import Data.Functor.Sum (Sum)
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Maybe (fromJust)
+import qualified Data.Text as T
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.TypeNats (KnownNat, type (<=))
+import Generics.Deriving
+  ( Default (Default, unDefault),
+    Generic (Rep, from, to),
+    K1 (K1),
+    M1 (M1),
+    U1,
+    type (:*:) ((:*:)),
+    type (:+:) (L1, R1),
+  )
+import Generics.Deriving.Instances ()
+import Grisette.Core.Control.Exception (AssertionError, VerificationConditions)
+import Grisette.Core.Data.BV (IntN, SomeIntN, SomeWordN, WordN)
+import Grisette.Core.Data.Class.ToCon (ToCon (toCon))
+import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term (LinkedRep, SupportedPrim)
+import Grisette.IR.SymPrim.Data.Prim.Model (Model, evaluateTerm)
+import Grisette.IR.SymPrim.Data.SymPrim
+  ( SomeSymIntN (SomeSymIntN),
+    SomeSymWordN (SomeSymWordN),
+    SymBool (SymBool),
+    SymIntN (SymIntN),
+    SymInteger (SymInteger),
+    SymWordN (SymWordN),
+    type (-~>) (SymGeneralFun),
+    type (=~>) (SymTabularFun),
+  )
+
+-- $setup
+-- >>> import Grisette.Core
+-- >>> import Grisette.IR.SymPrim
+-- >>> import Data.Proxy
+-- >>> :set -XTypeApplications
+
+-- | Evaluating symbolic values with some model.
+--
+-- >>> let model = insertValue (SimpleSymbol "a") (1 :: Integer) emptyModel :: Model
+-- >>> evaluateSym False model ([ssym "a", ssym "b"] :: [SymInteger])
+-- [1,b]
+--
+-- If we set the first argument true, the missing variables will be filled in with
+-- some default values:
+--
+-- >>> evaluateSym True model ([ssym "a", ssym "b"] :: [SymInteger])
+-- [1,0]
+--
+-- __Note 1:__ This type class can be derived for algebraic data types.
+-- You may need the @DerivingVia@ and @DerivingStrategies@ extensions.
+--
+-- > data X = ... deriving Generic deriving EvaluateSym via (Default X)
+class EvaluateSym a where
+  -- | Evaluate a symbolic variable with some model, possibly fill in values for the missing variables.
+  evaluateSym :: Bool -> Model -> a -> a
+
+-- | Evaluate a symbolic variable with some model, fill in values for the missing variables,
+-- and transform to concrete ones
+--
+-- >>> let model = insertValue (SimpleSymbol "a") (1 :: Integer) emptyModel :: Model
+-- >>> evaluateSymToCon model ([ssym "a", ssym "b"] :: [SymInteger]) :: [Integer]
+-- [1,0]
+evaluateSymToCon :: (ToCon a b, EvaluateSym a) => Model -> a -> b
+evaluateSymToCon model a = fromJust $ toCon $ evaluateSym True model a
+
+-- instances
+
+#define CONCRETE_EVALUATESYM(type) \
+instance EvaluateSym type where \
+  evaluateSym _ _ = id
+
+#define CONCRETE_EVALUATESYM_BV(type) \
+instance (KnownNat n, 1 <= n) => EvaluateSym (type n) where \
+  evaluateSym _ _ = id
+
+#if 1
+CONCRETE_EVALUATESYM(Bool)
+CONCRETE_EVALUATESYM(Integer)
+CONCRETE_EVALUATESYM(Char)
+CONCRETE_EVALUATESYM(Int)
+CONCRETE_EVALUATESYM(Int8)
+CONCRETE_EVALUATESYM(Int16)
+CONCRETE_EVALUATESYM(Int32)
+CONCRETE_EVALUATESYM(Int64)
+CONCRETE_EVALUATESYM(Word)
+CONCRETE_EVALUATESYM(Word8)
+CONCRETE_EVALUATESYM(Word16)
+CONCRETE_EVALUATESYM(Word32)
+CONCRETE_EVALUATESYM(Word64)
+CONCRETE_EVALUATESYM(SomeIntN)
+CONCRETE_EVALUATESYM(SomeWordN)
+CONCRETE_EVALUATESYM(B.ByteString)
+CONCRETE_EVALUATESYM(T.Text)
+CONCRETE_EVALUATESYM_BV(IntN)
+CONCRETE_EVALUATESYM_BV(WordN)
+#endif
+
+-- ()
+instance EvaluateSym () where
+  evaluateSym _ _ = id
+
+-- Either
+deriving via (Default (Either a b)) instance (EvaluateSym a, EvaluateSym b) => EvaluateSym (Either a b)
+
+-- Maybe
+deriving via (Default (Maybe a)) instance (EvaluateSym a) => EvaluateSym (Maybe a)
+
+-- List
+deriving via (Default [a]) instance (EvaluateSym a) => EvaluateSym [a]
+
+-- (,)
+deriving via (Default (a, b)) instance (EvaluateSym a, EvaluateSym b) => EvaluateSym (a, b)
+
+-- (,,)
+deriving via (Default (a, b, c)) instance (EvaluateSym a, EvaluateSym b, EvaluateSym c) => EvaluateSym (a, b, c)
+
+-- (,,,)
+deriving via
+  (Default (a, b, c, d))
+  instance
+    (EvaluateSym a, EvaluateSym b, EvaluateSym c, EvaluateSym d) => EvaluateSym (a, b, c, d)
+
+-- (,,,,)
+deriving via
+  (Default (a, b, c, d, e))
+  instance
+    (EvaluateSym a, EvaluateSym b, EvaluateSym c, EvaluateSym d, EvaluateSym e) =>
+    EvaluateSym (a, b, c, d, e)
+
+-- (,,,,,)
+deriving via
+  (Default (a, b, c, d, e, f))
+  instance
+    (EvaluateSym a, EvaluateSym b, EvaluateSym c, EvaluateSym d, EvaluateSym e, EvaluateSym f) =>
+    EvaluateSym (a, b, c, d, e, f)
+
+-- (,,,,,,)
+deriving via
+  (Default (a, b, c, d, e, f, g))
+  instance
+    ( EvaluateSym a,
+      EvaluateSym b,
+      EvaluateSym c,
+      EvaluateSym d,
+      EvaluateSym e,
+      EvaluateSym f,
+      EvaluateSym g
+    ) =>
+    EvaluateSym (a, b, c, d, e, f, g)
+
+-- (,,,,,,,)
+deriving via
+  (Default (a, b, c, d, e, f, g, h))
+  instance
+    ( EvaluateSym a,
+      EvaluateSym b,
+      EvaluateSym c,
+      EvaluateSym d,
+      EvaluateSym e,
+      EvaluateSym f,
+      EvaluateSym g,
+      EvaluateSym h
+    ) =>
+    EvaluateSym ((,,,,,,,) a b c d e f g h)
+
+-- MaybeT
+instance (EvaluateSym (m (Maybe a))) => EvaluateSym (MaybeT m a) where
+  evaluateSym fillDefault model (MaybeT v) = MaybeT $ evaluateSym fillDefault model v
+
+-- ExceptT
+instance (EvaluateSym (m (Either e a))) => EvaluateSym (ExceptT e m a) where
+  evaluateSym fillDefault model (ExceptT v) = ExceptT $ evaluateSym fillDefault model v
+
+-- Sum
+deriving via
+  (Default (Sum f g a))
+  instance
+    (EvaluateSym (f a), EvaluateSym (g a)) => EvaluateSym (Sum f g a)
+
+-- WriterT
+instance (EvaluateSym (m (a, s))) => EvaluateSym (WriterLazy.WriterT s m a) where
+  evaluateSym fillDefault model (WriterLazy.WriterT v) = WriterLazy.WriterT $ evaluateSym fillDefault model v
+
+instance (EvaluateSym (m (a, s))) => EvaluateSym (WriterStrict.WriterT s m a) where
+  evaluateSym fillDefault model (WriterStrict.WriterT v) = WriterStrict.WriterT $ evaluateSym fillDefault model v
+
+-- Identity
+instance (EvaluateSym a) => EvaluateSym (Identity a) where
+  evaluateSym fillDefault model (Identity a) = Identity $ evaluateSym fillDefault model a
+
+-- IdentityT
+instance (EvaluateSym (m a)) => EvaluateSym (IdentityT m a) where
+  evaluateSym fillDefault model (IdentityT a) = IdentityT $ evaluateSym fillDefault model a
+
+-- Symbolic primitives
+#define EVALUATE_SYM_SIMPLE(symtype) \
+instance EvaluateSym symtype where \
+  evaluateSym fillDefault model (symtype t) = symtype $ evaluateTerm fillDefault model t
+
+#define EVALUATE_SYM_BV(symtype) \
+instance (KnownNat n, 1 <= n) => EvaluateSym (symtype n) where \
+  evaluateSym fillDefault model (symtype t) = symtype $ evaluateTerm fillDefault model t
+
+#define EVALUATE_SYM_FUN(op, cons) \
+instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => EvaluateSym (sa op sb) where \
+  evaluateSym fillDefault model (cons t) = cons $ evaluateTerm fillDefault model t
+
+#define EVALUATE_SYM_BV_SOME(somety, origty) \
+instance EvaluateSym somety where \
+  evaluateSym fillDefault model (somety (origty t)) = somety $ origty $ evaluateTerm fillDefault model t
+
+#if 1
+EVALUATE_SYM_SIMPLE(SymBool)
+EVALUATE_SYM_SIMPLE(SymInteger)
+EVALUATE_SYM_BV(SymIntN)
+EVALUATE_SYM_BV(SymWordN)
+EVALUATE_SYM_FUN(=~>, SymTabularFun)
+EVALUATE_SYM_FUN(-~>, SymGeneralFun)
+EVALUATE_SYM_BV_SOME(SomeSymIntN, SymIntN)
+EVALUATE_SYM_BV_SOME(SomeSymWordN, SymWordN)
+#endif
+
+-- Exception
+deriving via (Default AssertionError) instance EvaluateSym AssertionError
+
+deriving via (Default VerificationConditions) instance EvaluateSym VerificationConditions
+
+instance (Generic a, EvaluateSym' (Rep a)) => EvaluateSym (Default a) where
+  evaluateSym fillDefault model = Default . to . evaluateSym' fillDefault model . from . unDefault
+
+class EvaluateSym' a where
+  evaluateSym' :: Bool -> Model -> a c -> a c
+
+instance EvaluateSym' U1 where
+  evaluateSym' _ _ = id
+
+instance (EvaluateSym c) => EvaluateSym' (K1 i c) where
+  evaluateSym' fillDefault model (K1 v) = K1 $ evaluateSym fillDefault model v
+
+instance (EvaluateSym' a) => EvaluateSym' (M1 i c a) where
+  evaluateSym' fillDefault model (M1 v) = M1 $ evaluateSym' fillDefault model v
+
+instance (EvaluateSym' a, EvaluateSym' b) => EvaluateSym' (a :+: b) where
+  evaluateSym' fillDefault model (L1 l) = L1 $ evaluateSym' fillDefault model l
+  evaluateSym' fillDefault model (R1 r) = R1 $ evaluateSym' fillDefault model r
+
+instance (EvaluateSym' a, EvaluateSym' b) => EvaluateSym' (a :*: b) where
+  evaluateSym' fillDefault model (a :*: b) = evaluateSym' fillDefault model a :*: evaluateSym' fillDefault model b
diff --git a/src/Grisette/Core/Data/Class/ExtractSymbolics.hs b/src/Grisette/Core/Data/Class/ExtractSymbolics.hs
--- a/src/Grisette/Core/Data/Class/ExtractSymbolics.hs
+++ b/src/Grisette/Core/Data/Class/ExtractSymbolics.hs
@@ -47,10 +47,26 @@
     type (:*:) ((:*:)),
     type (:+:) (L1, R1),
   )
+import Grisette.Core.Control.Exception (AssertionError, VerificationConditions)
 import Grisette.Core.Data.BV (IntN, SomeIntN, SomeWordN, WordN)
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.Prim.Model
-  ( SymbolSet,
+import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
+  ( LinkedRep,
+    SupportedPrim,
   )
+import Grisette.IR.SymPrim.Data.Prim.InternedTerm.TermUtils (extractSymbolicsTerm)
+import Grisette.IR.SymPrim.Data.Prim.Model
+  ( SymbolSet (SymbolSet),
+  )
+import Grisette.IR.SymPrim.Data.SymPrim
+  ( SomeSymIntN (SomeSymIntN),
+    SomeSymWordN (SomeSymWordN),
+    SymBool (SymBool),
+    SymIntN (SymIntN),
+    SymInteger (SymInteger),
+    SymWordN (SymWordN),
+    type (-~>) (SymGeneralFun),
+    type (=~>) (SymTabularFun),
+  )
 
 -- $setup
 -- >>> import Grisette.Core
@@ -74,36 +90,7 @@
 class ExtractSymbolics a where
   extractSymbolics :: a -> SymbolSet
 
-instance (Generic a, ExtractSymbolics' (Rep a)) => ExtractSymbolics (Default a) where
-  extractSymbolics = extractSymbolics' . from . unDefault
-
-class ExtractSymbolics' a where
-  extractSymbolics' :: a c -> SymbolSet
-
-instance ExtractSymbolics' U1 where
-  extractSymbolics' _ = mempty
-
-instance (ExtractSymbolics c) => ExtractSymbolics' (K1 i c) where
-  extractSymbolics' = extractSymbolics . unK1
-
-instance (ExtractSymbolics' a) => ExtractSymbolics' (M1 i c a) where
-  extractSymbolics' = extractSymbolics' . unM1
-
-instance
-  (ExtractSymbolics' a, ExtractSymbolics' b) =>
-  ExtractSymbolics' (a :+: b)
-  where
-  extractSymbolics' (L1 l) = extractSymbolics' l
-  extractSymbolics' (R1 r) = extractSymbolics' r
-
-instance
-  (ExtractSymbolics' a, ExtractSymbolics' b) =>
-  ExtractSymbolics' (a :*: b)
-  where
-  extractSymbolics' (l :*: r) = extractSymbolics' l <> extractSymbolics' r
-
 -- instances
-
 #define CONCRETE_EXTRACT_SYMBOLICS(type) \
 instance ExtractSymbolics type where \
   extractSymbolics _ = mempty
@@ -274,3 +261,63 @@
 -- IdentityT
 instance (ExtractSymbolics (m a)) => ExtractSymbolics (IdentityT m a) where
   extractSymbolics (IdentityT a) = extractSymbolics a
+
+#define EXTRACT_SYMBOLICS_SIMPLE(symtype) \
+instance ExtractSymbolics symtype where \
+  extractSymbolics (symtype t) = SymbolSet $ extractSymbolicsTerm t
+
+#define EXTRACT_SYMBOLICS_BV(symtype) \
+instance (KnownNat n, 1 <= n) => ExtractSymbolics (symtype n) where \
+  extractSymbolics (symtype t) = SymbolSet $ extractSymbolicsTerm t
+
+#define EXTRACT_SYMBOLICS_FUN(op, cons) \
+instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => ExtractSymbolics (sa op sb) where \
+  extractSymbolics (cons t) = SymbolSet $ extractSymbolicsTerm t
+
+#define EXTRACT_SYMBOLICS_BV_SOME(somety, origty) \
+instance ExtractSymbolics somety where \
+  extractSymbolics (somety (origty t)) = SymbolSet $ extractSymbolicsTerm t
+
+#if 1
+EXTRACT_SYMBOLICS_SIMPLE(SymBool)
+EXTRACT_SYMBOLICS_SIMPLE(SymInteger)
+EXTRACT_SYMBOLICS_BV(SymIntN)
+EXTRACT_SYMBOLICS_BV(SymWordN)
+EXTRACT_SYMBOLICS_FUN(=~>, SymTabularFun)
+EXTRACT_SYMBOLICS_FUN(-~>, SymGeneralFun)
+EXTRACT_SYMBOLICS_BV_SOME(SomeSymIntN, SymIntN)
+EXTRACT_SYMBOLICS_BV_SOME(SomeSymWordN, SymWordN)
+#endif
+
+-- Exception
+deriving via (Default AssertionError) instance ExtractSymbolics AssertionError
+
+deriving via (Default VerificationConditions) instance ExtractSymbolics VerificationConditions
+
+instance (Generic a, ExtractSymbolics' (Rep a)) => ExtractSymbolics (Default a) where
+  extractSymbolics = extractSymbolics' . from . unDefault
+
+class ExtractSymbolics' a where
+  extractSymbolics' :: a c -> SymbolSet
+
+instance ExtractSymbolics' U1 where
+  extractSymbolics' _ = mempty
+
+instance (ExtractSymbolics c) => ExtractSymbolics' (K1 i c) where
+  extractSymbolics' = extractSymbolics . unK1
+
+instance (ExtractSymbolics' a) => ExtractSymbolics' (M1 i c a) where
+  extractSymbolics' = extractSymbolics' . unM1
+
+instance
+  (ExtractSymbolics' a, ExtractSymbolics' b) =>
+  ExtractSymbolics' (a :+: b)
+  where
+  extractSymbolics' (L1 l) = extractSymbolics' l
+  extractSymbolics' (R1 r) = extractSymbolics' r
+
+instance
+  (ExtractSymbolics' a, ExtractSymbolics' b) =>
+  ExtractSymbolics' (a :*: b)
+  where
+  extractSymbolics' (l :*: r) = extractSymbolics' l <> extractSymbolics' r
diff --git a/src/Grisette/Core/Data/Class/Function.hs b/src/Grisette/Core/Data/Class/Function.hs
--- a/src/Grisette/Core/Data/Class/Function.hs
+++ b/src/Grisette/Core/Data/Class/Function.hs
@@ -12,9 +12,21 @@
 module Grisette.Core.Data.Class.Function
   ( -- * Function operations
     Function (..),
+    Apply (..),
   )
 where
 
+-- $setup
+-- >>> import Grisette.Core
+-- >>> import Grisette.IR.SymPrim
+-- >>> :set -XDataKinds
+-- >>> :set -XBinaryLiterals
+-- >>> :set -XFlexibleContexts
+-- >>> :set -XFlexibleInstances
+-- >>> :set -XFunctionalDependencies
+-- >>> :set -XOverloadedStrings
+-- >>> :set -XTypeOperators
+
 -- | Abstraction for function-like types.
 class Function f where
   -- | Argument type
@@ -41,3 +53,20 @@
   type Arg (a -> b) = a
   type Ret (a -> b) = b
   f # a = f a
+
+-- | Applying an uninterpreted function.
+--
+-- >>> let f = "f" :: SymInteger =~> SymInteger =~> SymInteger
+-- >>> apply f "a" "b"
+-- (apply (apply f a) b)
+--
+-- Note that for implementation reasons, you can also use `apply` function on
+-- a non-function symbolic value. In this case, the function is treated as an
+-- `id` function.
+class Apply uf where
+  type FunType uf
+  apply :: uf -> FunType uf
+
+instance (Apply b) => Apply (a -> b) where
+  type FunType (a -> b) = a -> FunType b
+  apply f a = apply (f a)
diff --git a/src/Grisette/Core/Data/Class/GPretty.hs b/src/Grisette/Core/Data/Class/GPretty.hs
--- a/src/Grisette/Core/Data/Class/GPretty.hs
+++ b/src/Grisette/Core/Data/Class/GPretty.hs
@@ -27,6 +27,7 @@
 import qualified Control.Monad.Writer.Lazy as WriterLazy
 import qualified Control.Monad.Writer.Strict as WriterStrict
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as C
 import Data.Functor.Sum (Sum)
 import Data.Int (Int16, Int32, Int64, Int8)
 import Data.String (IsString (fromString))
@@ -51,6 +52,21 @@
 import GHC.TypeLits (KnownNat, type (<=))
 import Generics.Deriving (Default (Default, unDefault))
 import Grisette.Core.Data.BV (IntN, SomeIntN, SomeWordN, WordN)
+import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
+  ( LinkedRep,
+    SupportedPrim,
+    prettyPrintTerm,
+  )
+import Grisette.IR.SymPrim.Data.SymPrim
+  ( SomeSymIntN (SomeSymIntN),
+    SomeSymWordN (SomeSymWordN),
+    SymBool (SymBool),
+    SymIntN (SymIntN),
+    SymInteger (SymInteger),
+    SymWordN (SymWordN),
+    type (-~>) (SymGeneralFun),
+    type (=~>) (SymTabularFun),
+  )
 
 #if MIN_VERSION_prettyprinter(1,7,0)
 import Prettyprinter
@@ -99,116 +115,6 @@
 
   {-# MINIMAL gpretty | gprettyPrec #-}
 
-instance (Generic a, GPretty' (Rep a)) => GPretty (Default a) where
-  gprettyPrec i v = gprettyPrec' Pref i $ from $ unDefault v
-
-data Type = Rec | Tup | Pref | Inf String Int
-
-class GPretty' a where
-  gprettyPrec' :: Type -> Int -> a c -> Doc ann
-  isNullary :: a c -> Bool
-  isNullary = error "generic gpretty (isNullary): unnecessary case"
-
-instance GPretty' V1 where
-  gprettyPrec' _ _ x = case x of {}
-
-instance GPretty' U1 where
-  gprettyPrec' _ _ U1 = ""
-  isNullary _ = True
-
-instance (GPretty c) => GPretty' (K1 i c) where
-  gprettyPrec' _ n (K1 a) = gprettyPrec n a
-  isNullary _ = False
-
-groupedEnclose :: Doc ann -> Doc ann -> Doc ann -> Doc ann
-groupedEnclose l r d = group $ align $ vcat [l <> flatAlt " " "" <> d, r]
-
-condEnclose :: Bool -> Doc ann -> Doc ann -> Doc ann -> Doc ann
-condEnclose b = if b then groupedEnclose else const $ const id
-
-instance (GPretty' a, Constructor c) => GPretty' (M1 C c a) where
-  gprettyPrec' _ n c@(M1 x) =
-    case t of
-      Tup ->
-        prettyBraces t (gprettyPrec' t 0 x)
-      Inf _ m ->
-        group $ condEnclose (n > m) "(" ")" $ gprettyPrec' t m x
-      _ ->
-        if isNullary x
-          then pretty (conName c)
-          else
-            group $
-              condEnclose (n > 10) "(" ")" $
-                align $
-                  nest 2 $
-                    vsep
-                      [ pretty (conName c),
-                        prettyBraces t (gprettyPrec' t 11 x)
-                      ]
-    where
-      prettyBraces :: Type -> Doc ann -> Doc ann
-      prettyBraces Rec = groupedEnclose "{" "}"
-      prettyBraces Tup = groupedEnclose "(" ")"
-      prettyBraces Pref = id
-      prettyBraces (Inf _ _) = id
-      fixity = conFixity c
-      t
-        | conIsRecord c = Rec
-        | conIsTuple c = Tup
-        | otherwise = case fixity of
-            Prefix -> Pref
-            Infix _ i -> Inf (conName c) i
-      conIsTuple :: C1 c f p -> Bool
-      conIsTuple y = tupleName (conName y)
-        where
-          tupleName ('(' : ',' : _) = True
-          tupleName _ = False
-
-instance (Selector s, GPretty' a) => GPretty' (M1 S s a) where
-  gprettyPrec' t n s@(M1 x)
-    | selName s == "" =
-        case t of
-          Pref -> gprettyPrec' t (n + 1) x
-          _ -> gprettyPrec' t (n + 1) x
-    | otherwise =
-        pretty (selName s) <+> "=" <+> gprettyPrec' t 0 x
-  isNullary (M1 x) = isNullary x
-
-instance (GPretty' a) => GPretty' (M1 D d a) where
-  gprettyPrec' t n (M1 x) = gprettyPrec' t n x
-
-instance (GPretty' a, GPretty' b) => GPretty' (a :+: b) where
-  gprettyPrec' t n (L1 x) = gprettyPrec' t n x
-  gprettyPrec' t n (R1 x) = gprettyPrec' t n x
-
-instance (GPretty' a, GPretty' b) => GPretty' (a :*: b) where
-  gprettyPrec' t@Rec n (a :*: b) =
-    vcat
-      [ gprettyPrec' t n a,
-        "," <+> gprettyPrec' t n b
-      ]
-  gprettyPrec' t@(Inf s _) n (a :*: b) =
-    align $
-      nest 2 $
-        vsep
-          [ gprettyPrec' t n a,
-            pretty s <+> gprettyPrec' t n b
-          ]
-  gprettyPrec' t@Tup _ (a :*: b) =
-    vcat
-      [ gprettyPrec' t 0 a,
-        "," <> flatAlt " " "" <> gprettyPrec' t 0 b
-      ]
-  gprettyPrec' t@Pref n (a :*: b) =
-    vsep
-      [ gprettyPrec' t (n + 1) a,
-        gprettyPrec' t (n + 1) b
-      ]
-  isNullary _ = False
-
-viaShowsPrec :: (Int -> a -> ShowS) -> Int -> a -> Doc ann
-viaShowsPrec f n a = pretty (f n a "")
-
 #define GPRETTY_SIMPLE(type) \
 instance GPretty type where gprettyPrec = viaShowsPrec showsPrec
 
@@ -231,10 +137,14 @@
 GPRETTY_SIMPLE(Word64)
 GPRETTY_SIMPLE(SomeIntN)
 GPRETTY_SIMPLE(SomeWordN)
-GPRETTY_SIMPLE(B.ByteString)
-GPRETTY_SIMPLE(T.Text)
 #endif
 
+instance GPretty B.ByteString where
+  gpretty = pretty . C.unpack
+
+instance GPretty T.Text where
+  gpretty = pretty
+
 instance (KnownNat n, 1 <= n) => GPretty (IntN n) where
   gpretty = viaShow
 
@@ -415,3 +325,142 @@
           [ "IdentityT",
             gprettyPrec 11 a
           ]
+
+-- Prettyprint
+#define GPRETTY_SYM_SIMPLE(symtype) \
+instance GPretty symtype where \
+  gpretty (symtype t) = prettyPrintTerm t
+
+#define GPRETTY_SYM_BV(symtype) \
+instance (KnownNat n, 1 <= n) => GPretty (symtype n) where \
+  gpretty (symtype t) = prettyPrintTerm t
+
+#define GPRETTY_SYM_FUN(op, cons) \
+instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb)\
+  => GPretty (sa op sb) where \
+  gpretty (cons t) = prettyPrintTerm t
+
+#define GPRETTY_SYM_SOME_BV(symtype) \
+instance GPretty symtype where \
+  gpretty (symtype t) = gpretty t
+
+#if 1
+GPRETTY_SYM_SIMPLE(SymBool)
+GPRETTY_SYM_SIMPLE(SymInteger)
+GPRETTY_SYM_BV(SymIntN)
+GPRETTY_SYM_BV(SymWordN)
+GPRETTY_SYM_FUN(=~>, SymTabularFun)
+GPRETTY_SYM_FUN(-~>, SymGeneralFun)
+GPRETTY_SYM_SOME_BV(SomeSymIntN)
+GPRETTY_SYM_SOME_BV(SomeSymWordN)
+#endif
+
+instance (Generic a, GPretty' (Rep a)) => GPretty (Default a) where
+  gprettyPrec i v = gprettyPrec' Pref i $ from $ unDefault v
+
+data Type = Rec | Tup | Pref | Inf String Int
+
+class GPretty' a where
+  gprettyPrec' :: Type -> Int -> a c -> Doc ann
+  isNullary :: a c -> Bool
+  isNullary = error "generic gpretty (isNullary): unnecessary case"
+
+instance GPretty' V1 where
+  gprettyPrec' _ _ x = case x of {}
+
+instance GPretty' U1 where
+  gprettyPrec' _ _ U1 = ""
+  isNullary _ = True
+
+instance (GPretty c) => GPretty' (K1 i c) where
+  gprettyPrec' _ n (K1 a) = gprettyPrec n a
+  isNullary _ = False
+
+groupedEnclose :: Doc ann -> Doc ann -> Doc ann -> Doc ann
+groupedEnclose l r d = group $ align $ vcat [l <> flatAlt " " "" <> d, r]
+
+condEnclose :: Bool -> Doc ann -> Doc ann -> Doc ann -> Doc ann
+condEnclose b = if b then groupedEnclose else const $ const id
+
+instance (GPretty' a, Constructor c) => GPretty' (M1 C c a) where
+  gprettyPrec' _ n c@(M1 x) =
+    case t of
+      Tup ->
+        prettyBraces t (gprettyPrec' t 0 x)
+      Inf _ m ->
+        group $ condEnclose (n > m) "(" ")" $ gprettyPrec' t m x
+      _ ->
+        if isNullary x
+          then pretty (conName c)
+          else
+            group $
+              condEnclose (n > 10) "(" ")" $
+                align $
+                  nest 2 $
+                    vsep
+                      [ pretty (conName c),
+                        prettyBraces t (gprettyPrec' t 11 x)
+                      ]
+    where
+      prettyBraces :: Type -> Doc ann -> Doc ann
+      prettyBraces Rec = groupedEnclose "{" "}"
+      prettyBraces Tup = groupedEnclose "(" ")"
+      prettyBraces Pref = id
+      prettyBraces (Inf _ _) = id
+      fixity = conFixity c
+      t
+        | conIsRecord c = Rec
+        | conIsTuple c = Tup
+        | otherwise = case fixity of
+            Prefix -> Pref
+            Infix _ i -> Inf (conName c) i
+      conIsTuple :: C1 c f p -> Bool
+      conIsTuple y = tupleName (conName y)
+        where
+          tupleName ('(' : ',' : _) = True
+          tupleName _ = False
+
+instance (Selector s, GPretty' a) => GPretty' (M1 S s a) where
+  gprettyPrec' t n s@(M1 x)
+    | selName s == "" =
+        case t of
+          Pref -> gprettyPrec' t (n + 1) x
+          _ -> gprettyPrec' t (n + 1) x
+    | otherwise =
+        pretty (selName s) <+> "=" <+> gprettyPrec' t 0 x
+  isNullary (M1 x) = isNullary x
+
+instance (GPretty' a) => GPretty' (M1 D d a) where
+  gprettyPrec' t n (M1 x) = gprettyPrec' t n x
+
+instance (GPretty' a, GPretty' b) => GPretty' (a :+: b) where
+  gprettyPrec' t n (L1 x) = gprettyPrec' t n x
+  gprettyPrec' t n (R1 x) = gprettyPrec' t n x
+
+instance (GPretty' a, GPretty' b) => GPretty' (a :*: b) where
+  gprettyPrec' t@Rec n (a :*: b) =
+    vcat
+      [ gprettyPrec' t n a,
+        "," <+> gprettyPrec' t n b
+      ]
+  gprettyPrec' t@(Inf s _) n (a :*: b) =
+    align $
+      nest 2 $
+        vsep
+          [ gprettyPrec' t n a,
+            pretty s <+> gprettyPrec' t n b
+          ]
+  gprettyPrec' t@Tup _ (a :*: b) =
+    vcat
+      [ gprettyPrec' t 0 a,
+        "," <> flatAlt " " "" <> gprettyPrec' t 0 b
+      ]
+  gprettyPrec' t@Pref n (a :*: b) =
+    vsep
+      [ gprettyPrec' t (n + 1) a,
+        gprettyPrec' t (n + 1) b
+      ]
+  isNullary _ = False
+
+viaShowsPrec :: (Int -> a -> ShowS) -> Int -> a -> Doc ann
+viaShowsPrec f n a = pretty (f n a "")
diff --git a/src/Grisette/Core/Data/Class/GenSym.hs b/src/Grisette/Core/Data/Class/GenSym.hs
--- a/src/Grisette/Core/Data/Class/GenSym.hs
+++ b/src/Grisette/Core/Data/Class/GenSym.hs
@@ -36,10 +36,13 @@
 
     -- * Monad for fresh symbolic value generation
     MonadFresh (..),
-    FreshT,
+    nextFreshIndex,
+    liftFresh,
+    FreshT (FreshT, runFreshTFromIndex),
     Fresh,
     runFreshT,
     runFresh,
+    mrgRunFreshT,
 
     -- * Symbolic value generation
     GenSym (..),
@@ -82,7 +85,7 @@
   )
 import qualified Control.Monad.RWS.Lazy as RWSLazy
 import qualified Control.Monad.RWS.Strict as RWSStrict
-import Control.Monad.Reader (ReaderT (ReaderT))
+import Control.Monad.Reader (ReaderT)
 import Control.Monad.Signatures (Catch)
 import qualified Control.Monad.State.Lazy as StateLazy
 import qualified Control.Monad.State.Strict as StateStrict
@@ -115,7 +118,7 @@
     type (:*:) ((:*:)),
     type (:+:) (L1, R1),
   )
-import {-# SOURCE #-} Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Control.Monad.UnionM (UnionM, isMerged, underlyingUnion)
 import Grisette.Core.Data.BV (IntN, SomeIntN, SomeWordN, WordN)
 import Grisette.Core.Data.Class.Mergeable
   ( Mergeable (rootStrategy),
@@ -136,11 +139,12 @@
 import Grisette.Core.Data.Class.Solvable
   ( Solvable (iinfosym, isym),
   )
+import Grisette.Core.Data.Union (Union (UnionIf, UnionSingle))
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
   ( LinkedRep,
     SupportedPrim,
   )
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim
+import Grisette.IR.SymPrim.Data.SymPrim
   ( SomeSymIntN (SomeSymIntN),
     SomeSymWordN (SomeSymWordN),
     SymBool,
@@ -213,15 +217,15 @@
 --     >>> nameWithInfo "a" (1 :: Int)
 --     a:1
 data FreshIdent where
-  FreshIdent :: String -> FreshIdent
-  FreshIdentWithInfo :: (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => String -> a -> FreshIdent
+  FreshIdent :: T.Text -> FreshIdent
+  FreshIdentWithInfo :: (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => T.Text -> a -> FreshIdent
 
 instance Show FreshIdent where
-  show (FreshIdent i) = i
-  show (FreshIdentWithInfo s i) = s ++ ":" ++ show i
+  show (FreshIdent i) = T.unpack i
+  show (FreshIdentWithInfo s i) = T.unpack s ++ ":" ++ show i
 
 instance IsString FreshIdent where
-  fromString = name
+  fromString = name . T.pack
 
 instance Eq FreshIdent where
   FreshIdent l == FreshIdent r = l == r
@@ -260,7 +264,7 @@
 --
 -- The user may need to use unique names to avoid unintentional identifier
 -- collision.
-name :: String -> FreshIdent
+name :: T.Text -> FreshIdent
 name = FreshIdent
 
 -- | Identifier with extra information.
@@ -269,7 +273,7 @@
 --
 -- The user may need to use unique names or additional information to avoid
 -- unintentional identifier collision.
-nameWithInfo :: forall a. (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => String -> a -> FreshIdent
+nameWithInfo :: forall a. (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => T.Text -> a -> FreshIdent
 nameWithInfo = FreshIdentWithInfo
 
 -- | Monad class for fresh symbolic value generation.
@@ -277,32 +281,54 @@
 -- The monad should be a reader monad for the 'FreshIdent' and a state monad for
 -- the 'FreshIndex'.
 class (Monad m) => MonadFresh m where
-  -- | Increase the index by one and return the new index.
-  nextFreshIndex :: m FreshIndex
+  -- | Get the current index for fresh variable generation.
+  getFreshIndex :: m FreshIndex
 
+  -- | Set the current index for fresh variable generation.
+  setFreshIndex :: FreshIndex -> m ()
+
   -- | Get the identifier.
   getFreshIdent :: m FreshIdent
 
+-- | Get the next fresh index and increase the current index.
+nextFreshIndex :: (MonadFresh m) => m FreshIndex
+nextFreshIndex = do
+  curr <- getFreshIndex
+  let new = curr + 1
+  setFreshIndex new
+  return curr
+
+-- | Lifts an @`Fresh` a@ into any `MonadFresh`.
+liftFresh :: (MonadFresh m) => Fresh a -> m a
+liftFresh (FreshT f) = do
+  index <- nextFreshIndex
+  ident <- getFreshIdent
+  let (a, newIdx) = runIdentity $ f ident index
+  setFreshIndex newIdx
+  return a
+
 -- | A symbolic generation monad transformer.
 -- It is a reader monad transformer for identifiers and
 -- a state monad transformer for indices.
 --
 -- Each time a fresh symbolic variable is generated, the index should be increased.
-newtype FreshT m a = FreshT {runFreshT' :: FreshIdent -> FreshIndex -> m (a, FreshIndex)}
+newtype FreshT m a = FreshT
+  { runFreshTFromIndex :: FreshIdent -> FreshIndex -> m (a, FreshIndex)
+  }
 
 instance
   (Mergeable a, Mergeable1 m) =>
   Mergeable (FreshT m a)
   where
   rootStrategy =
-    wrapStrategy (liftRootStrategy (liftRootStrategy rootStrategy1)) FreshT runFreshT'
+    wrapStrategy (liftRootStrategy (liftRootStrategy rootStrategy1)) FreshT runFreshTFromIndex
 
 instance (Mergeable1 m) => Mergeable1 (FreshT m) where
   liftRootStrategy m =
     wrapStrategy
       (liftRootStrategy (liftRootStrategy (liftRootStrategy (liftRootStrategy2 m rootStrategy))))
       FreshT
-      runFreshT'
+      runFreshTFromIndex
 
 instance
   (UnionLike m, Mergeable a) =>
@@ -330,8 +356,15 @@
 
 -- | Run the symbolic generation with the given identifier and 0 as the initial index.
 runFreshT :: (Monad m) => FreshT m a -> FreshIdent -> m a
-runFreshT m ident = fst <$> runFreshT' m ident (FreshIndex 0)
+runFreshT m ident = fst <$> runFreshTFromIndex m ident (FreshIndex 0)
 
+mrgRunFreshT ::
+  (Monad m, UnionLike m, Mergeable a) =>
+  FreshT m a ->
+  FreshIdent ->
+  m a
+mrgRunFreshT m ident = merge $ runFreshT m ident
+
 instance (Functor f) => Functor (FreshT f) where
   fmap f (FreshT s) = FreshT $ \ident idx -> first f <$> s ident idx
 
@@ -345,14 +378,14 @@
 instance (Monad m) => Monad (FreshT m) where
   (FreshT s) >>= f = FreshT $ \ident idx -> do
     (a, idx') <- s ident idx
-    runFreshT' (f a) ident idx'
+    runFreshTFromIndex (f a) ident idx'
 
 instance MonadTrans FreshT where
   lift x = FreshT $ \_ index -> (,index) <$> x
 
 liftFreshTCache :: (Functor m) => Catch e m (a, FreshIndex) -> Catch e (FreshT m) a
 liftFreshTCache catchE (FreshT m) h =
-  FreshT $ \ident index -> m ident index `catchE` \e -> runFreshT' (h e) ident index
+  FreshT $ \ident index -> m ident index `catchE` \e -> runFreshTFromIndex (h e) ident index
 
 instance (MonadError e m) => MonadError e (FreshT m) where
   throwError = lift . throwError
@@ -374,36 +407,44 @@
 instance (MonadRWS r w s m) => MonadRWS r w s (FreshT m)
 
 instance (MonadFresh m) => MonadFresh (ExceptT e m) where
-  nextFreshIndex = ExceptT $ Right <$> nextFreshIndex
-  getFreshIdent = ExceptT $ Right <$> getFreshIdent
+  getFreshIndex = lift getFreshIndex
+  setFreshIndex newIdx = lift $ setFreshIndex newIdx
+  getFreshIdent = lift getFreshIdent
 
 instance (MonadFresh m, Monoid w) => MonadFresh (WriterLazy.WriterT w m) where
-  nextFreshIndex = WriterLazy.WriterT $ (,mempty) <$> nextFreshIndex
-  getFreshIdent = WriterLazy.WriterT $ (,mempty) <$> getFreshIdent
+  getFreshIndex = lift getFreshIndex
+  setFreshIndex newIdx = lift $ setFreshIndex newIdx
+  getFreshIdent = lift getFreshIdent
 
 instance (MonadFresh m, Monoid w) => MonadFresh (WriterStrict.WriterT w m) where
-  nextFreshIndex = WriterStrict.WriterT $ (,mempty) <$> nextFreshIndex
-  getFreshIdent = WriterStrict.WriterT $ (,mempty) <$> getFreshIdent
+  getFreshIndex = lift getFreshIndex
+  setFreshIndex newIdx = lift $ setFreshIndex newIdx
+  getFreshIdent = lift getFreshIdent
 
 instance (MonadFresh m) => MonadFresh (StateLazy.StateT s m) where
-  nextFreshIndex = StateLazy.StateT $ \s -> (,s) <$> nextFreshIndex
-  getFreshIdent = StateLazy.StateT $ \s -> (,s) <$> getFreshIdent
+  getFreshIndex = lift getFreshIndex
+  setFreshIndex newIdx = lift $ setFreshIndex newIdx
+  getFreshIdent = lift getFreshIdent
 
 instance (MonadFresh m) => MonadFresh (StateStrict.StateT s m) where
-  nextFreshIndex = StateStrict.StateT $ \s -> (,s) <$> nextFreshIndex
-  getFreshIdent = StateStrict.StateT $ \s -> (,s) <$> getFreshIdent
+  getFreshIndex = lift getFreshIndex
+  setFreshIndex newIdx = lift $ setFreshIndex newIdx
+  getFreshIdent = lift getFreshIdent
 
 instance (MonadFresh m) => MonadFresh (ReaderT r m) where
-  nextFreshIndex = ReaderT $ const nextFreshIndex
-  getFreshIdent = ReaderT $ const getFreshIdent
+  getFreshIndex = lift getFreshIndex
+  setFreshIndex newIdx = lift $ setFreshIndex newIdx
+  getFreshIdent = lift getFreshIdent
 
 instance (MonadFresh m, Monoid w) => MonadFresh (RWSLazy.RWST r w s m) where
-  nextFreshIndex = RWSLazy.RWST $ \_ s -> (,s,mempty) <$> nextFreshIndex
-  getFreshIdent = RWSLazy.RWST $ \_ s -> (,s,mempty) <$> getFreshIdent
+  getFreshIndex = lift getFreshIndex
+  setFreshIndex newIdx = lift $ setFreshIndex newIdx
+  getFreshIdent = lift getFreshIdent
 
 instance (MonadFresh m, Monoid w) => MonadFresh (RWSStrict.RWST r w s m) where
-  nextFreshIndex = RWSStrict.RWST $ \_ s -> (,s,mempty) <$> nextFreshIndex
-  getFreshIdent = RWSStrict.RWST $ \_ s -> (,s,mempty) <$> getFreshIdent
+  getFreshIndex = lift getFreshIndex
+  setFreshIndex newIdx = lift $ setFreshIndex newIdx
+  getFreshIdent = lift getFreshIdent
 
 -- | 'FreshT' specialized with Identity.
 type Fresh = FreshT Identity
@@ -413,7 +454,8 @@
 runFresh m ident = runIdentity $ runFreshT m ident
 
 instance (Monad m) => MonadFresh (FreshT m) where
-  nextFreshIndex = FreshT $ \_ idx -> return (idx, idx + 1)
+  getFreshIndex = FreshT $ \_ idx -> return (idx, idx)
+  setFreshIndex newIdx = FreshT $ \_ _ -> return ((), newIdx)
   getFreshIdent = FreshT $ curry return
 
 -- | Class of types in which symbolic values can be generated with respect to some specification.
@@ -445,7 +487,7 @@
   -- is ensured. No specification is needed.
   --
   -- >>> runFresh (fresh ()) "a" :: UnionM (Maybe Bool)
-  -- {If a@1 Nothing (If a@0 (Just False) (Just True))}
+  -- {If a@0 Nothing (If a@1 (Just False) (Just True))}
   --
   -- The following example generates lists of symbolic booleans with length 1 to 2.
   --
@@ -906,6 +948,7 @@
 
 -- Maybe
 instance
+  {-# OVERLAPPING #-}
   (GenSym aspec a, Mergeable a) =>
   GenSym (Maybe aspec) (Maybe a)
   where
@@ -919,10 +962,15 @@
   simpleFresh Nothing = return Nothing
   simpleFresh (Just aspec) = Just <$> simpleFresh aspec
 
-instance (GenSym aspec a, Mergeable a) => GenSym aspec (Maybe a) where
+instance
+  {-# OVERLAPPABLE #-}
+  (GenSym aspec a, Mergeable a) =>
+  GenSym aspec (Maybe a)
+  where
   fresh aspec = do
+    cond <- simpleFresh ()
     a :: UnionM a <- fresh aspec
-    chooseUnionFresh [return Nothing, Just <$> a]
+    return $ mrgIf cond (mrgSingle Nothing) (Just <$> a)
 
 -- List
 instance
@@ -1749,3 +1797,19 @@
 GENSYM_UNIT_FUN(-~>)
 GENSYM_UNIT_SIMPLE_FUN(-~>)
 #endif
+
+instance (GenSym spec a, Mergeable a) => GenSym spec (UnionM a)
+
+instance (GenSym spec a) => GenSymSimple spec (UnionM a) where
+  simpleFresh spec = do
+    res <- fresh spec
+    if not (isMerged res) then error "Not merged" else return res
+
+instance
+  (GenSym a a, Mergeable a) =>
+  GenSym (UnionM a) a
+  where
+  fresh spec = go (underlyingUnion $ merge spec)
+    where
+      go (UnionSingle x) = fresh x
+      go (UnionIf _ _ _ t f) = mrgIf <$> simpleFresh () <*> go t <*> go f
diff --git a/src/Grisette/Core/Data/Class/ITEOp.hs b/src/Grisette/Core/Data/Class/ITEOp.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Core/Data/Class/ITEOp.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- |
+-- Module      :   Grisette.Core.Data.Class.ITEOp
+-- Copyright   :   (c) Sirui Lu 2021-2023
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Core.Data.Class.ITEOp
+  ( ITEOp (..),
+  )
+where
+
+import GHC.TypeNats (KnownNat, type (<=))
+import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
+  ( LinkedRep,
+    SupportedPrim,
+  )
+import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bool (pevalITETerm)
+import Grisette.IR.SymPrim.Data.SymPrim
+  ( SomeSymIntN,
+    SomeSymWordN,
+    SymBool (SymBool),
+    SymIntN (SymIntN),
+    SymInteger (SymInteger),
+    SymWordN (SymWordN),
+    binSomeSymIntNR1,
+    binSomeSymWordNR1,
+    type (-~>) (SymGeneralFun),
+    type (=~>) (SymTabularFun),
+  )
+
+-- $setup
+-- >>> import Grisette.Core
+-- >>> import Grisette.IR.SymPrim
+-- >>> :set -XDataKinds
+-- >>> :set -XBinaryLiterals
+-- >>> :set -XFlexibleContexts
+-- >>> :set -XFlexibleInstances
+-- >>> :set -XFunctionalDependencies
+
+-- | ITE operator for solvable (see "Grisette.Core#solvable")s, including symbolic boolean, integer, etc.
+--
+-- >>> let a = "a" :: SymBool
+-- >>> let b = "b" :: SymBool
+-- >>> let c = "c" :: SymBool
+-- >>> symIte a b c
+-- (ite a b c)
+class ITEOp v where
+  symIte :: SymBool -> v -> v -> v
+
+-- ITEOp instances
+#define ITEOP_SIMPLE(type) \
+instance ITEOp type where \
+  symIte (SymBool c) (type t) (type f) = type $ pevalITETerm c t f; \
+  {-# INLINE symIte #-}
+
+#define ITEOP_BV(type) \
+instance (KnownNat n, 1 <= n) => ITEOp (type n) where \
+  symIte (SymBool c) (type t) (type f) = type $ pevalITETerm c t f; \
+  {-# INLINE symIte #-}
+
+#define ITEOP_BV_SOME(symtype, bf) \
+instance ITEOp symtype where \
+  symIte c = bf (symIte c) "symIte"; \
+  {-# INLINE symIte #-}
+
+#define ITEOP_FUN(op, cons) \
+instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => ITEOp (sa op sb) where \
+  symIte (SymBool c) (cons t) (cons f) = cons $ pevalITETerm c t f; \
+  {-# INLINE symIte #-}
+
+#if 1
+ITEOP_SIMPLE(SymBool)
+ITEOP_SIMPLE(SymInteger)
+ITEOP_BV(SymIntN)
+ITEOP_BV(SymWordN)
+ITEOP_BV_SOME(SomeSymIntN, binSomeSymIntNR1)
+ITEOP_BV_SOME(SomeSymWordN, binSomeSymWordNR1)
+ITEOP_FUN(=~>, SymTabularFun)
+ITEOP_FUN(-~>, SymGeneralFun)
+#endif
diff --git a/src/Grisette/Core/Data/Class/LogicalOp.hs b/src/Grisette/Core/Data/Class/LogicalOp.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Core/Data/Class/LogicalOp.hs
@@ -0,0 +1,106 @@
+module Grisette.Core.Data.Class.LogicalOp
+  ( LogicalOp (..),
+  )
+where
+
+import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bool
+  ( pevalAndTerm,
+    pevalImplyTerm,
+    pevalNotTerm,
+    pevalOrTerm,
+    pevalXorTerm,
+  )
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool (SymBool))
+
+-- $setup
+-- >>> import Grisette.Core
+-- >>> import Grisette.IR.SymPrim
+-- >>> :set -XDataKinds
+-- >>> :set -XBinaryLiterals
+-- >>> :set -XFlexibleContexts
+-- >>> :set -XFlexibleInstances
+-- >>> :set -XFunctionalDependencies
+
+-- | Symbolic logical operators for symbolic booleans.
+--
+-- >>> let t = con True :: SymBool
+-- >>> let f = con False :: SymBool
+-- >>> let a = "a" :: SymBool
+-- >>> let b = "b" :: SymBool
+-- >>> t .|| f
+-- true
+-- >>> a .|| t
+-- true
+-- >>> a .|| f
+-- a
+-- >>> a .|| b
+-- (|| a b)
+-- >>> t .&& f
+-- false
+-- >>> a .&& t
+-- a
+-- >>> a .&& f
+-- false
+-- >>> a .&& b
+-- (&& a b)
+-- >>> symNot t
+-- false
+-- >>> symNot f
+-- true
+-- >>> symNot a
+-- (! a)
+-- >>> t `symXor` f
+-- true
+-- >>> t `symXor` t
+-- false
+-- >>> a `symXor` t
+-- (! a)
+-- >>> a `symXor` f
+-- a
+-- >>> a `symXor` b
+-- (|| (&& (! a) b) (&& a (! b)))
+class LogicalOp b where
+  -- | Symbolic disjunction
+  (.||) :: b -> b -> b
+  a .|| b = symNot $ symNot a .&& symNot b
+  {-# INLINE (.||) #-}
+
+  infixr 2 .||
+
+  -- | Symbolic conjunction
+  (.&&) :: b -> b -> b
+  a .&& b = symNot $ symNot a .|| symNot b
+  {-# INLINE (.&&) #-}
+
+  infixr 3 .&&
+
+  -- | Symbolic negation
+  symNot :: b -> b
+
+  -- | Symbolic exclusive disjunction
+  symXor :: b -> b -> b
+  a `symXor` b = (a .&& symNot b) .|| (symNot a .&& b)
+  {-# INLINE symXor #-}
+
+  -- | Symbolic implication
+  symImplies :: b -> b -> b
+  a `symImplies` b = symNot a .|| b
+  {-# INLINE symImplies #-}
+
+  {-# MINIMAL (.||), symNot | (.&&), symNot #-}
+
+-- LogicalOp instances
+instance LogicalOp Bool where
+  (.||) = (||)
+  {-# INLINE (.||) #-}
+  (.&&) = (&&)
+  {-# INLINE (.&&) #-}
+  symNot = not
+  {-# INLINE symNot #-}
+
+instance LogicalOp SymBool where
+  (SymBool l) .|| (SymBool r) = SymBool $ pevalOrTerm l r
+  (SymBool l) .&& (SymBool r) = SymBool $ pevalAndTerm l r
+  symNot (SymBool v) = SymBool $ pevalNotTerm v
+  (SymBool l) `symXor` (SymBool r) = SymBool $ pevalXorTerm l r
+  (SymBool l) `symImplies` (SymBool r) = SymBool $ pevalImplyTerm l r
diff --git a/src/Grisette/Core/Data/Class/Mergeable.hs b/src/Grisette/Core/Data/Class/Mergeable.hs
--- a/src/Grisette/Core/Data/Class/Mergeable.hs
+++ b/src/Grisette/Core/Data/Class/Mergeable.hs
@@ -111,6 +111,7 @@
     type (:*:) ((:*:)),
     type (:+:) (L1, R1),
   )
+import Grisette.Core.Control.Exception (AssertionError, VerificationConditions)
 import Grisette.Core.Data.BV
   ( BitwidthMismatch,
     IntN (IntN),
@@ -118,12 +119,12 @@
     SomeWordN (SomeWordN),
     WordN (WordN),
   )
-import Grisette.Core.Data.Class.Bool (ITEOp (ites))
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
   ( LinkedRep,
     SupportedPrim,
   )
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim
+import Grisette.IR.SymPrim.Data.SymPrim
   ( SomeSymIntN (SomeSymIntN),
     SomeSymWordN (SomeSymWordN),
     SymBool,
@@ -193,13 +194,13 @@
 -- The 'SimpleStrategy' merges values with a simple merge function.
 -- For example,
 --
---    * the symbolic boolean values can be directly merged with 'ites'.
+--    * the symbolic boolean values can be directly merged with 'symIte'.
 --
 --    * the set @{1}@, which is a subset of the values of the type @Integer@,
 --        can be simply merged as the set contains only a single value.
 --
 --    * all the 'Just' values of the type @Maybe SymBool@ can be simply merged
---        by merging the wrapped symbolic boolean with 'ites'.
+--        by merging the wrapped symbolic boolean with 'symIte'.
 --
 -- The 'SortedStrategy' merges values by first grouping the values with an
 -- indexing function, and the values with the same index will be organized as
@@ -242,7 +243,7 @@
   --
   -- For symbolic booleans, we can implement its merge strategy as follows:
   --
-  -- > SimpleStrategy ites :: MergingStrategy SymBool
+  -- > SimpleStrategy symIte :: MergingStrategy SymBool
   SimpleStrategy ::
     -- | Merge function.
     (SymBool -> a -> a -> a) ->
@@ -260,7 +261,7 @@
   -- >   (\idx ->
   -- >      if idx
   -- >        then SimpleStrategy $ \_ t _ -> t
-  -- >        else SimpleStrategy $ \cond (Just l) (Just r) -> Just $ ites cond l r)
+  -- >        else SimpleStrategy $ \cond (Just l) (Just r) -> Just $ symIte cond l r)
   SortedStrategy ::
     (Ord idx, Typeable idx, Show idx) =>
     -- | Indexing function
@@ -315,20 +316,6 @@
   -- | The root merging strategy for the type.
   rootStrategy :: MergingStrategy a
 
-instance (Generic a, Mergeable' (Rep a)) => Mergeable (Default a) where
-  rootStrategy = unsafeCoerce (derivedRootStrategy :: MergingStrategy a)
-  {-# NOINLINE rootStrategy #-}
-
--- | Generic derivation for the 'Mergeable' class.
---
--- Usually you can derive the merging strategy with the @DerivingVia@ and
--- @DerivingStrategies@ extension.
---
--- > data X = ... deriving (Generic) deriving Mergeable via (Default X)
-derivedRootStrategy :: (Generic a, Mergeable' (Rep a)) => MergingStrategy a
-derivedRootStrategy = wrapStrategy rootStrategy' to from
-{-# INLINE derivedRootStrategy #-}
-
 -- | Lifting of the 'Mergeable' class to unary type constructors.
 class Mergeable1 (u :: Type -> Type) where
   -- | Lift merge strategy through the type constructor.
@@ -359,94 +346,6 @@
 rootStrategy3 = liftRootStrategy3 rootStrategy rootStrategy rootStrategy
 {-# INLINE rootStrategy3 #-}
 
-instance (Generic1 u, Mergeable1' (Rep1 u)) => Mergeable1 (Default1 u) where
-  liftRootStrategy = unsafeCoerce (derivedLiftMergingStrategy :: MergingStrategy a -> MergingStrategy (u a))
-  {-# NOINLINE liftRootStrategy #-}
-
-class Mergeable1' (u :: Type -> Type) where
-  liftRootStrategy' :: MergingStrategy a -> MergingStrategy (u a)
-
-instance Mergeable1' U1 where
-  liftRootStrategy' _ = SimpleStrategy (\_ t _ -> t)
-  {-# INLINE liftRootStrategy' #-}
-
-instance Mergeable1' V1 where
-  liftRootStrategy' _ = SimpleStrategy (\_ t _ -> t)
-  {-# INLINE liftRootStrategy' #-}
-
-instance Mergeable1' Par1 where
-  liftRootStrategy' m = wrapStrategy m Par1 unPar1
-  {-# INLINE liftRootStrategy' #-}
-
-instance (Mergeable1 f) => Mergeable1' (Rec1 f) where
-  liftRootStrategy' m = wrapStrategy (liftRootStrategy m) Rec1 unRec1
-  {-# INLINE liftRootStrategy' #-}
-
-instance (Mergeable c) => Mergeable1' (K1 i c) where
-  liftRootStrategy' _ = wrapStrategy rootStrategy K1 unK1
-  {-# INLINE liftRootStrategy' #-}
-
-instance (Mergeable1' a) => Mergeable1' (M1 i c a) where
-  liftRootStrategy' m = wrapStrategy (liftRootStrategy' m) M1 unM1
-  {-# INLINE liftRootStrategy' #-}
-
-instance (Mergeable1' a, Mergeable1' b) => Mergeable1' (a :+: b) where
-  liftRootStrategy' m =
-    SortedStrategy
-      ( \case
-          L1 _ -> False
-          R1 _ -> True
-      )
-      ( \idx ->
-          if not idx
-            then wrapStrategy (liftRootStrategy' m) L1 (\case (L1 v) -> v; _ -> error "impossible")
-            else wrapStrategy (liftRootStrategy' m) R1 (\case (R1 v) -> v; _ -> error "impossible")
-      )
-  {-# INLINE liftRootStrategy' #-}
-
-instance (Mergeable1' a, Mergeable1' b) => Mergeable1' (a :*: b) where
-  liftRootStrategy' m = product2Strategy (:*:) (\(a :*: b) -> (a, b)) (liftRootStrategy' m) (liftRootStrategy' m)
-  {-# INLINE liftRootStrategy' #-}
-
--- | Generic derivation for the 'Mergeable' class.
-derivedLiftMergingStrategy :: (Generic1 u, Mergeable1' (Rep1 u)) => MergingStrategy a -> MergingStrategy (u a)
-derivedLiftMergingStrategy m = wrapStrategy (liftRootStrategy' m) to1 from1
-{-# INLINE derivedLiftMergingStrategy #-}
-
--- | Auxiliary class for the generic derivation for the 'Mergeable' class.
-class Mergeable' f where
-  rootStrategy' :: MergingStrategy (f a)
-
-instance Mergeable' U1 where
-  rootStrategy' = SimpleStrategy (\_ t _ -> t)
-  {-# INLINE rootStrategy' #-}
-
-instance Mergeable' V1 where
-  rootStrategy' = SimpleStrategy (\_ t _ -> t)
-  {-# INLINE rootStrategy' #-}
-
-instance (Mergeable c) => Mergeable' (K1 i c) where
-  rootStrategy' = wrapStrategy rootStrategy K1 unK1
-  {-# INLINE rootStrategy' #-}
-
-instance (Mergeable' a) => Mergeable' (M1 i c a) where
-  rootStrategy' = wrapStrategy rootStrategy' M1 unM1
-  {-# INLINE rootStrategy' #-}
-
-instance (Mergeable' a, Mergeable' b) => Mergeable' (a :+: b) where
-  rootStrategy' =
-    SortedStrategy
-      ( \case
-          L1 _ -> False
-          R1 _ -> True
-      )
-      ( \idx ->
-          if not idx
-            then wrapStrategy rootStrategy' L1 (\case (L1 v) -> v; _ -> undefined)
-            else wrapStrategy rootStrategy' R1 (\case (R1 v) -> v; _ -> undefined)
-      )
-  {-# INLINE rootStrategy' #-}
-
 -- | Useful utility function for building merge strategies for product types
 -- manually.
 --
@@ -1026,15 +925,15 @@
 
 #define MERGEABLE_SIMPLE(symtype) \
 instance Mergeable symtype where \
-  rootStrategy = SimpleStrategy ites
+  rootStrategy = SimpleStrategy symIte
 
 #define MERGEABLE_BV(symtype) \
 instance (KnownNat n, 1 <= n) => Mergeable (symtype n) where \
-  rootStrategy = SimpleStrategy ites
+  rootStrategy = SimpleStrategy symIte
 
 #define MERGEABLE_FUN(op) \
 instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => Mergeable (sa op sb) where \
-  rootStrategy = SimpleStrategy ites
+  rootStrategy = SimpleStrategy symIte
 
 #if 1
 MERGEABLE_SIMPLE(SymBool)
@@ -1053,7 +952,7 @@
           SimpleStrategy
             ( \c (SomeSymIntN (l :: SymIntN l)) (SomeSymIntN (r :: SymIntN r)) ->
                 case unsafeAxiom @l @r of
-                  Refl -> SomeSymIntN $ ites c l r
+                  Refl -> SomeSymIntN $ symIte c l r
             )
       )
 
@@ -1065,7 +964,7 @@
           SimpleStrategy
             ( \c (SomeSymWordN (l :: SymWordN l)) (SomeSymWordN (r :: SymWordN r)) ->
                 case unsafeAxiom @l @r of
-                  Refl -> SomeSymWordN $ ites c l r
+                  Refl -> SomeSymWordN $ symIte c l r
             )
       )
 
@@ -1084,3 +983,109 @@
       (const $ SimpleStrategy $ \_ l _ -> l)
 
 deriving via (Default BitwidthMismatch) instance (Mergeable BitwidthMismatch)
+
+deriving via (Default AssertionError) instance Mergeable AssertionError
+
+deriving via (Default VerificationConditions) instance Mergeable VerificationConditions
+
+instance (Generic a, Mergeable' (Rep a)) => Mergeable (Default a) where
+  rootStrategy = unsafeCoerce (derivedRootStrategy :: MergingStrategy a)
+  {-# NOINLINE rootStrategy #-}
+
+-- | Generic derivation for the 'Mergeable' class.
+--
+-- Usually you can derive the merging strategy with the @DerivingVia@ and
+-- @DerivingStrategies@ extension.
+--
+-- > data X = ... deriving (Generic) deriving Mergeable via (Default X)
+derivedRootStrategy :: (Generic a, Mergeable' (Rep a)) => MergingStrategy a
+derivedRootStrategy = wrapStrategy rootStrategy' to from
+{-# INLINE derivedRootStrategy #-}
+
+instance (Generic1 u, Mergeable1' (Rep1 u)) => Mergeable1 (Default1 u) where
+  liftRootStrategy = unsafeCoerce (derivedLiftMergingStrategy :: MergingStrategy a -> MergingStrategy (u a))
+  {-# NOINLINE liftRootStrategy #-}
+
+class Mergeable1' (u :: Type -> Type) where
+  liftRootStrategy' :: MergingStrategy a -> MergingStrategy (u a)
+
+instance Mergeable1' U1 where
+  liftRootStrategy' _ = SimpleStrategy (\_ t _ -> t)
+  {-# INLINE liftRootStrategy' #-}
+
+instance Mergeable1' V1 where
+  liftRootStrategy' _ = SimpleStrategy (\_ t _ -> t)
+  {-# INLINE liftRootStrategy' #-}
+
+instance Mergeable1' Par1 where
+  liftRootStrategy' m = wrapStrategy m Par1 unPar1
+  {-# INLINE liftRootStrategy' #-}
+
+instance (Mergeable1 f) => Mergeable1' (Rec1 f) where
+  liftRootStrategy' m = wrapStrategy (liftRootStrategy m) Rec1 unRec1
+  {-# INLINE liftRootStrategy' #-}
+
+instance (Mergeable c) => Mergeable1' (K1 i c) where
+  liftRootStrategy' _ = wrapStrategy rootStrategy K1 unK1
+  {-# INLINE liftRootStrategy' #-}
+
+instance (Mergeable1' a) => Mergeable1' (M1 i c a) where
+  liftRootStrategy' m = wrapStrategy (liftRootStrategy' m) M1 unM1
+  {-# INLINE liftRootStrategy' #-}
+
+instance (Mergeable1' a, Mergeable1' b) => Mergeable1' (a :+: b) where
+  liftRootStrategy' m =
+    SortedStrategy
+      ( \case
+          L1 _ -> False
+          R1 _ -> True
+      )
+      ( \idx ->
+          if not idx
+            then wrapStrategy (liftRootStrategy' m) L1 (\case (L1 v) -> v; _ -> error "impossible")
+            else wrapStrategy (liftRootStrategy' m) R1 (\case (R1 v) -> v; _ -> error "impossible")
+      )
+  {-# INLINE liftRootStrategy' #-}
+
+instance (Mergeable1' a, Mergeable1' b) => Mergeable1' (a :*: b) where
+  liftRootStrategy' m = product2Strategy (:*:) (\(a :*: b) -> (a, b)) (liftRootStrategy' m) (liftRootStrategy' m)
+  {-# INLINE liftRootStrategy' #-}
+
+-- | Generic derivation for the 'Mergeable' class.
+derivedLiftMergingStrategy :: (Generic1 u, Mergeable1' (Rep1 u)) => MergingStrategy a -> MergingStrategy (u a)
+derivedLiftMergingStrategy m = wrapStrategy (liftRootStrategy' m) to1 from1
+{-# INLINE derivedLiftMergingStrategy #-}
+
+-- | Auxiliary class for the generic derivation for the 'Mergeable' class.
+class Mergeable' f where
+  rootStrategy' :: MergingStrategy (f a)
+
+instance Mergeable' U1 where
+  rootStrategy' = SimpleStrategy (\_ t _ -> t)
+  {-# INLINE rootStrategy' #-}
+
+instance Mergeable' V1 where
+  rootStrategy' = SimpleStrategy (\_ t _ -> t)
+  {-# INLINE rootStrategy' #-}
+
+instance (Mergeable c) => Mergeable' (K1 i c) where
+  rootStrategy' = wrapStrategy rootStrategy K1 unK1
+  {-# INLINE rootStrategy' #-}
+
+instance (Mergeable' a) => Mergeable' (M1 i c a) where
+  rootStrategy' = wrapStrategy rootStrategy' M1 unM1
+  {-# INLINE rootStrategy' #-}
+
+instance (Mergeable' a, Mergeable' b) => Mergeable' (a :+: b) where
+  rootStrategy' =
+    SortedStrategy
+      ( \case
+          L1 _ -> False
+          R1 _ -> True
+      )
+      ( \idx ->
+          if not idx
+            then wrapStrategy rootStrategy' L1 (\case (L1 v) -> v; _ -> undefined)
+            else wrapStrategy rootStrategy' R1 (\case (R1 v) -> v; _ -> undefined)
+      )
+  {-# INLINE rootStrategy' #-}
diff --git a/src/Grisette/Core/Data/Class/Mergeable.hs-boot b/src/Grisette/Core/Data/Class/Mergeable.hs-boot
deleted file mode 100644
--- a/src/Grisette/Core/Data/Class/Mergeable.hs-boot
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE Trustworthy #-}
-
-module Grisette.Core.Data.Class.Mergeable
-  ( MergingStrategy (..),
-    Mergeable' (..),
-    Mergeable (..),
-  )
-where
-
-import Data.Typeable (Typeable)
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim (SymBool)
-
-data MergingStrategy a where
-  SimpleStrategy :: (SymBool -> a -> a -> a) -> MergingStrategy a
-  SortedStrategy ::
-    (Ord idx, Typeable idx, Show idx) =>
-    (a -> idx) ->
-    (idx -> MergingStrategy a) ->
-    MergingStrategy a
-  NoStrategy :: MergingStrategy a
-
-class Mergeable' f where
-  rootStrategy' :: MergingStrategy (f a)
-
-class Mergeable a where
-  rootStrategy :: MergingStrategy a
diff --git a/src/Grisette/Core/Data/Class/SEq.hs b/src/Grisette/Core/Data/Class/SEq.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Core/Data/Class/SEq.hs
@@ -0,0 +1,306 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- |
+-- Module      :   Grisette.Core.Data.Class.Bool
+-- Copyright   :   (c) Sirui Lu 2021-2023
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Core.Data.Class.SEq
+  ( -- * Symbolic equality
+    SEq (..),
+    SEq' (..),
+  )
+where
+
+import Control.Monad.Except (ExceptT (ExceptT))
+import Control.Monad.Identity
+  ( Identity (Identity),
+    IdentityT (IdentityT),
+  )
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import qualified Control.Monad.Writer.Lazy as WriterLazy
+import qualified Control.Monad.Writer.Strict as WriterStrict
+import qualified Data.ByteString as B
+import Data.Functor.Sum (Sum)
+import Data.Int (Int16, Int32, Int64, Int8)
+import qualified Data.Text as T
+import Data.Typeable (Proxy (Proxy), type (:~:) (Refl))
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.TypeLits (sameNat)
+import GHC.TypeNats (KnownNat, type (<=))
+import Generics.Deriving
+  ( Default (Default),
+    Generic (Rep, from),
+    K1 (K1),
+    M1 (M1),
+    U1,
+    V1,
+    type (:*:) ((:*:)),
+    type (:+:) (L1, R1),
+  )
+import Grisette.Core.Control.Exception (AssertionError, VerificationConditions)
+import Grisette.Core.Data.BV (IntN, SomeIntN, SomeWordN, WordN)
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&)))
+import Grisette.Core.Data.Class.Solvable (Solvable (con))
+import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bool (pevalEqvTerm)
+import Grisette.IR.SymPrim.Data.SymPrim
+  ( SomeSymIntN (SomeSymIntN),
+    SomeSymWordN (SomeSymWordN),
+    SymBool (SymBool),
+    SymIntN (SymIntN),
+    SymInteger (SymInteger),
+    SymWordN (SymWordN),
+  )
+
+-- $setup
+-- >>> import Grisette.Core
+-- >>> import Grisette.IR.SymPrim
+-- >>> :set -XDataKinds
+-- >>> :set -XBinaryLiterals
+-- >>> :set -XFlexibleContexts
+-- >>> :set -XFlexibleInstances
+-- >>> :set -XFunctionalDependencies
+
+-- | Symbolic equality. Note that we can't use Haskell's 'Eq' class since
+-- symbolic comparison won't necessarily return a concrete 'Bool' value.
+--
+-- >>> let a = 1 :: SymInteger
+-- >>> let b = 2 :: SymInteger
+-- >>> a .== b
+-- false
+-- >>> a ./= b
+-- true
+--
+-- >>> let a = "a" :: SymInteger
+-- >>> let b = "b" :: SymInteger
+-- >>> a ./= b
+-- (! (= a b))
+-- >>> a ./= b
+-- (! (= a b))
+--
+-- __Note:__ This type class can be derived for algebraic data types.
+-- You may need the @DerivingVia@ and @DerivingStrategies@ extensions.
+--
+-- > data X = ... deriving Generic deriving SEq via (Default X)
+class SEq a where
+  (.==) :: a -> a -> SymBool
+  a .== b = symNot $ a ./= b
+  {-# INLINE (.==) #-}
+  infix 4 .==
+
+  (./=) :: a -> a -> SymBool
+  a ./= b = symNot $ a .== b
+  {-# INLINE (./=) #-}
+  infix 4 ./=
+  {-# MINIMAL (.==) | (./=) #-}
+
+-- SEq instances
+#define CONCRETE_SEQ(type) \
+instance SEq type where \
+  l .== r = con $ l == r; \
+  {-# INLINE (.==) #-}
+
+#define CONCRETE_SEQ_BV(type) \
+instance (KnownNat n, 1 <= n) => SEq (type n) where \
+  l .== r = con $ l == r; \
+  {-# INLINE (.==) #-}
+
+#if 1
+CONCRETE_SEQ(Bool)
+CONCRETE_SEQ(Integer)
+CONCRETE_SEQ(Char)
+CONCRETE_SEQ(Int)
+CONCRETE_SEQ(Int8)
+CONCRETE_SEQ(Int16)
+CONCRETE_SEQ(Int32)
+CONCRETE_SEQ(Int64)
+CONCRETE_SEQ(Word)
+CONCRETE_SEQ(Word8)
+CONCRETE_SEQ(Word16)
+CONCRETE_SEQ(Word32)
+CONCRETE_SEQ(Word64)
+CONCRETE_SEQ(B.ByteString)
+CONCRETE_SEQ(T.Text)
+CONCRETE_SEQ_BV(WordN)
+CONCRETE_SEQ_BV(IntN)
+CONCRETE_SEQ(SomeWordN)
+CONCRETE_SEQ(SomeIntN)
+#endif
+
+-- List
+deriving via (Default [a]) instance (SEq a) => SEq [a]
+
+-- Maybe
+deriving via (Default (Maybe a)) instance (SEq a) => SEq (Maybe a)
+
+-- Either
+deriving via (Default (Either e a)) instance (SEq e, SEq a) => SEq (Either e a)
+
+-- ExceptT
+instance (SEq (m (Either e a))) => SEq (ExceptT e m a) where
+  (ExceptT a) .== (ExceptT b) = a .== b
+  {-# INLINE (.==) #-}
+
+-- MaybeT
+instance (SEq (m (Maybe a))) => SEq (MaybeT m a) where
+  (MaybeT a) .== (MaybeT b) = a .== b
+  {-# INLINE (.==) #-}
+
+-- ()
+instance SEq () where
+  _ .== _ = con True
+  {-# INLINE (.==) #-}
+
+-- (,)
+deriving via (Default (a, b)) instance (SEq a, SEq b) => SEq (a, b)
+
+-- (,,)
+deriving via (Default (a, b, c)) instance (SEq a, SEq b, SEq c) => SEq (a, b, c)
+
+-- (,,,)
+deriving via
+  (Default (a, b, c, d))
+  instance
+    (SEq a, SEq b, SEq c, SEq d) =>
+    SEq (a, b, c, d)
+
+-- (,,,,)
+deriving via
+  (Default (a, b, c, d, e))
+  instance
+    (SEq a, SEq b, SEq c, SEq d, SEq e) =>
+    SEq (a, b, c, d, e)
+
+-- (,,,,,)
+deriving via
+  (Default (a, b, c, d, e, f))
+  instance
+    (SEq a, SEq b, SEq c, SEq d, SEq e, SEq f) =>
+    SEq (a, b, c, d, e, f)
+
+-- (,,,,,,)
+deriving via
+  (Default (a, b, c, d, e, f, g))
+  instance
+    (SEq a, SEq b, SEq c, SEq d, SEq e, SEq f, SEq g) =>
+    SEq (a, b, c, d, e, f, g)
+
+-- (,,,,,,,)
+deriving via
+  (Default (a, b, c, d, e, f, g, h))
+  instance
+    (SEq a, SEq b, SEq c, SEq d, SEq e, SEq f, SEq g, SEq h) =>
+    SEq (a, b, c, d, e, f, g, h)
+
+-- Sum
+deriving via
+  (Default (Sum f g a))
+  instance
+    (SEq (f a), SEq (g a)) => SEq (Sum f g a)
+
+-- Writer
+instance (SEq (m (a, s))) => SEq (WriterLazy.WriterT s m a) where
+  (WriterLazy.WriterT l) .== (WriterLazy.WriterT r) = l .== r
+  {-# INLINE (.==) #-}
+
+instance (SEq (m (a, s))) => SEq (WriterStrict.WriterT s m a) where
+  (WriterStrict.WriterT l) .== (WriterStrict.WriterT r) = l .== r
+  {-# INLINE (.==) #-}
+
+-- Identity
+instance (SEq a) => SEq (Identity a) where
+  (Identity l) .== (Identity r) = l .== r
+  {-# INLINE (.==) #-}
+
+-- IdentityT
+instance (SEq (m a)) => SEq (IdentityT m a) where
+  (IdentityT l) .== (IdentityT r) = l .== r
+  {-# INLINE (.==) #-}
+
+-- Symbolic types
+#define SEQ_SIMPLE(symtype) \
+instance SEq symtype where \
+  (symtype l) .== (symtype r) = SymBool $ pevalEqvTerm l r
+
+#define SEQ_BV(symtype) \
+instance (KnownNat n, 1 <= n) => SEq (symtype n) where \
+  (symtype l) .== (symtype r) = SymBool $ pevalEqvTerm l r
+
+#define SEQ_BV_SOME(somety, origty) \
+instance SEq somety where \
+  somety (l :: origty l) .== somety (r :: origty r) = \
+    (case sameNat (Proxy @l) (Proxy @r) of \
+      Just Refl -> l .== r; \
+      Nothing -> con False); \
+  {-# INLINE (.==) #-}; \
+  somety (l :: origty l) ./= somety (r :: origty r) = \
+    (case sameNat (Proxy @l) (Proxy @r) of \
+      Just Refl -> l ./= r; \
+      Nothing -> con True); \
+  {-# INLINE (./=) #-}
+
+#if 1
+SEQ_SIMPLE(SymBool)
+SEQ_SIMPLE(SymInteger)
+SEQ_BV(SymIntN)
+SEQ_BV(SymWordN)
+SEQ_BV_SOME(SomeSymIntN, SymIntN)
+SEQ_BV_SOME(SomeSymWordN, SymWordN)
+#endif
+
+-- Exceptions
+deriving via (Default AssertionError) instance SEq AssertionError
+
+deriving via (Default VerificationConditions) instance SEq VerificationConditions
+
+-- | Auxiliary class for 'SEq' instance derivation
+class SEq' f where
+  -- | Auxiliary function for '(..==) derivation
+  (..==) :: f a -> f a -> SymBool
+
+  infix 4 ..==
+
+instance SEq' U1 where
+  _ ..== _ = con True
+  {-# INLINE (..==) #-}
+
+instance SEq' V1 where
+  _ ..== _ = con True
+  {-# INLINE (..==) #-}
+
+instance (SEq c) => SEq' (K1 i c) where
+  (K1 a) ..== (K1 b) = a .== b
+  {-# INLINE (..==) #-}
+
+instance (SEq' a) => SEq' (M1 i c a) where
+  (M1 a) ..== (M1 b) = a ..== b
+  {-# INLINE (..==) #-}
+
+instance (SEq' a, SEq' b) => SEq' (a :+: b) where
+  (L1 a) ..== (L1 b) = a ..== b
+  (R1 a) ..== (R1 b) = a ..== b
+  _ ..== _ = con False
+  {-# INLINE (..==) #-}
+
+instance (SEq' a, SEq' b) => SEq' (a :*: b) where
+  (a1 :*: b1) ..== (a2 :*: b2) = (a1 ..== a2) .&& (b1 ..== b2)
+  {-# INLINE (..==) #-}
+
+instance (Generic a, SEq' (Rep a)) => SEq (Default a) where
+  Default l .== Default r = from l ..== from r
+  {-# INLINE (.==) #-}
diff --git a/src/Grisette/Core/Data/Class/SOrd.hs b/src/Grisette/Core/Data/Class/SOrd.hs
--- a/src/Grisette/Core/Data/Class/SOrd.hs
+++ b/src/Grisette/Core/Data/Class/SOrd.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -50,19 +51,33 @@
     type (:*:) ((:*:)),
     type (:+:) (L1, R1),
   )
-import {-# SOURCE #-} Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Control.Exception (AssertionError, VerificationConditions)
+import Grisette.Core.Control.Monad.UnionM (UnionM, liftToMonadUnion)
 import Grisette.Core.Data.BV (IntN, SomeIntN, SomeWordN, WordN)
-import Grisette.Core.Data.Class.Bool
-  ( LogicalOp ((&&~), (||~)),
-    SEq ((/=~), (==~)),
-    SEq' ((==~~)),
-  )
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&), (.||)))
+import Grisette.Core.Data.Class.SEq (SEq ((./=), (.==)), SEq' ((..==)))
 import Grisette.Core.Data.Class.SimpleMergeable
   ( mrgIf,
     mrgSingle,
+    simpleMerge,
   )
 import Grisette.Core.Data.Class.Solvable (Solvable (con))
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Grisette.IR.SymPrim.Data.Prim.PartialEval.Num
+  ( pevalGeNumTerm,
+    pevalGtNumTerm,
+    pevalLeNumTerm,
+    pevalLtNumTerm,
+  )
+import Grisette.IR.SymPrim.Data.SymPrim
+  ( SomeSymIntN,
+    SomeSymWordN,
+    SymBool (SymBool),
+    SymIntN (SymIntN),
+    SymInteger (SymInteger),
+    SymWordN (SymWordN),
+    binSomeSymIntN,
+    binSomeSymWordN,
+  )
 
 -- $setup
 -- >>> import Grisette.Core
@@ -73,129 +88,26 @@
 -- >>> :set -XFlexibleInstances
 -- >>> :set -XFunctionalDependencies
 
--- | Auxiliary class for 'SOrd' instance derivation
-class (SEq' f) => SOrd' f where
-  -- | Auxiliary function for '(<~~) derivation
-  (<~~) :: f a -> f a -> SymBool
-
-  infix 4 <~~
-
-  -- | Auxiliary function for '(<=~~) derivation
-  (<=~~) :: f a -> f a -> SymBool
-
-  infix 4 <=~~
-
-  -- | Auxiliary function for '(>~~) derivation
-  (>~~) :: f a -> f a -> SymBool
-
-  infix 4 >~~
-
-  -- | Auxiliary function for '(>=~~) derivation
-  (>=~~) :: f a -> f a -> SymBool
-
-  infix 4 >=~~
-
-  -- | Auxiliary function for 'symCompare' derivation
-  symCompare' :: f a -> f a -> UnionM Ordering
-
-instance SOrd' U1 where
-  _ <~~ _ = con False
-  _ <=~~ _ = con True
-  _ >~~ _ = con False
-  _ >=~~ _ = con True
-  symCompare' _ _ = mrgSingle EQ
-
-instance SOrd' V1 where
-  _ <~~ _ = con False
-  _ <=~~ _ = con True
-  _ >~~ _ = con False
-  _ >=~~ _ = con True
-  symCompare' _ _ = mrgSingle EQ
-
-instance (SOrd c) => SOrd' (K1 i c) where
-  (K1 a) <~~ (K1 b) = a <~ b
-  (K1 a) <=~~ (K1 b) = a <=~ b
-  (K1 a) >~~ (K1 b) = a >~ b
-  (K1 a) >=~~ (K1 b) = a >=~ b
-  symCompare' (K1 a) (K1 b) = symCompare a b
-
-instance (SOrd' a) => SOrd' (M1 i c a) where
-  (M1 a) <~~ (M1 b) = a <~~ b
-  (M1 a) <=~~ (M1 b) = a <=~~ b
-  (M1 a) >~~ (M1 b) = a >~~ b
-  (M1 a) >=~~ (M1 b) = a >=~~ b
-  symCompare' (M1 a) (M1 b) = symCompare' a b
-
-instance (SOrd' a, SOrd' b) => SOrd' (a :+: b) where
-  (L1 _) <~~ (R1 _) = con True
-  (L1 a) <~~ (L1 b) = a <~~ b
-  (R1 _) <~~ (L1 _) = con False
-  (R1 a) <~~ (R1 b) = a <~~ b
-  (L1 _) <=~~ (R1 _) = con True
-  (L1 a) <=~~ (L1 b) = a <=~~ b
-  (R1 _) <=~~ (L1 _) = con False
-  (R1 a) <=~~ (R1 b) = a <=~~ b
-
-  (L1 _) >~~ (R1 _) = con False
-  (L1 a) >~~ (L1 b) = a >~~ b
-  (R1 _) >~~ (L1 _) = con True
-  (R1 a) >~~ (R1 b) = a >~~ b
-  (L1 _) >=~~ (R1 _) = con False
-  (L1 a) >=~~ (L1 b) = a >=~~ b
-  (R1 _) >=~~ (L1 _) = con True
-  (R1 a) >=~~ (R1 b) = a >=~~ b
-
-  symCompare' (L1 a) (L1 b) = symCompare' a b
-  symCompare' (L1 _) (R1 _) = mrgSingle LT
-  symCompare' (R1 a) (R1 b) = symCompare' a b
-  symCompare' (R1 _) (L1 _) = mrgSingle GT
-
-instance (SOrd' a, SOrd' b) => SOrd' (a :*: b) where
-  (a1 :*: b1) <~~ (a2 :*: b2) = (a1 <~~ a2) ||~ ((a1 ==~~ a2) &&~ (b1 <~~ b2))
-  (a1 :*: b1) <=~~ (a2 :*: b2) = (a1 <~~ a2) ||~ ((a1 ==~~ a2) &&~ (b1 <=~~ b2))
-  (a1 :*: b1) >~~ (a2 :*: b2) = (a1 >~~ a2) ||~ ((a1 ==~~ a2) &&~ (b1 >~~ b2))
-  (a1 :*: b1) >=~~ (a2 :*: b2) = (a1 >~~ a2) ||~ ((a1 ==~~ a2) &&~ (b1 >=~~ b2))
-  symCompare' (a1 :*: b1) (a2 :*: b2) = do
-    l <- symCompare' a1 a2
-    case l of
-      EQ -> symCompare' b1 b2
-      _ -> mrgSingle l
-
-derivedSymLt :: (Generic a, SOrd' (Rep a)) => a -> a -> SymBool
-derivedSymLt x y = from x <~~ from y
-
-derivedSymLe :: (Generic a, SOrd' (Rep a)) => a -> a -> SymBool
-derivedSymLe x y = from x <=~~ from y
-
-derivedSymGt :: (Generic a, SOrd' (Rep a)) => a -> a -> SymBool
-derivedSymGt x y = from x >~~ from y
-
-derivedSymGe :: (Generic a, SOrd' (Rep a)) => a -> a -> SymBool
-derivedSymGe x y = from x >=~~ from y
-
-derivedSymCompare :: (Generic a, SOrd' (Rep a)) => a -> a -> UnionM Ordering
-derivedSymCompare x y = symCompare' (from x) (from y)
-
 -- | Symbolic total order. Note that we can't use Haskell's 'Ord' class since
 -- symbolic comparison won't necessarily return a concrete 'Bool' or 'Ordering'
 -- value.
 --
 -- >>> let a = 1 :: SymInteger
 -- >>> let b = 2 :: SymInteger
--- >>> a <~ b
+-- >>> a .< b
 -- true
--- >>> a >~ b
+-- >>> a .> b
 -- false
 --
 -- >>> let a = "a" :: SymInteger
 -- >>> let b = "b" :: SymInteger
--- >>> a <~ b
+-- >>> a .< b
 -- (< a b)
--- >>> a <=~ b
+-- >>> a .<= b
 -- (<= a b)
--- >>> a >~ b
+-- >>> a .> b
 -- (< b a)
--- >>> a >=~ b
+-- >>> a .>= b
 -- (<= b a)
 --
 -- For `symCompare`, `Ordering` is not a solvable type, and the result would
@@ -210,46 +122,46 @@
 --
 -- > data X = ... deriving Generic deriving SOrd via (Default X)
 class (SEq a) => SOrd a where
-  (<~) :: a -> a -> SymBool
-  infix 4 <~
-  (<=~) :: a -> a -> SymBool
-  infix 4 <=~
-  (>~) :: a -> a -> SymBool
-  infix 4 >~
-  (>=~) :: a -> a -> SymBool
-  infix 4 >=~
-  x <~ y = x <=~ y &&~ x /=~ y
-  x >~ y = y <~ x
-  x >=~ y = y <=~ x
+  (.<) :: a -> a -> SymBool
+  infix 4 .<
+  (.<=) :: a -> a -> SymBool
+  infix 4 .<=
+  (.>) :: a -> a -> SymBool
+  infix 4 .>
+  (.>=) :: a -> a -> SymBool
+  infix 4 .>=
+  x .< y = x .<= y .&& x ./= y
+  x .> y = y .< x
+  x .>= y = y .<= x
   symCompare :: a -> a -> UnionM Ordering
   symCompare l r =
     mrgIf
-      (l <~ r)
+      (l .< r)
       (mrgSingle LT)
-      (mrgIf (l ==~ r) (mrgSingle EQ) (mrgSingle GT))
-  {-# MINIMAL (<=~) #-}
+      (mrgIf (l .== r) (mrgSingle EQ) (mrgSingle GT))
+  {-# MINIMAL (.<=) #-}
 
 instance (SEq a, Generic a, SOrd' (Rep a)) => SOrd (Default a) where
-  (Default l) <=~ (Default r) = l `derivedSymLe` r
-  (Default l) <~ (Default r) = l `derivedSymLt` r
-  (Default l) >=~ (Default r) = l `derivedSymGe` r
-  (Default l) >~ (Default r) = l `derivedSymGt` r
+  (Default l) .<= (Default r) = l `derivedSymLe` r
+  (Default l) .< (Default r) = l `derivedSymLt` r
+  (Default l) .>= (Default r) = l `derivedSymGe` r
+  (Default l) .> (Default r) = l `derivedSymGt` r
   symCompare (Default l) (Default r) = derivedSymCompare l r
 
 #define CONCRETE_SORD(type) \
 instance SOrd type where \
-  l <=~ r = con $ l <= r; \
-  l <~ r = con $ l < r; \
-  l >=~ r = con $ l >= r; \
-  l >~ r = con $ l > r; \
+  l .<= r = con $ l <= r; \
+  l .< r = con $ l < r; \
+  l .>= r = con $ l >= r; \
+  l .> r = con $ l > r; \
   symCompare l r = mrgSingle $ compare l r
 
 #define CONCRETE_SORD_BV(type) \
 instance (KnownNat n, 1 <= n) => SOrd (type n) where \
-  l <=~ r = con $ l <= r; \
-  l <~ r = con $ l < r; \
-  l >=~ r = con $ l >= r; \
-  l >~ r = con $ l > r; \
+  l .<= r = con $ l <= r; \
+  l .< r = con $ l < r; \
+  l .>= r = con $ l >= r; \
+  l .> r = con $ l > r; \
   symCompare l r = mrgSingle $ compare l r
 
 #if 1
@@ -278,7 +190,7 @@
 symCompareSingleList isLess isStrict = go
   where
     go [] [] = con (not isStrict)
-    go (x : xs) (y : ys) = (if isLess then x <~ y else x >~ y) ||~ (x ==~ y &&~ go xs ys)
+    go (x : xs) (y : ys) = (if isLess then x .< y else x .> y) .|| (x .== y .&& go xs ys)
     go [] _ = if isLess then con True else con False
     go _ [] = if isLess then con False else con True
 
@@ -294,10 +206,10 @@
 symCompareList _ [] = mrgSingle GT
 
 instance (SOrd a) => SOrd [a] where
-  (<=~) = symCompareSingleList True False
-  (<~) = symCompareSingleList True True
-  (>=~) = symCompareSingleList False False
-  (>~) = symCompareSingleList False True
+  (.<=) = symCompareSingleList True False
+  (.<) = symCompareSingleList True True
+  (.>=) = symCompareSingleList False False
+  (.>) = symCompareSingleList False True
   symCompare = symCompareList
 
 deriving via (Default (Maybe a)) instance (SOrd a) => SOrd (Maybe a)
@@ -354,43 +266,239 @@
     (SOrd (f a), SOrd (g a)) => SOrd (Sum f g a)
 
 instance (SOrd (m (Maybe a))) => SOrd (MaybeT m a) where
-  (MaybeT l) <=~ (MaybeT r) = l <=~ r
-  (MaybeT l) <~ (MaybeT r) = l <~ r
-  (MaybeT l) >=~ (MaybeT r) = l >=~ r
-  (MaybeT l) >~ (MaybeT r) = l >~ r
+  (MaybeT l) .<= (MaybeT r) = l .<= r
+  (MaybeT l) .< (MaybeT r) = l .< r
+  (MaybeT l) .>= (MaybeT r) = l .>= r
+  (MaybeT l) .> (MaybeT r) = l .> r
   symCompare (MaybeT l) (MaybeT r) = symCompare l r
 
 instance (SOrd (m (Either e a))) => SOrd (ExceptT e m a) where
-  (ExceptT l) <=~ (ExceptT r) = l <=~ r
-  (ExceptT l) <~ (ExceptT r) = l <~ r
-  (ExceptT l) >=~ (ExceptT r) = l >=~ r
-  (ExceptT l) >~ (ExceptT r) = l >~ r
+  (ExceptT l) .<= (ExceptT r) = l .<= r
+  (ExceptT l) .< (ExceptT r) = l .< r
+  (ExceptT l) .>= (ExceptT r) = l .>= r
+  (ExceptT l) .> (ExceptT r) = l .> r
   symCompare (ExceptT l) (ExceptT r) = symCompare l r
 
 instance (SOrd (m (a, s))) => SOrd (WriterLazy.WriterT s m a) where
-  (WriterLazy.WriterT l) <=~ (WriterLazy.WriterT r) = l <=~ r
-  (WriterLazy.WriterT l) <~ (WriterLazy.WriterT r) = l <~ r
-  (WriterLazy.WriterT l) >=~ (WriterLazy.WriterT r) = l >=~ r
-  (WriterLazy.WriterT l) >~ (WriterLazy.WriterT r) = l >~ r
+  (WriterLazy.WriterT l) .<= (WriterLazy.WriterT r) = l .<= r
+  (WriterLazy.WriterT l) .< (WriterLazy.WriterT r) = l .< r
+  (WriterLazy.WriterT l) .>= (WriterLazy.WriterT r) = l .>= r
+  (WriterLazy.WriterT l) .> (WriterLazy.WriterT r) = l .> r
   symCompare (WriterLazy.WriterT l) (WriterLazy.WriterT r) = symCompare l r
 
 instance (SOrd (m (a, s))) => SOrd (WriterStrict.WriterT s m a) where
-  (WriterStrict.WriterT l) <=~ (WriterStrict.WriterT r) = l <=~ r
-  (WriterStrict.WriterT l) <~ (WriterStrict.WriterT r) = l <~ r
-  (WriterStrict.WriterT l) >=~ (WriterStrict.WriterT r) = l >=~ r
-  (WriterStrict.WriterT l) >~ (WriterStrict.WriterT r) = l >~ r
+  (WriterStrict.WriterT l) .<= (WriterStrict.WriterT r) = l .<= r
+  (WriterStrict.WriterT l) .< (WriterStrict.WriterT r) = l .< r
+  (WriterStrict.WriterT l) .>= (WriterStrict.WriterT r) = l .>= r
+  (WriterStrict.WriterT l) .> (WriterStrict.WriterT r) = l .> r
   symCompare (WriterStrict.WriterT l) (WriterStrict.WriterT r) = symCompare l r
 
 instance (SOrd a) => SOrd (Identity a) where
-  (Identity l) <=~ (Identity r) = l <=~ r
-  (Identity l) <~ (Identity r) = l <~ r
-  (Identity l) >=~ (Identity r) = l >=~ r
-  (Identity l) >~ (Identity r) = l >~ r
+  (Identity l) .<= (Identity r) = l .<= r
+  (Identity l) .< (Identity r) = l .< r
+  (Identity l) .>= (Identity r) = l .>= r
+  (Identity l) .> (Identity r) = l .> r
   (Identity l) `symCompare` (Identity r) = l `symCompare` r
 
 instance (SOrd (m a)) => SOrd (IdentityT m a) where
-  (IdentityT l) <=~ (IdentityT r) = l <=~ r
-  (IdentityT l) <~ (IdentityT r) = l <~ r
-  (IdentityT l) >=~ (IdentityT r) = l >=~ r
-  (IdentityT l) >~ (IdentityT r) = l >~ r
+  (IdentityT l) .<= (IdentityT r) = l .<= r
+  (IdentityT l) .< (IdentityT r) = l .< r
+  (IdentityT l) .>= (IdentityT r) = l .>= r
+  (IdentityT l) .> (IdentityT r) = l .> r
   (IdentityT l) `symCompare` (IdentityT r) = l `symCompare` r
+
+-- SOrd
+#define SORD_SIMPLE(symtype) \
+instance SOrd symtype where \
+  (symtype a) .<= (symtype b) = SymBool $ pevalLeNumTerm a b; \
+  (symtype a) .< (symtype b) = SymBool $ pevalLtNumTerm a b; \
+  (symtype a) .>= (symtype b) = SymBool $ pevalGeNumTerm a b; \
+  (symtype a) .> (symtype b) = SymBool $ pevalGtNumTerm a b; \
+  a `symCompare` b = mrgIf \
+    (a .< b) \
+    (mrgSingle LT) \
+    (mrgIf (a .== b) (mrgSingle EQ) (mrgSingle GT))
+
+#define SORD_BV(symtype) \
+instance (KnownNat n, 1 <= n) => SOrd (symtype n) where \
+  (symtype a) .<= (symtype b) = SymBool $ pevalLeNumTerm a b; \
+  (symtype a) .< (symtype b) = SymBool $ pevalLtNumTerm a b; \
+  (symtype a) .>= (symtype b) = SymBool $ pevalGeNumTerm a b; \
+  (symtype a) .> (symtype b) = SymBool $ pevalGtNumTerm a b; \
+  a `symCompare` b = mrgIf \
+    (a .< b) \
+    (mrgSingle LT) \
+    (mrgIf (a .== b) (mrgSingle EQ) (mrgSingle GT))
+
+#define SORD_BV_SOME(somety, bf) \
+instance SOrd somety where \
+  (.<=) = bf (.<=) ".<="; \
+  {-# INLINE (.<=) #-}; \
+  (.<) = bf (.<) ".<"; \
+  {-# INLINE (.<) #-}; \
+  (.>=) = bf (.>=) ".>="; \
+  {-# INLINE (.>=) #-}; \
+  (.>) = bf (.>) ".>"; \
+  {-# INLINE (.>) #-}; \
+  symCompare = bf symCompare "symCompare"; \
+  {-# INLINE symCompare #-}
+
+instance SOrd SymBool where
+  l .<= r = symNot l .|| r
+  l .< r = symNot l .&& r
+  l .>= r = l .|| symNot r
+  l .> r = l .&& symNot r
+  symCompare l r =
+    mrgIf
+      (symNot l .&& r)
+      (mrgSingle LT)
+      (mrgIf (l .== r) (mrgSingle EQ) (mrgSingle GT))
+
+#if 1
+SORD_SIMPLE(SymInteger)
+SORD_BV(SymIntN)
+SORD_BV(SymWordN)
+SORD_BV_SOME(SomeSymIntN, binSomeSymIntN)
+SORD_BV_SOME(SomeSymWordN, binSomeSymWordN)
+#endif
+
+-- Exception
+instance SOrd AssertionError where
+  _ .<= _ = con True
+  _ .< _ = con False
+  _ .>= _ = con True
+  _ .> _ = con False
+  _ `symCompare` _ = mrgSingle EQ
+
+instance SOrd VerificationConditions where
+  l .>= r = con $ l >= r
+  l .> r = con $ l > r
+  l .<= r = con $ l <= r
+  l .< r = con $ l < r
+  l `symCompare` r = mrgSingle $ l `compare` r
+
+-- UnionM
+instance (SOrd a) => SOrd (UnionM a) where
+  x .<= y = simpleMerge $ do
+    x1 <- x
+    y1 <- y
+    mrgSingle $ x1 .<= y1
+  x .< y = simpleMerge $ do
+    x1 <- x
+    y1 <- y
+    mrgSingle $ x1 .< y1
+  x .>= y = simpleMerge $ do
+    x1 <- x
+    y1 <- y
+    mrgSingle $ x1 .>= y1
+  x .> y = simpleMerge $ do
+    x1 <- x
+    y1 <- y
+    mrgSingle $ x1 .> y1
+  x `symCompare` y = liftToMonadUnion $ do
+    x1 <- x
+    y1 <- y
+    x1 `symCompare` y1
+
+-- | Auxiliary class for 'SOrd' instance derivation
+class (SEq' f) => SOrd' f where
+  -- | Auxiliary function for '(..<) derivation
+  (..<) :: f a -> f a -> SymBool
+
+  infix 4 ..<
+
+  -- | Auxiliary function for '(..<=) derivation
+  (..<=) :: f a -> f a -> SymBool
+
+  infix 4 ..<=
+
+  -- | Auxiliary function for '(..>) derivation
+  (..>) :: f a -> f a -> SymBool
+
+  infix 4 ..>
+
+  -- | Auxiliary function for '(..>=) derivation
+  (..>=) :: f a -> f a -> SymBool
+
+  infix 4 ..>=
+
+  -- | Auxiliary function for 'symCompare' derivation
+  symCompare' :: f a -> f a -> UnionM Ordering
+
+instance SOrd' U1 where
+  _ ..< _ = con False
+  _ ..<= _ = con True
+  _ ..> _ = con False
+  _ ..>= _ = con True
+  symCompare' _ _ = mrgSingle EQ
+
+instance SOrd' V1 where
+  _ ..< _ = con False
+  _ ..<= _ = con True
+  _ ..> _ = con False
+  _ ..>= _ = con True
+  symCompare' _ _ = mrgSingle EQ
+
+instance (SOrd c) => SOrd' (K1 i c) where
+  (K1 a) ..< (K1 b) = a .< b
+  (K1 a) ..<= (K1 b) = a .<= b
+  (K1 a) ..> (K1 b) = a .> b
+  (K1 a) ..>= (K1 b) = a .>= b
+  symCompare' (K1 a) (K1 b) = symCompare a b
+
+instance (SOrd' a) => SOrd' (M1 i c a) where
+  (M1 a) ..< (M1 b) = a ..< b
+  (M1 a) ..<= (M1 b) = a ..<= b
+  (M1 a) ..> (M1 b) = a ..> b
+  (M1 a) ..>= (M1 b) = a ..>= b
+  symCompare' (M1 a) (M1 b) = symCompare' a b
+
+instance (SOrd' a, SOrd' b) => SOrd' (a :+: b) where
+  (L1 _) ..< (R1 _) = con True
+  (L1 a) ..< (L1 b) = a ..< b
+  (R1 _) ..< (L1 _) = con False
+  (R1 a) ..< (R1 b) = a ..< b
+  (L1 _) ..<= (R1 _) = con True
+  (L1 a) ..<= (L1 b) = a ..<= b
+  (R1 _) ..<= (L1 _) = con False
+  (R1 a) ..<= (R1 b) = a ..<= b
+
+  (L1 _) ..> (R1 _) = con False
+  (L1 a) ..> (L1 b) = a ..> b
+  (R1 _) ..> (L1 _) = con True
+  (R1 a) ..> (R1 b) = a ..> b
+  (L1 _) ..>= (R1 _) = con False
+  (L1 a) ..>= (L1 b) = a ..>= b
+  (R1 _) ..>= (L1 _) = con True
+  (R1 a) ..>= (R1 b) = a ..>= b
+
+  symCompare' (L1 a) (L1 b) = symCompare' a b
+  symCompare' (L1 _) (R1 _) = mrgSingle LT
+  symCompare' (R1 a) (R1 b) = symCompare' a b
+  symCompare' (R1 _) (L1 _) = mrgSingle GT
+
+instance (SOrd' a, SOrd' b) => SOrd' (a :*: b) where
+  (a1 :*: b1) ..< (a2 :*: b2) = (a1 ..< a2) .|| ((a1 ..== a2) .&& (b1 ..< b2))
+  (a1 :*: b1) ..<= (a2 :*: b2) = (a1 ..< a2) .|| ((a1 ..== a2) .&& (b1 ..<= b2))
+  (a1 :*: b1) ..> (a2 :*: b2) = (a1 ..> a2) .|| ((a1 ..== a2) .&& (b1 ..> b2))
+  (a1 :*: b1) ..>= (a2 :*: b2) = (a1 ..> a2) .|| ((a1 ..== a2) .&& (b1 ..>= b2))
+  symCompare' (a1 :*: b1) (a2 :*: b2) = do
+    l <- symCompare' a1 a2
+    case l of
+      EQ -> symCompare' b1 b2
+      _ -> mrgSingle l
+
+derivedSymLt :: (Generic a, SOrd' (Rep a)) => a -> a -> SymBool
+derivedSymLt x y = from x ..< from y
+
+derivedSymLe :: (Generic a, SOrd' (Rep a)) => a -> a -> SymBool
+derivedSymLe x y = from x ..<= from y
+
+derivedSymGt :: (Generic a, SOrd' (Rep a)) => a -> a -> SymBool
+derivedSymGt x y = from x ..> from y
+
+derivedSymGe :: (Generic a, SOrd' (Rep a)) => a -> a -> SymBool
+derivedSymGe x y = from x ..>= from y
+
+derivedSymCompare :: (Generic a, SOrd' (Rep a)) => a -> a -> UnionM Ordering
+derivedSymCompare x y = symCompare' (from x) (from y)
diff --git a/src/Grisette/Core/Data/Class/SafeArith.hs b/src/Grisette/Core/Data/Class/SafeArith.hs
deleted file mode 100644
--- a/src/Grisette/Core/Data/Class/SafeArith.hs
+++ /dev/null
@@ -1,444 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-{- HLINT ignore "Redundant bracket" -}
-
--- |
--- Module      :   Grisette.Core.Data.Class.SafeArith
--- Copyright   :   (c) Sirui Lu 2021-2023
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Core.Data.Class.SafeArith
-  ( -- * Symbolic integer operations
-    ArithException (..),
-    SafeDivision (..),
-    SafeLinearArith (..),
-    SymIntegerOp,
-  )
-where
-
-import Control.Exception (ArithException (DivideByZero, Overflow, Underflow))
-import Control.Monad.Except (MonadError (throwError))
-import Data.Int (Int16, Int32, Int64, Int8)
-import Data.Typeable (Proxy (Proxy), type (:~:) (Refl))
-import Data.Word (Word16, Word32, Word64, Word8)
-import GHC.TypeNats (KnownNat, sameNat, type (<=))
-import Grisette.Core.Control.Monad.Union (MonadUnion)
-import Grisette.Core.Data.BV
-  ( BitwidthMismatch (BitwidthMismatch),
-    IntN,
-    SomeIntN (SomeIntN),
-    SomeWordN (SomeWordN),
-    WordN,
-  )
-import Grisette.Core.Data.Class.Bool
-  ( LogicalOp ((&&~), (||~)),
-    SEq ((==~)),
-  )
-import Grisette.Core.Data.Class.Mergeable (Mergeable)
-import Grisette.Core.Data.Class.SOrd
-  ( SOrd ((<=~), (<~), (>=~), (>~)),
-  )
-import Grisette.Core.Data.Class.SimpleMergeable
-  ( merge,
-    mrgIf,
-    mrgSingle,
-  )
-import Grisette.Core.Data.Class.Solvable (Solvable (con))
-
--- $setup
--- >>> import Grisette.Core
--- >>> import Grisette.IR.SymPrim
--- >>> import Control.Monad.Except
-
--- | Safe division with monadic error handling in multi-path
--- execution. These procedures throw an exception when the
--- divisor is zero. The result should be able to handle errors with
--- `MonadError`.
-class (SOrd a, Num a, Mergeable a, Mergeable e) => SafeDivision e a | a -> e where
-  -- | Safe signed 'div' with monadic error handling in multi-path execution.
-  --
-  -- >>> safeDiv (ssym "a") (ssym "b") :: ExceptT ArithException UnionM SymInteger
-  -- ExceptT {If (= b 0) (Left divide by zero) (Right (div a b))}
-  safeDiv :: (MonadError e uf, MonadUnion uf) => a -> a -> uf a
-  safeDiv l r = do
-    (d, _) <- safeDivMod l r
-    mrgSingle d
-
-  -- | Safe signed 'mod' with monadic error handling in multi-path execution.
-  --
-  -- >>> safeMod (ssym "a") (ssym "b") :: ExceptT ArithException UnionM SymInteger
-  -- ExceptT {If (= b 0) (Left divide by zero) (Right (mod a b))}
-  safeMod :: (MonadError e uf, MonadUnion uf) => a -> a -> uf a
-  safeMod l r = do
-    (_, m) <- safeDivMod l r
-    mrgSingle m
-
-  -- | Safe signed 'divMod' with monadic error handling in multi-path execution.
-  --
-  -- >>> safeDivMod (ssym "a") (ssym "b") :: ExceptT ArithException UnionM (SymInteger, SymInteger)
-  -- ExceptT {If (= b 0) (Left divide by zero) (Right ((div a b),(mod a b)))}
-  safeDivMod :: (MonadError e uf, MonadUnion uf) => a -> a -> uf (a, a)
-  safeDivMod l r = do
-    d <- safeDiv l r
-    m <- safeMod l r
-    mrgSingle (d, m)
-
-  -- | Safe signed 'quot' with monadic error handling in multi-path execution.
-  safeQuot :: (MonadError e uf, MonadUnion uf) => a -> a -> uf a
-  safeQuot l r = do
-    (d, m) <- safeDivMod l r
-    mrgIf
-      ((l >=~ 0 &&~ r >~ 0) ||~ (l <=~ 0 &&~ r <~ 0) ||~ m ==~ 0)
-      (mrgSingle d)
-      (mrgSingle $ d + 1)
-
-  -- | Safe signed 'rem' with monadic error handling in multi-path execution.
-  safeRem :: (MonadError e uf, MonadUnion uf) => a -> a -> uf a
-  safeRem l r = do
-    (_, m) <- safeDivMod l r
-    mrgIf
-      ((l >=~ 0 &&~ r >~ 0) ||~ (l <=~ 0 &&~ r <~ 0) ||~ m ==~ 0)
-      (mrgSingle m)
-      (mrgSingle $ m - r)
-
-  -- | Safe signed 'quotRem' with monadic error handling in multi-path execution.
-  safeQuotRem :: (MonadError e uf, MonadUnion uf) => a -> a -> uf (a, a)
-  safeQuotRem l r = do
-    (d, m) <- safeDivMod l r
-    mrgIf
-      ((l >=~ 0 &&~ r >~ 0) ||~ (l <=~ 0 &&~ r <~ 0) ||~ m ==~ 0)
-      (mrgSingle (d, m))
-      (mrgSingle (d + 1, m - r))
-
-  -- | Safe signed 'div' with monadic error handling in multi-path execution.
-  -- The error is transformed.
-  --
-  -- >>> safeDiv' (const ()) (ssym "a") (ssym "b") :: ExceptT () UnionM SymInteger
-  -- ExceptT {If (= b 0) (Left ()) (Right (div a b))}
-  safeDiv' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf a
-  safeDiv' t l r = do
-    (d, _) <- safeDivMod' t l r
-    mrgSingle d
-
-  -- | Safe signed 'mod' with monadic error handling in multi-path execution.
-  -- The error is transformed.
-  --
-  -- >>> safeMod' (const ()) (ssym "a") (ssym "b") :: ExceptT () UnionM SymInteger
-  -- ExceptT {If (= b 0) (Left ()) (Right (mod a b))}
-  safeMod' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf a
-  safeMod' t l r = do
-    (_, m) <- safeDivMod' t l r
-    mrgSingle m
-
-  -- | Safe signed 'divMod' with monadic error handling in multi-path execution.
-  -- The error is transformed.
-  --
-  -- >>> safeDivMod' (const ()) (ssym "a") (ssym "b") :: ExceptT () UnionM (SymInteger, SymInteger)
-  -- ExceptT {If (= b 0) (Left ()) (Right ((div a b),(mod a b)))}
-  safeDivMod' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf (a, a)
-  safeDivMod' t l r = do
-    d <- safeDiv' t l r
-    m <- safeMod' t l r
-    mrgSingle (d, m)
-
-  -- | Safe signed 'quot' with monadic error handling in multi-path execution.
-  -- The error is transformed.
-  safeQuot' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf a
-  safeQuot' t l r = do
-    (d, m) <- safeDivMod' t l r
-    mrgIf
-      ((l >=~ 0 &&~ r >~ 0) ||~ (l <=~ 0 &&~ r <~ 0) ||~ m ==~ 0)
-      (mrgSingle d)
-      (mrgSingle $ d + 1)
-
-  -- | Safe signed 'rem' with monadic error handling in multi-path execution.
-  -- The error is transformed.
-  safeRem' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf a
-  safeRem' t l r = do
-    (_, m) <- safeDivMod' t l r
-    mrgIf
-      ((l >=~ 0 &&~ r >~ 0) ||~ (l <=~ 0 &&~ r <~ 0) ||~ m ==~ 0)
-      (mrgSingle m)
-      (mrgSingle $ m - r)
-
-  -- | Safe signed 'quotRem' with monadic error handling in multi-path execution.
-  -- The error is transformed.
-  safeQuotRem' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf (a, a)
-  safeQuotRem' t l r = do
-    (d, m) <- safeDivMod' t l r
-    mrgIf
-      ((l >=~ 0 &&~ r >~ 0) ||~ (l <=~ 0 &&~ r <~ 0) ||~ m ==~ 0)
-      (mrgSingle (d, m))
-      (mrgSingle (d + 1, m - r))
-
-  {-# MINIMAL (safeDivMod | (safeDiv, safeMod)), (safeDivMod' | (safeDiv', safeMod')) #-}
-
-#define QUOTE() '
-#define QID(a) a
-#define QRIGHT(a) QID(a)'
-
-#define QRIGHTT(a) QID(a)' t'
-#define QRIGHTU(a) QID(a)' _'
-
-#define SAFE_DIVISION_FUNC(name, op) \
-name _ r | r == 0 = merge $ throwError DivideByZero; \
-name l r = mrgSingle $ l `op` r; \
-QRIGHTT(name) _ r | r == 0 = let _ = t' in merge $ throwError (t' DivideByZero); \
-QRIGHTU(name) l r = mrgSingle $ l `op` r
-
-#define SAFE_DIVISION_CONCRETE(type) \
-instance SafeDivision ArithException type where \
-  SAFE_DIVISION_FUNC(safeDiv, div); \
-  SAFE_DIVISION_FUNC(safeMod, mod); \
-  SAFE_DIVISION_FUNC(safeDivMod, divMod); \
-  SAFE_DIVISION_FUNC(safeQuot, quot); \
-  SAFE_DIVISION_FUNC(safeRem, rem); \
-  SAFE_DIVISION_FUNC(safeQuotRem, quotRem)
-
-#define SAFE_DIVISION_CONCRETE_BV(type) \
-instance (KnownNat n, 1 <= n) => SafeDivision ArithException (type n) where \
-  SAFE_DIVISION_FUNC(safeDiv, div); \
-  SAFE_DIVISION_FUNC(safeMod, mod); \
-  SAFE_DIVISION_FUNC(safeDivMod, divMod); \
-  SAFE_DIVISION_FUNC(safeQuot, quot); \
-  SAFE_DIVISION_FUNC(safeRem, rem); \
-  SAFE_DIVISION_FUNC(safeQuotRem, quotRem)
-
-#if 1
-SAFE_DIVISION_CONCRETE(Integer)
-SAFE_DIVISION_CONCRETE(Int8)
-SAFE_DIVISION_CONCRETE(Int16)
-SAFE_DIVISION_CONCRETE(Int32)
-SAFE_DIVISION_CONCRETE(Int64)
-SAFE_DIVISION_CONCRETE(Int)
-SAFE_DIVISION_CONCRETE(Word8)
-SAFE_DIVISION_CONCRETE(Word16)
-SAFE_DIVISION_CONCRETE(Word32)
-SAFE_DIVISION_CONCRETE(Word64)
-SAFE_DIVISION_CONCRETE(Word)
-#endif
-
-#define SAFE_DIVISION_FUNC_SOME(stype, type, name, op) \
-  name (stype (l :: type l)) (stype (r :: type r)) = \
-    (case sameNat (Proxy @l) (Proxy @r) of \
-      Just Refl -> \
-        if r == 0 \
-          then merge $ throwError $ Right DivideByZero \
-          else mrgSingle $ stype $ l `op` r; \
-      Nothing -> merge $ throwError $ Left BitwidthMismatch); \
-  QRIGHT(name) t (stype (l :: type l)) (stype (r :: type r)) = \
-    (case sameNat (Proxy @l) (Proxy @r) of \
-      Just Refl -> \
-        if r == 0 \
-          then merge $ throwError $ t (Right DivideByZero) \
-          else mrgSingle $ stype $ l `op` r; \
-      Nothing -> merge $ throwError $ t (Left BitwidthMismatch))
-
-#define SAFE_DIVISION_FUNC_SOME_DIVMOD(stype, type, name, op) \
-  name (stype (l :: type l)) (stype (r :: type r)) = \
-    (case sameNat (Proxy @l) (Proxy @r) of \
-      Just Refl -> \
-        if r == 0 \
-          then merge $ throwError $ Right DivideByZero \
-          else (case l `op` r of (d, m) -> mrgSingle (stype d, stype m)); \
-      Nothing -> merge $ throwError $ Left BitwidthMismatch); \
-  QRIGHT(name) t (stype (l :: type l)) (stype (r :: type r)) = \
-    (case sameNat (Proxy @l) (Proxy @r) of \
-      Just Refl -> \
-        if r == 0 \
-          then merge $ throwError $ t (Right DivideByZero) \
-          else (case l `op` r of (d, m) -> mrgSingle (stype d, stype m)); \
-      Nothing -> merge $ throwError $ t (Left BitwidthMismatch))
-
-#if 1
-SAFE_DIVISION_CONCRETE_BV(IntN)
-SAFE_DIVISION_CONCRETE_BV(WordN)
-instance SafeDivision (Either BitwidthMismatch ArithException) SomeIntN where
-  SAFE_DIVISION_FUNC_SOME(SomeIntN, IntN, safeDiv, div)
-  SAFE_DIVISION_FUNC_SOME(SomeIntN, IntN, safeMod, mod)
-  SAFE_DIVISION_FUNC_SOME_DIVMOD(SomeIntN, IntN, safeDivMod, divMod)
-  SAFE_DIVISION_FUNC_SOME(SomeIntN, IntN, safeQuot, quot)
-  SAFE_DIVISION_FUNC_SOME(SomeIntN, IntN, safeRem, rem)
-  SAFE_DIVISION_FUNC_SOME_DIVMOD(SomeIntN, IntN, safeQuotRem, quotRem)
-
-instance SafeDivision (Either BitwidthMismatch ArithException) SomeWordN where
-  SAFE_DIVISION_FUNC_SOME(SomeWordN, WordN, safeDiv, div)
-  SAFE_DIVISION_FUNC_SOME(SomeWordN, WordN, safeMod, mod)
-  SAFE_DIVISION_FUNC_SOME_DIVMOD(SomeWordN, WordN, safeDivMod, divMod)
-  SAFE_DIVISION_FUNC_SOME(SomeWordN, WordN, safeQuot, quot)
-  SAFE_DIVISION_FUNC_SOME(SomeWordN, WordN, safeRem, rem)
-  SAFE_DIVISION_FUNC_SOME_DIVMOD(SomeWordN, WordN, safeQuotRem, quotRem)
-#endif
-
--- | Safe division with monadic error handling in multi-path
--- execution. These procedures throw an exception when overflow or underflow happens.
--- The result should be able to handle errors with `MonadError`.
-class (SOrd a, Num a, Mergeable a, Mergeable e) => SafeLinearArith e a | a -> e where
-  -- | Safe '+' with monadic error handling in multi-path execution.
-  -- Overflows or underflows are treated as errors.
-  --
-  -- >>> safeAdd (ssym "a") (ssym "b") :: ExceptT ArithException UnionM SymInteger
-  -- ExceptT {Right (+ a b)}
-  -- >>> safeAdd (ssym "a") (ssym "b") :: ExceptT ArithException UnionM (SymIntN 4)
-  -- ExceptT {If (ite (< 0x0 a) (&& (< 0x0 b) (< (+ a b) 0x0)) (&& (< a 0x0) (&& (< b 0x0) (<= 0x0 (+ a b))))) (If (< 0x0 a) (Left arithmetic overflow) (Left arithmetic underflow)) (Right (+ a b))}
-  safeAdd :: (MonadError e uf, MonadUnion uf) => a -> a -> uf a
-
-  -- | Safe 'negate' with monadic error handling in multi-path execution.
-  -- Overflows or underflows are treated as errors.
-  --
-  -- >>> safeNeg (ssym "a") :: ExceptT ArithException UnionM SymInteger
-  -- ExceptT {Right (- a)}
-  -- >>> safeNeg (ssym "a") :: ExceptT ArithException UnionM (SymIntN 4)
-  -- ExceptT {If (= a 0x8) (Left arithmetic overflow) (Right (- a))}
-  safeNeg :: (MonadError e uf, MonadUnion uf) => a -> uf a
-
-  -- | Safe '-' with monadic error handling in multi-path execution.
-  -- Overflows or underflows are treated as errors.
-  --
-  -- >>> safeMinus (ssym "a") (ssym "b") :: ExceptT ArithException UnionM SymInteger
-  -- ExceptT {Right (+ a (- b))}
-  -- >>> safeMinus (ssym "a") (ssym "b") :: ExceptT ArithException UnionM (SymIntN 4)
-  -- ExceptT {If (ite (<= 0x0 a) (&& (< b 0x0) (< (+ a (- b)) 0x0)) (&& (< a 0x0) (&& (< 0x0 b) (< 0x0 (+ a (- b)))))) (If (<= 0x0 a) (Left arithmetic overflow) (Left arithmetic underflow)) (Right (+ a (- b)))}
-  safeMinus :: (MonadError e uf, MonadUnion uf) => a -> a -> uf a
-
-  -- | Safe '+' with monadic error handling in multi-path execution.
-  -- Overflows or underflows are treated as errors.
-  -- The error is transformed.
-  safeAdd' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf a
-
-  -- | Safe 'negate' with monadic error handling in multi-path execution.
-  -- Overflows or underflows are treated as errors.
-  -- The error is transformed.
-  safeNeg' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> uf a
-
-  -- | Safe '-' with monadic error handling in multi-path execution.
-  -- Overflows or underflows are treated as errors.
-  -- The error is transformed.
-  safeMinus' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf a
-
-instance SafeLinearArith ArithException Integer where
-  safeAdd l r = mrgSingle (l + r)
-  safeNeg l = mrgSingle (-l)
-  safeMinus l r = mrgSingle (l - r)
-  safeAdd' _ l r = mrgSingle (l + r)
-  safeNeg' _ l = mrgSingle (-l)
-  safeMinus' _ l r = mrgSingle (l - r)
-
-#define SAFE_LINARITH_SIGNED_CONCRETE_BODY \
-  safeAdd l r = let res = l + r in \
-    mrgIf (con $ l > 0 && r > 0 && res < 0) \
-          (throwError Overflow) \
-          (mrgIf (con $ l < 0 && r < 0 && res >= 0) \
-                 (throwError Underflow) \
-                 (return res));\
-  safeAdd' t' l r = let res = l + r in \
-    mrgIf (con $ l > 0 && r > 0 && res < 0) \
-          (throwError (t' Overflow)) \
-          (mrgIf (con $ l < 0 && r < 0 && res >= 0) \
-                 (throwError (t' Underflow)) \
-                 (return res)); \
-  safeMinus l r = let res = l - r in \
-    mrgIf (con $ l >= 0 && r < 0 && res < 0) \
-          (throwError Overflow) \
-          (mrgIf (con $ l < 0 && r > 0 && res > 0) \
-                 (throwError Underflow) \
-                 (return res));\
-  safeMinus' t' l r = let res = l - r in \
-    mrgIf (con $ l >= 0 && r < 0 && res < 0) \
-          (throwError (t' Overflow)) \
-          (mrgIf (con $ l < 0 && r > 0 && res > 0) \
-                 (throwError (t' Underflow)) \
-                 (return res)); \
-  safeNeg v = mrgIf (con $ v == minBound) (throwError Overflow) (return $ -v);\
-  safeNeg' t' v = mrgIf (con $ v == minBound) (throwError (t' Overflow)) (return $ -v)
-
-#define SAFE_LINARITH_SIGNED_CONCRETE(type) \
-instance SafeLinearArith ArithException type where \
-  SAFE_LINARITH_SIGNED_CONCRETE_BODY
-
-#define SAFE_LINARITH_SIGNED_BV_CONCRETE(type) \
-instance (KnownNat n, 1 <= n) => SafeLinearArith ArithException (type n) where \
-  SAFE_LINARITH_SIGNED_CONCRETE_BODY
-
-#define SAFE_LINARITH_UNSIGNED_CONCRETE_BODY \
-  safeAdd l r = let res = l + r in \
-    mrgIf (con $ l > res || r > res) \
-          (throwError Overflow) \
-          (return res);\
-  safeAdd' t' l r = let res = l + r in \
-    mrgIf (con $ l > res || r > res) \
-          (throwError (t' Overflow)) \
-          (return res); \
-  safeMinus l r = \
-    mrgIf (con $ r > l) \
-          (throwError Underflow) \
-          (return $ l - r);\
-  safeMinus' t' l r = \
-    mrgIf (con $ r > l) \
-          (throwError $ t' Underflow) \
-          (return $ l - r);\
-  safeNeg v = mrgIf (con $ v /= 0) (throwError Underflow) (return $ -v);\
-  safeNeg' t' v = mrgIf (con $ v /= 0) (throwError (t' Underflow)) (return $ -v)
-
-#define SAFE_LINARITH_UNSIGNED_CONCRETE(type) \
-instance SafeLinearArith ArithException type where \
-  SAFE_LINARITH_UNSIGNED_CONCRETE_BODY
-
-#define SAFE_LINARITH_UNSIGNED_BV_CONCRETE(type) \
-instance (KnownNat n, 1 <= n) => SafeLinearArith ArithException (type n) where \
-  SAFE_LINARITH_UNSIGNED_CONCRETE_BODY
-
-#define SAFE_LINARITH_SOME_CONCRETE(type, ctype) \
-instance SafeLinearArith (Either BitwidthMismatch ArithException) type where \
-  safeAdd (type (l :: ctype l)) (type (r :: ctype r)) = merge (\
-    case sameNat (Proxy @l) (Proxy @r) of \
-      Just Refl -> type <$> safeAdd' Right l r; \
-      _ -> throwError $ Left BitwidthMismatch); \
-  safeAdd' t (type (l :: ctype l)) (type (r :: ctype r)) = merge (\
-    case sameNat (Proxy @l) (Proxy @r) of \
-      Just Refl -> type <$> safeAdd' (t . Right) l r; \
-      _ -> let t' = t; _ = t' in throwError $ t' $ Left BitwidthMismatch); \
-  safeMinus (type (l :: ctype l)) (type (r :: ctype r)) = merge (\
-    case sameNat (Proxy @l) (Proxy @r) of \
-      Just Refl -> type <$> safeMinus' Right l r; \
-      _ -> throwError $ Left BitwidthMismatch); \
-  safeMinus' t (type (l :: ctype l)) (type (r :: ctype r)) = merge (\
-    case sameNat (Proxy @l) (Proxy @r) of \
-      Just Refl -> type <$> safeMinus' (t . Right) l r; \
-      _ -> let t' = t; _ = t' in throwError $ t' $ Left BitwidthMismatch); \
-  safeNeg (type l) = merge $ type <$> safeNeg' Right l; \
-  safeNeg' t (type l) = merge $ type <$> safeNeg' (t . Right) l
-
-#if 1
-SAFE_LINARITH_SIGNED_CONCRETE(Int8)
-SAFE_LINARITH_SIGNED_CONCRETE(Int16)
-SAFE_LINARITH_SIGNED_CONCRETE(Int32)
-SAFE_LINARITH_SIGNED_CONCRETE(Int64)
-SAFE_LINARITH_SIGNED_CONCRETE(Int)
-SAFE_LINARITH_SIGNED_BV_CONCRETE(IntN)
-SAFE_LINARITH_SOME_CONCRETE(SomeIntN, IntN)
-SAFE_LINARITH_UNSIGNED_CONCRETE(Word8)
-SAFE_LINARITH_UNSIGNED_CONCRETE(Word16)
-SAFE_LINARITH_UNSIGNED_CONCRETE(Word32)
-SAFE_LINARITH_UNSIGNED_CONCRETE(Word64)
-SAFE_LINARITH_UNSIGNED_CONCRETE(Word)
-SAFE_LINARITH_UNSIGNED_BV_CONCRETE(WordN)
-SAFE_LINARITH_SOME_CONCRETE(SomeWordN, WordN)
-#endif
-
--- | Aggregation for the operations on symbolic integer types
-class (Num a, SEq a, SOrd a, Solvable Integer a) => SymIntegerOp a
diff --git a/src/Grisette/Core/Data/Class/SafeDivision.hs b/src/Grisette/Core/Data/Class/SafeDivision.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Core/Data/Class/SafeDivision.hs
@@ -0,0 +1,379 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- |
+-- Module      :   Grisette.Core.Data.Class.SafeDivision
+-- Copyright   :   (c) Sirui Lu 2021-2023
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Core.Data.Class.SafeDivision
+  ( ArithException (..),
+    SafeDivision (..),
+  )
+where
+
+import Control.Exception (ArithException (DivideByZero, Overflow, Underflow))
+import Control.Monad.Except (MonadError (throwError))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Typeable (Proxy (Proxy), type (:~:) (Refl))
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.TypeNats (KnownNat, sameNat, type (<=))
+import Grisette.Core.Control.Monad.Union (MonadUnion)
+import Grisette.Core.Data.BV
+  ( BitwidthMismatch (BitwidthMismatch),
+    IntN,
+    SomeIntN (SomeIntN),
+    SomeWordN (SomeWordN),
+    WordN,
+  )
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp ((.&&), (.||)))
+import Grisette.Core.Data.Class.Mergeable (Mergeable)
+import Grisette.Core.Data.Class.SEq (SEq ((.==)))
+import Grisette.Core.Data.Class.SOrd
+  ( SOrd ((.<), (.<=), (.>), (.>=)),
+  )
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( merge,
+    mrgIf,
+    mrgSingle,
+  )
+import Grisette.Core.Data.Class.Solvable (Solvable (con))
+import Grisette.IR.SymPrim.Data.Prim.PartialEval.Integral
+  ( pevalDivBoundedIntegralTerm,
+    pevalDivIntegralTerm,
+    pevalModBoundedIntegralTerm,
+    pevalModIntegralTerm,
+    pevalQuotBoundedIntegralTerm,
+    pevalQuotIntegralTerm,
+    pevalRemBoundedIntegralTerm,
+    pevalRemIntegralTerm,
+  )
+import Grisette.IR.SymPrim.Data.SymPrim
+  ( SymIntN (SymIntN),
+    SymInteger (SymInteger),
+    SymWordN (SymWordN),
+  )
+
+-- $setup
+-- >>> import Grisette.Core
+-- >>> import Grisette.IR.SymPrim
+-- >>> import Control.Monad.Except
+
+-- | Safe division with monadic error handling in multi-path
+-- execution. These procedures throw an exception when the
+-- divisor is zero. The result should be able to handle errors with
+-- `MonadError`.
+class (SOrd a, Num a, Mergeable a, Mergeable e) => SafeDivision e a | a -> e where
+  -- | Safe signed 'div' with monadic error handling in multi-path execution.
+  --
+  -- >>> safeDiv (ssym "a") (ssym "b") :: ExceptT ArithException UnionM SymInteger
+  -- ExceptT {If (= b 0) (Left divide by zero) (Right (div a b))}
+  safeDiv :: (MonadError e uf, MonadUnion uf) => a -> a -> uf a
+  safeDiv l r = do
+    (d, _) <- safeDivMod l r
+    mrgSingle d
+
+  -- | Safe signed 'mod' with monadic error handling in multi-path execution.
+  --
+  -- >>> safeMod (ssym "a") (ssym "b") :: ExceptT ArithException UnionM SymInteger
+  -- ExceptT {If (= b 0) (Left divide by zero) (Right (mod a b))}
+  safeMod :: (MonadError e uf, MonadUnion uf) => a -> a -> uf a
+  safeMod l r = do
+    (_, m) <- safeDivMod l r
+    mrgSingle m
+
+  -- | Safe signed 'divMod' with monadic error handling in multi-path execution.
+  --
+  -- >>> safeDivMod (ssym "a") (ssym "b") :: ExceptT ArithException UnionM (SymInteger, SymInteger)
+  -- ExceptT {If (= b 0) (Left divide by zero) (Right ((div a b),(mod a b)))}
+  safeDivMod :: (MonadError e uf, MonadUnion uf) => a -> a -> uf (a, a)
+  safeDivMod l r = do
+    d <- safeDiv l r
+    m <- safeMod l r
+    mrgSingle (d, m)
+
+  -- | Safe signed 'quot' with monadic error handling in multi-path execution.
+  safeQuot :: (MonadError e uf, MonadUnion uf) => a -> a -> uf a
+  safeQuot l r = do
+    (d, m) <- safeDivMod l r
+    mrgIf
+      ((l .>= 0 .&& r .> 0) .|| (l .<= 0 .&& r .< 0) .|| m .== 0)
+      (mrgSingle d)
+      (mrgSingle $ d + 1)
+
+  -- | Safe signed 'rem' with monadic error handling in multi-path execution.
+  safeRem :: (MonadError e uf, MonadUnion uf) => a -> a -> uf a
+  safeRem l r = do
+    (_, m) <- safeDivMod l r
+    mrgIf
+      ((l .>= 0 .&& r .> 0) .|| (l .<= 0 .&& r .< 0) .|| m .== 0)
+      (mrgSingle m)
+      (mrgSingle $ m - r)
+
+  -- | Safe signed 'quotRem' with monadic error handling in multi-path execution.
+  safeQuotRem :: (MonadError e uf, MonadUnion uf) => a -> a -> uf (a, a)
+  safeQuotRem l r = do
+    (d, m) <- safeDivMod l r
+    mrgIf
+      ((l .>= 0 .&& r .> 0) .|| (l .<= 0 .&& r .< 0) .|| m .== 0)
+      (mrgSingle (d, m))
+      (mrgSingle (d + 1, m - r))
+
+  -- | Safe signed 'div' with monadic error handling in multi-path execution.
+  -- The error is transformed.
+  --
+  -- >>> safeDiv' (const ()) (ssym "a") (ssym "b") :: ExceptT () UnionM SymInteger
+  -- ExceptT {If (= b 0) (Left ()) (Right (div a b))}
+  safeDiv' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf a
+  safeDiv' t l r = do
+    (d, _) <- safeDivMod' t l r
+    mrgSingle d
+
+  -- | Safe signed 'mod' with monadic error handling in multi-path execution.
+  -- The error is transformed.
+  --
+  -- >>> safeMod' (const ()) (ssym "a") (ssym "b") :: ExceptT () UnionM SymInteger
+  -- ExceptT {If (= b 0) (Left ()) (Right (mod a b))}
+  safeMod' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf a
+  safeMod' t l r = do
+    (_, m) <- safeDivMod' t l r
+    mrgSingle m
+
+  -- | Safe signed 'divMod' with monadic error handling in multi-path execution.
+  -- The error is transformed.
+  --
+  -- >>> safeDivMod' (const ()) (ssym "a") (ssym "b") :: ExceptT () UnionM (SymInteger, SymInteger)
+  -- ExceptT {If (= b 0) (Left ()) (Right ((div a b),(mod a b)))}
+  safeDivMod' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf (a, a)
+  safeDivMod' t l r = do
+    d <- safeDiv' t l r
+    m <- safeMod' t l r
+    mrgSingle (d, m)
+
+  -- | Safe signed 'quot' with monadic error handling in multi-path execution.
+  -- The error is transformed.
+  safeQuot' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf a
+  safeQuot' t l r = do
+    (d, m) <- safeDivMod' t l r
+    mrgIf
+      ((l .>= 0 .&& r .> 0) .|| (l .<= 0 .&& r .< 0) .|| m .== 0)
+      (mrgSingle d)
+      (mrgSingle $ d + 1)
+
+  -- | Safe signed 'rem' with monadic error handling in multi-path execution.
+  -- The error is transformed.
+  safeRem' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf a
+  safeRem' t l r = do
+    (_, m) <- safeDivMod' t l r
+    mrgIf
+      ((l .>= 0 .&& r .> 0) .|| (l .<= 0 .&& r .< 0) .|| m .== 0)
+      (mrgSingle m)
+      (mrgSingle $ m - r)
+
+  -- | Safe signed 'quotRem' with monadic error handling in multi-path execution.
+  -- The error is transformed.
+  safeQuotRem' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf (a, a)
+  safeQuotRem' t l r = do
+    (d, m) <- safeDivMod' t l r
+    mrgIf
+      ((l .>= 0 .&& r .> 0) .|| (l .<= 0 .&& r .< 0) .|| m .== 0)
+      (mrgSingle (d, m))
+      (mrgSingle (d + 1, m - r))
+
+  {-# MINIMAL (safeDivMod | (safeDiv, safeMod)), (safeDivMod' | (safeDiv', safeMod')) #-}
+
+#define QUOTE() '
+#define QID(a) a
+#define QRIGHT(a) QID(a)'
+
+#define QRIGHTT(a) QID(a)' t'
+#define QRIGHTU(a) QID(a)' _'
+
+#define SAFE_DIVISION_CONCRETE_FUNC(name, op) \
+name _ r | r == 0 = merge $ throwError DivideByZero; \
+name l r = mrgSingle $ l `op` r; \
+QRIGHTT(name) _ r | r == 0 = let _ = t' in merge $ throwError (t' DivideByZero); \
+QRIGHTU(name) l r = mrgSingle $ l `op` r
+
+#define SAFE_DIVISION_CONCRETE(type) \
+instance SafeDivision ArithException type where \
+  SAFE_DIVISION_CONCRETE_FUNC(safeDiv, div); \
+  SAFE_DIVISION_CONCRETE_FUNC(safeMod, mod); \
+  SAFE_DIVISION_CONCRETE_FUNC(safeDivMod, divMod); \
+  SAFE_DIVISION_CONCRETE_FUNC(safeQuot, quot); \
+  SAFE_DIVISION_CONCRETE_FUNC(safeRem, rem); \
+  SAFE_DIVISION_CONCRETE_FUNC(safeQuotRem, quotRem)
+
+#define SAFE_DIVISION_CONCRETE_BV(type) \
+instance (KnownNat n, 1 <= n) => SafeDivision ArithException (type n) where \
+  SAFE_DIVISION_CONCRETE_FUNC(safeDiv, div); \
+  SAFE_DIVISION_CONCRETE_FUNC(safeMod, mod); \
+  SAFE_DIVISION_CONCRETE_FUNC(safeDivMod, divMod); \
+  SAFE_DIVISION_CONCRETE_FUNC(safeQuot, quot); \
+  SAFE_DIVISION_CONCRETE_FUNC(safeRem, rem); \
+  SAFE_DIVISION_CONCRETE_FUNC(safeQuotRem, quotRem)
+
+#if 1
+SAFE_DIVISION_CONCRETE(Integer)
+SAFE_DIVISION_CONCRETE(Int8)
+SAFE_DIVISION_CONCRETE(Int16)
+SAFE_DIVISION_CONCRETE(Int32)
+SAFE_DIVISION_CONCRETE(Int64)
+SAFE_DIVISION_CONCRETE(Int)
+SAFE_DIVISION_CONCRETE(Word8)
+SAFE_DIVISION_CONCRETE(Word16)
+SAFE_DIVISION_CONCRETE(Word32)
+SAFE_DIVISION_CONCRETE(Word64)
+SAFE_DIVISION_CONCRETE(Word)
+#endif
+
+#define SAFE_DIVISION_CONCRETE_FUNC_SOME(stype, type, name, op) \
+  name (stype (l :: type l)) (stype (r :: type r)) = \
+    (case sameNat (Proxy @l) (Proxy @r) of \
+      Just Refl -> \
+        if r == 0 \
+          then merge $ throwError $ Right DivideByZero \
+          else mrgSingle $ stype $ l `op` r; \
+      Nothing -> merge $ throwError $ Left BitwidthMismatch); \
+  QRIGHT(name) t (stype (l :: type l)) (stype (r :: type r)) = \
+    (case sameNat (Proxy @l) (Proxy @r) of \
+      Just Refl -> \
+        if r == 0 \
+          then merge $ throwError $ t (Right DivideByZero) \
+          else mrgSingle $ stype $ l `op` r; \
+      Nothing -> merge $ throwError $ t (Left BitwidthMismatch))
+
+#define SAFE_DIVISION_CONCRETE_FUNC_SOME_DIVMOD(stype, type, name, op) \
+  name (stype (l :: type l)) (stype (r :: type r)) = \
+    (case sameNat (Proxy @l) (Proxy @r) of \
+      Just Refl -> \
+        if r == 0 \
+          then merge $ throwError $ Right DivideByZero \
+          else (case l `op` r of (d, m) -> mrgSingle (stype d, stype m)); \
+      Nothing -> merge $ throwError $ Left BitwidthMismatch); \
+  QRIGHT(name) t (stype (l :: type l)) (stype (r :: type r)) = \
+    (case sameNat (Proxy @l) (Proxy @r) of \
+      Just Refl -> \
+        if r == 0 \
+          then merge $ throwError $ t (Right DivideByZero) \
+          else (case l `op` r of (d, m) -> mrgSingle (stype d, stype m)); \
+      Nothing -> merge $ throwError $ t (Left BitwidthMismatch))
+
+#if 1
+SAFE_DIVISION_CONCRETE_BV(IntN)
+SAFE_DIVISION_CONCRETE_BV(WordN)
+instance SafeDivision (Either BitwidthMismatch ArithException) SomeIntN where
+  SAFE_DIVISION_CONCRETE_FUNC_SOME(SomeIntN, IntN, safeDiv, div)
+  SAFE_DIVISION_CONCRETE_FUNC_SOME(SomeIntN, IntN, safeMod, mod)
+  SAFE_DIVISION_CONCRETE_FUNC_SOME_DIVMOD(SomeIntN, IntN, safeDivMod, divMod)
+  SAFE_DIVISION_CONCRETE_FUNC_SOME(SomeIntN, IntN, safeQuot, quot)
+  SAFE_DIVISION_CONCRETE_FUNC_SOME(SomeIntN, IntN, safeRem, rem)
+  SAFE_DIVISION_CONCRETE_FUNC_SOME_DIVMOD(SomeIntN, IntN, safeQuotRem, quotRem)
+
+instance SafeDivision (Either BitwidthMismatch ArithException) SomeWordN where
+  SAFE_DIVISION_CONCRETE_FUNC_SOME(SomeWordN, WordN, safeDiv, div)
+  SAFE_DIVISION_CONCRETE_FUNC_SOME(SomeWordN, WordN, safeMod, mod)
+  SAFE_DIVISION_CONCRETE_FUNC_SOME_DIVMOD(SomeWordN, WordN, safeDivMod, divMod)
+  SAFE_DIVISION_CONCRETE_FUNC_SOME(SomeWordN, WordN, safeQuot, quot)
+  SAFE_DIVISION_CONCRETE_FUNC_SOME(SomeWordN, WordN, safeRem, rem)
+  SAFE_DIVISION_CONCRETE_FUNC_SOME_DIVMOD(SomeWordN, WordN, safeQuotRem, quotRem)
+#endif
+
+#define SAFE_DIVISION_SYMBOLIC_FUNC(name, type, op) \
+name (type l) rs@(type r) = \
+  mrgIf \
+    (rs .== con 0) \
+    (throwError DivideByZero) \
+    (mrgSingle $ type $ op l r); \
+QRIGHT(name) t (type l) rs@(type r) = \
+  mrgIf \
+    (rs .== con 0) \
+    (throwError (t DivideByZero)) \
+    (mrgSingle $ type $ op l r)
+
+#define SAFE_DIVISION_SYMBOLIC_FUNC2(name, type, op1, op2) \
+name (type l) rs@(type r) = \
+  mrgIf \
+    (rs .== con 0) \
+    (throwError DivideByZero) \
+    (mrgSingle (type $ op1 l r, type $ op2 l r)); \
+QRIGHT(name) t (type l) rs@(type r) = \
+  mrgIf \
+    (rs .== con 0) \
+    (throwError (t DivideByZero)) \
+    (mrgSingle (type $ op1 l r, type $ op2 l r))
+
+#if 1
+instance SafeDivision ArithException SymInteger where
+  SAFE_DIVISION_SYMBOLIC_FUNC(safeDiv, SymInteger, pevalDivIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC(safeMod, SymInteger, pevalModIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC(safeQuot, SymInteger, pevalQuotIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC(safeRem, SymInteger, pevalRemIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC2(safeDivMod, SymInteger, pevalDivIntegralTerm, pevalModIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC2(safeQuotRem, SymInteger, pevalQuotIntegralTerm, pevalRemIntegralTerm)
+#endif
+
+#define SAFE_DIVISION_SYMBOLIC_FUNC_BOUNDED_SIGNED(name, type, op) \
+name ls@(type l) rs@(type r) = \
+  mrgIf \
+    (rs .== con 0) \
+    (throwError DivideByZero) \
+    (mrgIf (rs .== con (-1) .&& ls .== con minBound) \
+      (throwError Overflow) \
+      (mrgSingle $ type $ op l r)); \
+QRIGHT(name) t ls@(type l) rs@(type r) = \
+  mrgIf \
+    (rs .== con 0) \
+    (throwError (t DivideByZero)) \
+    (mrgIf (rs .== con (-1) .&& ls .== con minBound) \
+      (throwError (t Overflow)) \
+      (mrgSingle $ type $ op l r))
+
+#define SAFE_DIVISION_SYMBOLIC_FUNC2_BOUNDED_SIGNED(name, type, op1, op2) \
+name ls@(type l) rs@(type r) = \
+  mrgIf \
+    (rs .== con 0) \
+    (throwError DivideByZero) \
+    (mrgIf (rs .== con (-1) .&& ls .== con minBound) \
+      (throwError Overflow) \
+      (mrgSingle (type $ op1 l r, type $ op2 l r))); \
+QRIGHT(name) t ls@(type l) rs@(type r) = \
+  mrgIf \
+    (rs .== con 0) \
+    (throwError (t DivideByZero)) \
+    (mrgIf (rs .== con (-1) .&& ls .== con minBound) \
+      (throwError (t Overflow)) \
+      (mrgSingle (type $ op1 l r, type $ op2 l r)))
+
+#if 1
+instance (KnownNat n, 1 <= n) => SafeDivision ArithException (SymIntN n) where
+  SAFE_DIVISION_SYMBOLIC_FUNC_BOUNDED_SIGNED(safeDiv, SymIntN, pevalDivBoundedIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC(safeMod, SymIntN, pevalModBoundedIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC_BOUNDED_SIGNED(safeQuot, SymIntN, pevalQuotBoundedIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC(safeRem, SymIntN, pevalRemBoundedIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC2_BOUNDED_SIGNED(safeDivMod, SymIntN, pevalDivBoundedIntegralTerm, pevalModBoundedIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC2_BOUNDED_SIGNED(safeQuotRem, SymIntN, pevalQuotBoundedIntegralTerm, pevalRemBoundedIntegralTerm)
+#endif
+
+#if 1
+instance (KnownNat n, 1 <= n) => SafeDivision ArithException (SymWordN n) where
+  SAFE_DIVISION_SYMBOLIC_FUNC(safeDiv, SymWordN, pevalDivIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC(safeMod, SymWordN, pevalModIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC(safeQuot, SymWordN, pevalQuotIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC(safeRem, SymWordN, pevalRemIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC2(safeDivMod, SymWordN, pevalDivIntegralTerm, pevalModIntegralTerm)
+  SAFE_DIVISION_SYMBOLIC_FUNC2(safeQuotRem, SymWordN, pevalQuotIntegralTerm, pevalRemIntegralTerm)
+#endif
diff --git a/src/Grisette/Core/Data/Class/SafeLinearArith.hs b/src/Grisette/Core/Data/Class/SafeLinearArith.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Core/Data/Class/SafeLinearArith.hs
@@ -0,0 +1,307 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- |
+-- Module      :   Grisette.Core.Data.Class.SafeLinearArith
+-- Copyright   :   (c) Sirui Lu 2021-2023
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Core.Data.Class.SafeLinearArith
+  ( ArithException (..),
+    SafeLinearArith (..),
+  )
+where
+
+import Control.Exception (ArithException (DivideByZero, Overflow, Underflow))
+import Control.Monad.Except (MonadError (throwError))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Typeable (Proxy (Proxy), type (:~:) (Refl))
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.TypeNats (KnownNat, sameNat, type (<=))
+import Grisette.Core.Control.Monad.Union (MonadUnion)
+import Grisette.Core.Data.BV
+  ( BitwidthMismatch (BitwidthMismatch),
+    IntN,
+    SomeIntN (SomeIntN),
+    SomeWordN (SomeWordN),
+    WordN,
+  )
+import Grisette.Core.Data.Class.LogicalOp
+  ( LogicalOp ((.&&), (.||)),
+  )
+import Grisette.Core.Data.Class.Mergeable (Mergeable)
+import Grisette.Core.Data.Class.SEq (SEq ((./=), (.==)))
+import Grisette.Core.Data.Class.SOrd (SOrd ((.<), (.>), (.>=)))
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( merge,
+    mrgIf,
+    mrgSingle,
+  )
+import Grisette.Core.Data.Class.Solvable (Solvable (con))
+import Grisette.IR.SymPrim.Data.SymPrim
+  ( SymIntN,
+    SymInteger,
+    SymWordN,
+  )
+
+-- $setup
+-- >>> import Grisette.Core
+-- >>> import Grisette.IR.SymPrim
+-- >>> import Control.Monad.Except
+
+-- | Safe division with monadic error handling in multi-path
+-- execution. These procedures throw an exception when overflow or underflow happens.
+-- The result should be able to handle errors with `MonadError`.
+class (SOrd a, Num a, Mergeable a, Mergeable e) => SafeLinearArith e a | a -> e where
+  -- | Safe '+' with monadic error handling in multi-path execution.
+  -- Overflows or underflows are treated as errors.
+  --
+  -- >>> safeAdd (ssym "a") (ssym "b") :: ExceptT ArithException UnionM SymInteger
+  -- ExceptT {Right (+ a b)}
+  -- >>> safeAdd (ssym "a") (ssym "b") :: ExceptT ArithException UnionM (SymIntN 4)
+  -- ExceptT {If (ite (< 0x0 a) (&& (< 0x0 b) (< (+ a b) 0x0)) (&& (< a 0x0) (&& (< b 0x0) (<= 0x0 (+ a b))))) (If (< 0x0 a) (Left arithmetic overflow) (Left arithmetic underflow)) (Right (+ a b))}
+  safeAdd :: (MonadError e uf, MonadUnion uf) => a -> a -> uf a
+
+  -- | Safe 'negate' with monadic error handling in multi-path execution.
+  -- Overflows or underflows are treated as errors.
+  --
+  -- >>> safeNeg (ssym "a") :: ExceptT ArithException UnionM SymInteger
+  -- ExceptT {Right (- a)}
+  -- >>> safeNeg (ssym "a") :: ExceptT ArithException UnionM (SymIntN 4)
+  -- ExceptT {If (= a 0x8) (Left arithmetic overflow) (Right (- a))}
+  safeNeg :: (MonadError e uf, MonadUnion uf) => a -> uf a
+
+  -- | Safe '-' with monadic error handling in multi-path execution.
+  -- Overflows or underflows are treated as errors.
+  --
+  -- >>> safeMinus (ssym "a") (ssym "b") :: ExceptT ArithException UnionM SymInteger
+  -- ExceptT {Right (+ a (- b))}
+  -- >>> safeMinus (ssym "a") (ssym "b") :: ExceptT ArithException UnionM (SymIntN 4)
+  -- ExceptT {If (ite (<= 0x0 a) (&& (< b 0x0) (< (+ a (- b)) 0x0)) (&& (< a 0x0) (&& (< 0x0 b) (< 0x0 (+ a (- b)))))) (If (<= 0x0 a) (Left arithmetic overflow) (Left arithmetic underflow)) (Right (+ a (- b)))}
+  safeMinus :: (MonadError e uf, MonadUnion uf) => a -> a -> uf a
+
+  -- | Safe '+' with monadic error handling in multi-path execution.
+  -- Overflows or underflows are treated as errors.
+  -- The error is transformed.
+  safeAdd' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf a
+
+  -- | Safe 'negate' with monadic error handling in multi-path execution.
+  -- Overflows or underflows are treated as errors.
+  -- The error is transformed.
+  safeNeg' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> uf a
+
+  -- | Safe '-' with monadic error handling in multi-path execution.
+  -- Overflows or underflows are treated as errors.
+  -- The error is transformed.
+  safeMinus' :: (MonadError e' uf, MonadUnion uf, Mergeable e') => (e -> e') -> a -> a -> uf a
+
+instance SafeLinearArith ArithException Integer where
+  safeAdd l r = mrgSingle (l + r)
+  safeNeg l = mrgSingle (-l)
+  safeMinus l r = mrgSingle (l - r)
+  safeAdd' _ l r = mrgSingle (l + r)
+  safeNeg' _ l = mrgSingle (-l)
+  safeMinus' _ l r = mrgSingle (l - r)
+
+#define SAFE_LINARITH_SIGNED_CONCRETE_BODY \
+  safeAdd l r = let res = l + r in \
+    mrgIf (con $ l > 0 && r > 0 && res < 0) \
+          (throwError Overflow) \
+          (mrgIf (con $ l < 0 && r < 0 && res >= 0) \
+                 (throwError Underflow) \
+                 (return res));\
+  safeAdd' t' l r = let res = l + r in \
+    mrgIf (con $ l > 0 && r > 0 && res < 0) \
+          (throwError (t' Overflow)) \
+          (mrgIf (con $ l < 0 && r < 0 && res >= 0) \
+                 (throwError (t' Underflow)) \
+                 (return res)); \
+  safeMinus l r = let res = l - r in \
+    mrgIf (con $ l >= 0 && r < 0 && res < 0) \
+          (throwError Overflow) \
+          (mrgIf (con $ l < 0 && r > 0 && res > 0) \
+                 (throwError Underflow) \
+                 (return res));\
+  safeMinus' t' l r = let res = l - r in \
+    mrgIf (con $ l >= 0 && r < 0 && res < 0) \
+          (throwError (t' Overflow)) \
+          (mrgIf (con $ l < 0 && r > 0 && res > 0) \
+                 (throwError (t' Underflow)) \
+                 (return res)); \
+  safeNeg v = mrgIf (con $ v == minBound) (throwError Overflow) (return $ -v);\
+  safeNeg' t' v = mrgIf (con $ v == minBound) (throwError (t' Overflow)) (return $ -v)
+
+#define SAFE_LINARITH_SIGNED_CONCRETE(type) \
+instance SafeLinearArith ArithException type where \
+  SAFE_LINARITH_SIGNED_CONCRETE_BODY
+
+#define SAFE_LINARITH_SIGNED_BV_CONCRETE(type) \
+instance (KnownNat n, 1 <= n) => SafeLinearArith ArithException (type n) where \
+  SAFE_LINARITH_SIGNED_CONCRETE_BODY
+
+#define SAFE_LINARITH_UNSIGNED_CONCRETE_BODY \
+  safeAdd l r = let res = l + r in \
+    mrgIf (con $ l > res || r > res) \
+          (throwError Overflow) \
+          (return res);\
+  safeAdd' t' l r = let res = l + r in \
+    mrgIf (con $ l > res || r > res) \
+          (throwError (t' Overflow)) \
+          (return res); \
+  safeMinus l r = \
+    mrgIf (con $ r > l) \
+          (throwError Underflow) \
+          (return $ l - r);\
+  safeMinus' t' l r = \
+    mrgIf (con $ r > l) \
+          (throwError $ t' Underflow) \
+          (return $ l - r);\
+  safeNeg v = mrgIf (con $ v /= 0) (throwError Underflow) (return $ -v);\
+  safeNeg' t' v = mrgIf (con $ v /= 0) (throwError (t' Underflow)) (return $ -v)
+
+#define SAFE_LINARITH_UNSIGNED_CONCRETE(type) \
+instance SafeLinearArith ArithException type where \
+  SAFE_LINARITH_UNSIGNED_CONCRETE_BODY
+
+#define SAFE_LINARITH_UNSIGNED_BV_CONCRETE(type) \
+instance (KnownNat n, 1 <= n) => SafeLinearArith ArithException (type n) where \
+  SAFE_LINARITH_UNSIGNED_CONCRETE_BODY
+
+#define SAFE_LINARITH_SOME_CONCRETE(type, ctype) \
+instance SafeLinearArith (Either BitwidthMismatch ArithException) type where \
+  safeAdd (type (l :: ctype l)) (type (r :: ctype r)) = merge (\
+    case sameNat (Proxy @l) (Proxy @r) of \
+      Just Refl -> type <$> safeAdd' Right l r; \
+      _ -> throwError $ Left BitwidthMismatch); \
+  safeAdd' t (type (l :: ctype l)) (type (r :: ctype r)) = merge (\
+    case sameNat (Proxy @l) (Proxy @r) of \
+      Just Refl -> type <$> safeAdd' (t . Right) l r; \
+      _ -> let t' = t; _ = t' in throwError $ t' $ Left BitwidthMismatch); \
+  safeMinus (type (l :: ctype l)) (type (r :: ctype r)) = merge (\
+    case sameNat (Proxy @l) (Proxy @r) of \
+      Just Refl -> type <$> safeMinus' Right l r; \
+      _ -> throwError $ Left BitwidthMismatch); \
+  safeMinus' t (type (l :: ctype l)) (type (r :: ctype r)) = merge (\
+    case sameNat (Proxy @l) (Proxy @r) of \
+      Just Refl -> type <$> safeMinus' (t . Right) l r; \
+      _ -> let t' = t; _ = t' in throwError $ t' $ Left BitwidthMismatch); \
+  safeNeg (type l) = merge $ type <$> safeNeg' Right l; \
+  safeNeg' t (type l) = merge $ type <$> safeNeg' (t . Right) l
+
+#if 1
+SAFE_LINARITH_SIGNED_CONCRETE(Int8)
+SAFE_LINARITH_SIGNED_CONCRETE(Int16)
+SAFE_LINARITH_SIGNED_CONCRETE(Int32)
+SAFE_LINARITH_SIGNED_CONCRETE(Int64)
+SAFE_LINARITH_SIGNED_CONCRETE(Int)
+SAFE_LINARITH_SIGNED_BV_CONCRETE(IntN)
+SAFE_LINARITH_SOME_CONCRETE(SomeIntN, IntN)
+SAFE_LINARITH_UNSIGNED_CONCRETE(Word8)
+SAFE_LINARITH_UNSIGNED_CONCRETE(Word16)
+SAFE_LINARITH_UNSIGNED_CONCRETE(Word32)
+SAFE_LINARITH_UNSIGNED_CONCRETE(Word64)
+SAFE_LINARITH_UNSIGNED_CONCRETE(Word)
+SAFE_LINARITH_UNSIGNED_BV_CONCRETE(WordN)
+SAFE_LINARITH_SOME_CONCRETE(SomeWordN, WordN)
+#endif
+
+instance SafeLinearArith ArithException SymInteger where
+  safeAdd ls rs = mrgSingle $ ls + rs
+  safeAdd' _ ls rs = mrgSingle $ ls + rs
+  safeNeg v = mrgSingle $ -v
+  safeNeg' _ v = mrgSingle $ -v
+  safeMinus ls rs = mrgSingle $ ls - rs
+  safeMinus' _ ls rs = mrgSingle $ ls - rs
+
+instance (KnownNat n, 1 <= n) => SafeLinearArith ArithException (SymIntN n) where
+  safeAdd ls rs =
+    mrgIf
+      (ls .> 0)
+      (mrgIf (rs .> 0 .&& res .< 0) (throwError Overflow) (return res))
+      ( mrgIf
+          (ls .< 0 .&& rs .< 0 .&& res .>= 0)
+          (throwError Underflow)
+          (mrgSingle res)
+      )
+    where
+      res = ls + rs
+  safeAdd' f ls rs =
+    mrgIf
+      (ls .> 0)
+      (mrgIf (rs .> 0 .&& res .< 0) (throwError $ f Overflow) (return res))
+      ( mrgIf
+          (ls .< 0 .&& rs .< 0 .&& res .>= 0)
+          (throwError $ f Underflow)
+          (mrgSingle res)
+      )
+    where
+      res = ls + rs
+  safeNeg v = mrgIf (v .== con minBound) (throwError Overflow) (mrgSingle $ -v)
+  safeNeg' f v = mrgIf (v .== con minBound) (throwError $ f Overflow) (mrgSingle $ -v)
+  safeMinus ls rs =
+    mrgIf
+      (ls .>= 0)
+      (mrgIf (rs .< 0 .&& res .< 0) (throwError Overflow) (return res))
+      ( mrgIf
+          (ls .< 0 .&& rs .> 0 .&& res .> 0)
+          (throwError Underflow)
+          (mrgSingle res)
+      )
+    where
+      res = ls - rs
+  safeMinus' f ls rs =
+    mrgIf
+      (ls .>= 0)
+      (mrgIf (rs .< 0 .&& res .< 0) (throwError $ f Overflow) (return res))
+      ( mrgIf
+          (ls .< 0 .&& rs .> 0 .&& res .> 0)
+          (throwError $ f Underflow)
+          (mrgSingle res)
+      )
+    where
+      res = ls - rs
+
+instance (KnownNat n, 1 <= n) => SafeLinearArith ArithException (SymWordN n) where
+  safeAdd ls rs =
+    mrgIf
+      (ls .> res .|| rs .> res)
+      (throwError Overflow)
+      (mrgSingle res)
+    where
+      res = ls + rs
+  safeAdd' f ls rs =
+    mrgIf
+      (ls .> res .|| rs .> res)
+      (throwError $ f Overflow)
+      (mrgSingle res)
+    where
+      res = ls + rs
+  safeNeg v = mrgIf (v ./= 0) (throwError Underflow) (mrgSingle v)
+  safeNeg' f v = mrgIf (v ./= 0) (throwError $ f Underflow) (mrgSingle v)
+  safeMinus ls rs =
+    mrgIf
+      (rs .> ls)
+      (throwError Underflow)
+      (mrgSingle res)
+    where
+      res = ls - rs
+  safeMinus' f ls rs =
+    mrgIf
+      (rs .> ls)
+      (throwError $ f Underflow)
+      (mrgSingle res)
+    where
+      res = ls - rs
diff --git a/src/Grisette/Core/Data/Class/SafeSymRotate.hs b/src/Grisette/Core/Data/Class/SafeSymRotate.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Core/Data/Class/SafeSymRotate.hs
@@ -0,0 +1,110 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Grisette.Core.Data.Class.SafeSymRotate (SafeSymRotate (..)) where
+
+import Control.Exception (ArithException (Overflow))
+import Control.Monad.Error.Class (MonadError)
+import Data.Bits (Bits (rotateL, rotateR), FiniteBits (finiteBitSize))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.TypeLits (KnownNat, type (<=))
+import Grisette.Core.Control.Monad.Union (MonadUnion)
+import Grisette.Core.Data.BV (IntN, WordN)
+import Grisette.Core.Data.Class.Mergeable (Mergeable)
+import Grisette.Core.Data.Class.SOrd (SOrd ((.<)))
+import Grisette.Core.Data.Class.SimpleMergeable (UnionLike, mrgIf)
+import Grisette.Core.Data.Class.SymRotate (SymRotate)
+import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bits
+  ( pevalRotateLeftTerm,
+    pevalRotateRightTerm,
+  )
+import Grisette.IR.SymPrim.Data.SymPrim
+  ( SymIntN (SymIntN),
+    SymWordN (SymWordN),
+  )
+import Grisette.Lib.Control.Monad (mrgReturn)
+import Grisette.Lib.Control.Monad.Except (mrgThrowError)
+
+class (SymRotate a) => SafeSymRotate e a | a -> e where
+  safeSymRotateL :: (MonadError e m, UnionLike m) => a -> a -> m a
+  safeSymRotateL = safeSymRotateL' id
+  safeSymRotateR :: (MonadError e m, UnionLike m) => a -> a -> m a
+  safeSymRotateR = safeSymRotateR' id
+  safeSymRotateL' ::
+    (MonadError e' m, UnionLike m) => (e -> e') -> a -> a -> m a
+  safeSymRotateR' ::
+    (MonadError e' m, UnionLike m) => (e -> e') -> a -> a -> m a
+  {-# MINIMAL safeSymRotateL', safeSymRotateR' #-}
+
+-- | This function handles the case when the shift amount is out the range of
+-- `Int` correctly.
+safeSymRotateLConcreteNum ::
+  (MonadError e m, MonadUnion m, Integral a, FiniteBits a, Mergeable a) =>
+  e ->
+  a ->
+  a ->
+  m a
+safeSymRotateLConcreteNum e _ s | s < 0 = mrgThrowError e
+safeSymRotateLConcreteNum _ a s =
+  mrgReturn $ rotateL a (fromIntegral $ s `rem` fromIntegral (finiteBitSize s))
+
+-- | This function handles the case when the shift amount is out the range of
+-- `Int` correctly.
+safeSymRotateRConcreteNum ::
+  (MonadError e m, MonadUnion m, Integral a, FiniteBits a, Mergeable a) =>
+  e ->
+  a ->
+  a ->
+  m a
+safeSymRotateRConcreteNum e _ s | s < 0 = mrgThrowError e
+safeSymRotateRConcreteNum _ a s =
+  mrgReturn $ rotateR a (fromIntegral $ s `rem` fromIntegral (finiteBitSize s))
+
+#define SAFE_SYM_ROTATE_CONCRETE(T) \
+  instance SafeSymRotate ArithException T where \
+    safeSymRotateL' f = safeSymRotateLConcreteNum (f Overflow); \
+    safeSymRotateR' f = safeSymRotateRConcreteNum (f Overflow) \
+
+#if 1
+SAFE_SYM_ROTATE_CONCRETE(Word8)
+SAFE_SYM_ROTATE_CONCRETE(Word16)
+SAFE_SYM_ROTATE_CONCRETE(Word32)
+SAFE_SYM_ROTATE_CONCRETE(Word64)
+SAFE_SYM_ROTATE_CONCRETE(Word)
+SAFE_SYM_ROTATE_CONCRETE(Int8)
+SAFE_SYM_ROTATE_CONCRETE(Int16)
+SAFE_SYM_ROTATE_CONCRETE(Int32)
+SAFE_SYM_ROTATE_CONCRETE(Int64)
+SAFE_SYM_ROTATE_CONCRETE(Int)
+#endif
+
+instance (KnownNat n, 1 <= n) => SafeSymRotate ArithException (WordN n) where
+  safeSymRotateL' f = safeSymRotateLConcreteNum (f Overflow)
+  safeSymRotateR' f = safeSymRotateRConcreteNum (f Overflow)
+
+instance (KnownNat n, 1 <= n) => SafeSymRotate ArithException (IntN n) where
+  safeSymRotateL' f = safeSymRotateLConcreteNum (f Overflow)
+  safeSymRotateR' f = safeSymRotateRConcreteNum (f Overflow)
+
+instance (KnownNat n, 1 <= n) => SafeSymRotate ArithException (SymWordN n) where
+  safeSymRotateL' _ (SymWordN ta) (SymWordN tr) =
+    mrgReturn $ SymWordN $ pevalRotateLeftTerm ta tr
+  safeSymRotateR' _ (SymWordN ta) (SymWordN tr) =
+    mrgReturn $ SymWordN $ pevalRotateRightTerm ta tr
+
+instance (KnownNat n, 1 <= n) => SafeSymRotate ArithException (SymIntN n) where
+  safeSymRotateL' f (SymIntN ta) r@(SymIntN tr) =
+    mrgIf
+      (r .< 0)
+      (mrgThrowError $ f Overflow)
+      (mrgReturn $ SymIntN $ pevalRotateLeftTerm ta tr)
+  safeSymRotateR' f (SymIntN ta) r@(SymIntN tr) =
+    mrgIf
+      (r .< 0)
+      (mrgThrowError $ f Overflow)
+      (mrgReturn $ SymIntN $ pevalRotateRightTerm ta tr)
diff --git a/src/Grisette/Core/Data/Class/SafeSymShift.hs b/src/Grisette/Core/Data/Class/SafeSymShift.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Core/Data/Class/SafeSymShift.hs
@@ -0,0 +1,190 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Grisette.Core.Data.Class.SafeSymShift
+  ( SafeSymShift (..),
+  )
+where
+
+import Control.Exception (ArithException (Overflow))
+import Control.Monad.Error.Class (MonadError)
+import Data.Bits (Bits (shiftL, shiftR), FiniteBits (finiteBitSize))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.TypeLits (KnownNat, type (<=))
+import Grisette.Core.Control.Monad.Union (MonadUnion)
+import Grisette.Core.Data.BV (IntN, WordN)
+import Grisette.Core.Data.Class.LogicalOp
+  ( LogicalOp ((.&&), (.||)),
+  )
+import Grisette.Core.Data.Class.Mergeable (Mergeable)
+import Grisette.Core.Data.Class.SOrd
+  ( SOrd ((.<), (.>=)),
+  )
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( UnionLike,
+    mrgIf,
+  )
+import Grisette.Core.Data.Class.SymShift (SymShift)
+import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bits
+  ( pevalShiftLeftTerm,
+    pevalShiftRightTerm,
+  )
+import Grisette.IR.SymPrim.Data.SymPrim (SymIntN (SymIntN), SymWordN (SymWordN))
+import Grisette.Lib.Control.Monad (mrgReturn)
+import Grisette.Lib.Control.Monad.Except (mrgThrowError)
+
+-- | Safe version for `shiftL` or `shiftR`.
+--
+-- The `safeSymShiftL` and `safeSymShiftR` and their primed versions are defined
+-- for all non-negative shift amounts.
+--
+-- * Shifting by negative shift amounts is an error.
+-- * The result is defined to be 0 when shifting left by more than or equal to
+-- the  bit size of the number.
+-- * The result is defined to be 0 when shifting right by more than or equal to
+-- the bit size of the number and the number is unsigned or signed non-negative.
+-- * The result is defined to be -1 when shifting right by more than or equal to
+-- the bit size of the number and the number is signed negative.
+--
+-- The `safeSymStrictShiftL` and `safeSymStrictShiftR` and their primed versions
+-- are defined for all non-negative shift amounts that is less than the bit
+-- size. Shifting by more than or equal to the bit size is an error, otherwise
+-- they are the same as the non-strict versions.
+class (SymShift a) => SafeSymShift e a | a -> e where
+  safeSymShiftL :: (MonadError e m, UnionLike m) => a -> a -> m a
+  safeSymShiftL = safeSymShiftL' id
+  safeSymShiftR :: (MonadError e m, UnionLike m) => a -> a -> m a
+  safeSymShiftR = safeSymShiftR' id
+  safeSymShiftL' ::
+    (MonadError e' m, UnionLike m) => (e -> e') -> a -> a -> m a
+  safeSymShiftR' ::
+    (MonadError e' m, UnionLike m) => (e -> e') -> a -> a -> m a
+  safeSymStrictShiftL :: (MonadError e m, UnionLike m) => a -> a -> m a
+  safeSymStrictShiftL = safeSymStrictShiftL' id
+  safeSymStrictShiftR :: (MonadError e m, UnionLike m) => a -> a -> m a
+  safeSymStrictShiftR = safeSymStrictShiftR' id
+  safeSymStrictShiftL' ::
+    (MonadError e' m, UnionLike m) => (e -> e') -> a -> a -> m a
+  safeSymStrictShiftR' ::
+    (MonadError e' m, UnionLike m) => (e -> e') -> a -> a -> m a
+  {-# MINIMAL
+    safeSymShiftL',
+    safeSymShiftR',
+    safeSymStrictShiftL',
+    safeSymStrictShiftR'
+    #-}
+
+-- | This function handles the case when the shift amount is out the range of
+-- `Int` correctly.
+safeSymShiftLConcreteNum ::
+  (MonadError e m, MonadUnion m, Integral a, FiniteBits a, Mergeable a) =>
+  e ->
+  Bool ->
+  a ->
+  a ->
+  m a
+safeSymShiftLConcreteNum e _ _ s | s < 0 = mrgThrowError e
+safeSymShiftLConcreteNum e allowLargeShiftAmount a s
+  | (fromIntegral s :: Integer) >= fromIntegral (finiteBitSize a) =
+      if allowLargeShiftAmount then mrgReturn 0 else mrgThrowError e
+safeSymShiftLConcreteNum _ _ a s = mrgReturn $ shiftL a (fromIntegral s)
+
+-- | This function handles the case when the shift amount is out the range of
+-- `Int` correctly.
+safeSymShiftRConcreteNum ::
+  (MonadError e m, MonadUnion m, Integral a, FiniteBits a, Mergeable a) =>
+  e ->
+  Bool ->
+  a ->
+  a ->
+  m a
+safeSymShiftRConcreteNum e _ _ s | s < 0 = mrgThrowError e
+safeSymShiftRConcreteNum e allowLargeShiftAmount a s
+  | (fromIntegral s :: Integer) >= fromIntegral (finiteBitSize a) =
+      if allowLargeShiftAmount then mrgReturn 0 else mrgThrowError e
+safeSymShiftRConcreteNum _ _ a s = mrgReturn $ shiftR a (fromIntegral s)
+
+#define SAFE_SYM_SHIFT_CONCRETE(T) \
+  instance SafeSymShift ArithException T where \
+    safeSymShiftL' f = safeSymShiftLConcreteNum (f Overflow) True; \
+    safeSymShiftR' f = safeSymShiftRConcreteNum (f Overflow) True; \
+    safeSymStrictShiftL' f = safeSymShiftLConcreteNum (f Overflow) False; \
+    safeSymStrictShiftR' f = safeSymShiftRConcreteNum (f Overflow) False
+
+#if 1
+SAFE_SYM_SHIFT_CONCRETE(Word8)
+SAFE_SYM_SHIFT_CONCRETE(Word16)
+SAFE_SYM_SHIFT_CONCRETE(Word32)
+SAFE_SYM_SHIFT_CONCRETE(Word64)
+SAFE_SYM_SHIFT_CONCRETE(Word)
+SAFE_SYM_SHIFT_CONCRETE(Int8)
+SAFE_SYM_SHIFT_CONCRETE(Int16)
+SAFE_SYM_SHIFT_CONCRETE(Int32)
+SAFE_SYM_SHIFT_CONCRETE(Int64)
+SAFE_SYM_SHIFT_CONCRETE(Int)
+#endif
+
+instance (KnownNat n, 1 <= n) => SafeSymShift ArithException (WordN n) where
+  safeSymShiftL' f = safeSymShiftLConcreteNum (f Overflow) True
+  safeSymShiftR' f = safeSymShiftRConcreteNum (f Overflow) True
+  safeSymStrictShiftL' f = safeSymShiftLConcreteNum (f Overflow) False
+  safeSymStrictShiftR' f = safeSymShiftRConcreteNum (f Overflow) False
+
+instance (KnownNat n, 1 <= n) => SafeSymShift ArithException (IntN n) where
+  safeSymShiftL' f = safeSymShiftLConcreteNum (f Overflow) True
+  safeSymShiftR' f = safeSymShiftRConcreteNum (f Overflow) True
+  safeSymStrictShiftL' f = safeSymShiftLConcreteNum (f Overflow) False
+  safeSymStrictShiftR' f = safeSymShiftRConcreteNum (f Overflow) False
+
+instance (KnownNat n, 1 <= n) => SafeSymShift ArithException (SymWordN n) where
+  safeSymShiftL' _ (SymWordN a) (SymWordN s) =
+    return $ SymWordN $ pevalShiftLeftTerm a s
+  safeSymShiftR' _ (SymWordN a) (SymWordN s) =
+    return $ SymWordN $ pevalShiftRightTerm a s
+  safeSymStrictShiftL' f a@(SymWordN ta) s@(SymWordN ts) =
+    mrgIf
+      (s .>= fromIntegral (finiteBitSize a))
+      (mrgThrowError $ f Overflow)
+      (return $ SymWordN $ pevalShiftLeftTerm ta ts)
+  safeSymStrictShiftR' f a@(SymWordN ta) s@(SymWordN ts) =
+    mrgIf
+      (s .>= fromIntegral (finiteBitSize a))
+      (mrgThrowError $ f Overflow)
+      (return $ SymWordN $ pevalShiftRightTerm ta ts)
+
+instance (KnownNat n, 1 <= n) => SafeSymShift ArithException (SymIntN n) where
+  safeSymShiftL' f (SymIntN a) ss@(SymIntN s) =
+    mrgIf
+      (ss .< 0)
+      (mrgThrowError $ f Overflow)
+      (return $ SymIntN $ pevalShiftLeftTerm a s)
+  safeSymShiftR' f (SymIntN a) ss@(SymIntN s) =
+    mrgIf
+      (ss .< 0)
+      (mrgThrowError $ f Overflow)
+      (return $ SymIntN $ pevalShiftRightTerm a s)
+  safeSymStrictShiftL' f a@(SymIntN ta) s@(SymIntN ts) =
+    mrgIf
+      (s .< 0 .|| (bs .>= 0 .&& s .>= bs))
+      (mrgThrowError $ f Overflow)
+      (return $ SymIntN $ pevalShiftLeftTerm ta ts)
+    where
+      bs = fromIntegral (finiteBitSize a)
+  safeSymStrictShiftR' f a@(SymIntN ta) s@(SymIntN ts) =
+    mrgIf
+      (s .< 0 .|| (bs .>= 0 .&& s .>= bs))
+      (mrgThrowError $ f Overflow)
+      (return $ SymIntN $ pevalShiftRightTerm ta ts)
+    where
+      bs = fromIntegral (finiteBitSize a)
diff --git a/src/Grisette/Core/Data/Class/SignConversion.hs b/src/Grisette/Core/Data/Class/SignConversion.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Core/Data/Class/SignConversion.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE FunctionalDependencies #-}
+
+module Grisette.Core.Data.Class.SignConversion
+  ( SignConversion (..),
+  )
+where
+
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+
+-- | Convert values between signed and unsigned.
+class SignConversion ubv sbv | ubv -> sbv, sbv -> ubv where
+  -- | Convert unsigned value to the corresponding signed value.
+  toSigned :: ubv -> sbv
+
+  -- | Convert signed value to the corresponding unsigned value.
+  toUnsigned :: sbv -> ubv
+
+instance SignConversion Word8 Int8 where
+  toSigned = fromIntegral
+  toUnsigned = fromIntegral
+
+instance SignConversion Word16 Int16 where
+  toSigned = fromIntegral
+  toUnsigned = fromIntegral
+
+instance SignConversion Word32 Int32 where
+  toSigned = fromIntegral
+  toUnsigned = fromIntegral
+
+instance SignConversion Word64 Int64 where
+  toSigned = fromIntegral
+  toUnsigned = fromIntegral
+
+instance SignConversion Word Int where
+  toSigned = fromIntegral
+  toUnsigned = fromIntegral
diff --git a/src/Grisette/Core/Data/Class/SimpleMergeable.hs b/src/Grisette/Core/Data/Class/SimpleMergeable.hs
--- a/src/Grisette/Core/Data/Class/SimpleMergeable.hs
+++ b/src/Grisette/Core/Data/Class/SimpleMergeable.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -8,6 +9,7 @@
 {-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -35,14 +37,14 @@
     merge,
     mrgSingle,
     UnionPrjOp (..),
-    pattern SingleU,
-    pattern IfU,
+    pattern Single,
+    pattern If,
     simpleMerge,
     onUnion,
     onUnion2,
     onUnion3,
     onUnion4,
-    (#~),
+    (.#),
   )
 where
 
@@ -60,6 +62,7 @@
 import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
 import qualified Control.Monad.Writer.Lazy as WriterLazy
 import qualified Control.Monad.Writer.Strict as WriterStrict
+import Data.Bifunctor (Bifunctor (first))
 import Data.Kind (Type)
 import GHC.Generics
   ( Generic (Rep, from, to),
@@ -71,8 +74,10 @@
   )
 import GHC.TypeNats (KnownNat, type (<=))
 import Generics.Deriving (Default (Default))
-import Grisette.Core.Data.Class.Bool (ITEOp (ites))
+import Grisette.Core.Control.Exception (AssertionError)
 import Grisette.Core.Data.Class.Function (Function (Arg, Ret, (#)))
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&)))
 import Grisette.Core.Data.Class.Mergeable
   ( Mergeable (rootStrategy),
     Mergeable',
@@ -81,11 +86,12 @@
     Mergeable3 (liftRootStrategy3),
     MergingStrategy (SimpleStrategy),
   )
+import Grisette.Core.Data.Class.Solvable (Solvable (con))
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
   ( LinkedRep,
     SupportedPrim,
   )
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim
+import Grisette.IR.SymPrim.Data.SymPrim
   ( SymBool,
     SymIntN,
     SymInteger,
@@ -717,24 +723,37 @@
   -- 1
   leftMost :: u a -> a
 
+  -- | Convert the union to a guarded list.
+  --
+  -- >>> toGuardedList (mrgIf "a" (single 1) (mrgIf "b" (single 2) (single 3)) :: UnionM Integer)
+  -- [(a,1),((&& b (! a)),2),((! (|| b a)),3)]
+  toGuardedList :: u a -> [(SymBool, a)]
+  toGuardedList u =
+    case (singleView u, ifView u) of
+      (Just x, _) -> [(con True, x)]
+      (_, Just (c, l, r)) ->
+        fmap (first (.&& c)) (toGuardedList l)
+          ++ fmap (first (.&& symNot c)) (toGuardedList r)
+      _ -> error "Should not happen"
+
 -- | Pattern match to extract single values with 'singleView'.
 --
--- >>> case (single 1 :: UnionM Integer) of SingleU v -> v
+-- >>> case (single 1 :: UnionM Integer) of Single v -> v
 -- 1
-pattern SingleU :: (UnionPrjOp u) => a -> u a
-pattern SingleU x <-
+pattern Single :: (UnionPrjOp u, Mergeable a) => a -> u a
+pattern Single x <-
   (singleView -> Just x)
   where
-    SingleU x = single x
+    Single x = mrgSingle x
 
 -- | Pattern match to extract guard values with 'ifView'
--- >>> case (unionIf "a" (single 1) (single 2) :: UnionM Integer) of IfU c t f -> (c,t,f)
+-- >>> case (unionIf "a" (single 1) (single 2) :: UnionM Integer) of If c t f -> (c,t,f)
 -- (a,<1>,<2>)
-pattern IfU :: (UnionPrjOp u) => SymBool -> u a -> u a -> u a
-pattern IfU c t f <-
+pattern If :: (UnionPrjOp u, Mergeable a) => SymBool -> u a -> u a -> u a
+pattern If c t f <-
   (ifView -> Just (c, t, f))
   where
-    IfU c t f = unionIf c t f
+    If c t f = unionIf c t f
 
 -- | Merge the simply mergeable values in a union, and extract the merged value.
 --
@@ -747,7 +766,7 @@
 -- (ite a b c)
 simpleMerge :: forall u a. (SimpleMergeable a, UnionLike u, UnionPrjOp u) => u a -> a
 simpleMerge u = case merge u of
-  SingleU x -> x
+  Single x -> x
   _ -> error "Should not happen"
 {-# INLINE simpleMerge #-}
 
@@ -790,31 +809,31 @@
 -- | Helper for applying functions on 'UnionPrjOp' and 'SimpleMergeable'.
 --
 -- >>> let f :: Integer -> UnionM Integer = \x -> mrgIf (ssym "a") (mrgSingle $ x + 1) (mrgSingle $ x + 2)
--- >>> f #~ (mrgIf (ssym "b" :: SymBool) (mrgSingle 0) (mrgSingle 2) :: UnionM Integer)
+-- >>> f .# (mrgIf (ssym "b" :: SymBool) (mrgSingle 0) (mrgSingle 2) :: UnionM Integer)
 -- {If (&& b a) 1 (If b 2 (If a 3 4))}
-(#~) ::
+(.#) ::
   (Function f, SimpleMergeable (Ret f), UnionPrjOp u, Functor u) =>
   f ->
   u (Arg f) ->
   Ret f
-(#~) f u = simpleMerge $ fmap (f #) u
-{-# INLINE (#~) #-}
+(.#) f u = simpleMerge $ fmap (f #) u
+{-# INLINE (.#) #-}
 
-infixl 9 #~
+infixl 9 .#
 
 #define SIMPLE_MERGEABLE_SIMPLE(symtype) \
 instance SimpleMergeable symtype where \
-  mrgIte = ites; \
+  mrgIte = symIte; \
   {-# INLINE mrgIte #-}
 
 #define SIMPLE_MERGEABLE_BV(symtype) \
 instance (KnownNat n, 1 <= n) => SimpleMergeable (symtype n) where \
-  mrgIte = ites; \
+  mrgIte = symIte; \
   {-# INLINE mrgIte #-}
 
 #define SIMPLE_MERGEABLE_FUN(op) \
 instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => SimpleMergeable (sa op sb) where \
-  mrgIte = ites; \
+  mrgIte = symIte; \
   {-# INLINE mrgIte #-}
 
 #if 1
@@ -825,3 +844,6 @@
 SIMPLE_MERGEABLE_FUN(=~>)
 SIMPLE_MERGEABLE_FUN(-~>)
 #endif
+
+-- Exception
+deriving via (Default AssertionError) instance SimpleMergeable AssertionError
diff --git a/src/Grisette/Core/Data/Class/SimpleMergeable.hs-boot b/src/Grisette/Core/Data/Class/SimpleMergeable.hs-boot
deleted file mode 100644
--- a/src/Grisette/Core/Data/Class/SimpleMergeable.hs-boot
+++ /dev/null
@@ -1,12 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE Trustworthy #-}
-
-module Grisette.Core.Data.Class.SimpleMergeable (SimpleMergeable (..)) where
-
-import {-# SOURCE #-} Grisette.Core.Data.Class.Mergeable
-  ( Mergeable,
-  )
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim (SymBool)
-
-class (Mergeable a) => SimpleMergeable a where
-  mrgIte :: SymBool -> a -> a -> a
diff --git a/src/Grisette/Core/Data/Class/Solvable.hs b/src/Grisette/Core/Data/Class/Solvable.hs
--- a/src/Grisette/Core/Data/Class/Solvable.hs
+++ b/src/Grisette/Core/Data/Class/Solvable.hs
@@ -1,6 +1,9 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 
 -- |
@@ -21,12 +24,14 @@
 import Control.DeepSeq (NFData)
 import Data.Hashable (Hashable)
 import Data.String (IsString)
+import qualified Data.Text as T
 import Data.Typeable (Typeable)
 import Language.Haskell.TH.Syntax (Lift)
 
 -- $setup
 -- >>> import Grisette.Core
 -- >>> import Grisette.IR.SymPrim
+-- >>> :set -XOverloadedStrings
 
 -- | The class defines the creation and pattern matching of solvable type
 -- values.
@@ -57,9 +62,9 @@
   -- True
   -- >>> (ssym "a" :: SymBool) == ssym "b"
   -- False
-  -- >>> (ssym "a" :: SymBool) &&~ ssym "a"
+  -- >>> (ssym "a" :: SymBool) .&& ssym "a"
   -- a
-  ssym :: String -> t
+  ssym :: T.Text -> t
 
   -- | Generate indexed symbolic constants.
   --
@@ -68,7 +73,7 @@
   --
   -- >>> isym "a" 1 :: SymBool
   -- a@1
-  isym :: String -> Int -> t
+  isym :: T.Text -> Int -> t
 
   -- | Generate simply-named symbolic constants with some extra information for
   -- disambiguation.
@@ -78,7 +83,7 @@
   --
   -- >>> sinfosym "a" "someInfo" :: SymInteger
   -- a:"someInfo"
-  sinfosym :: (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => String -> a -> t
+  sinfosym :: (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => T.Text -> a -> t
 
   -- | Generate indexed symbolic constants with some extra information for
   -- disambiguation.
@@ -89,7 +94,7 @@
   --
   -- >>> iinfosym "a" 1 "someInfo" :: SymInteger
   -- a@1:"someInfo"
-  iinfosym :: (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => String -> Int -> a -> t
+  iinfosym :: (Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) => T.Text -> Int -> a -> t
 
 -- | Extract the concrete value from a solvable value with 'conView'.
 --
diff --git a/src/Grisette/Core/Data/Class/Solver.hs b/src/Grisette/Core/Data/Class/Solver.hs
--- a/src/Grisette/Core/Data/Class/Solver.hs
+++ b/src/Grisette/Core/Data/Class/Solver.hs
@@ -27,28 +27,51 @@
 
     --
 
-    -- | The examples assumes a [z3](https://github.com/Z3Prover/z3) solver available in @PATH@.
-
-    -- * Union with exceptions
-    UnionWithExcept (..),
+    -- | The examples assumes that the [z3](https://github.com/Z3Prover/z3)
+    -- solver is available in @PATH@.
 
     -- * Solver interfaces
+    SolvingFailure (..),
+    MonadicSolver (..),
+    SolverCommand (..),
+    ConfigurableSolver (..),
     Solver (..),
+    withSolver,
+    solve,
+    solveMulti,
+
+    -- * Union with exceptions
+    UnionWithExcept (..),
     solveExcept,
     solveMultiExcept,
   )
 where
 
 import Control.DeepSeq (NFData)
+import Control.Exception (SomeException, bracket)
 import Control.Monad.Except (ExceptT, runExceptT)
+import qualified Data.HashSet as S
 import Data.Hashable (Hashable)
+import Data.Maybe (fromJust)
 import GHC.Generics (Generic)
+import Grisette.Core.Data.Class.ExtractSymbolics
+  ( ExtractSymbolics (extractSymbolics),
+  )
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.||)))
 import Grisette.Core.Data.Class.SimpleMergeable
   ( UnionPrjOp,
     simpleMerge,
   )
-import Grisette.IR.SymPrim.Data.Prim.Model (Model)
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Grisette.Core.Data.Class.Solvable (Solvable (con))
+import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
+  ( SomeTypedSymbol (SomeTypedSymbol),
+  )
+import Grisette.IR.SymPrim.Data.Prim.Model
+  ( Model,
+    SymbolSet (unSymbolSet),
+    equation,
+  )
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool (SymBool))
 import Language.Haskell.TH.Syntax (Lift)
 
 data SolveInternal = SolveInternal
@@ -60,50 +83,144 @@
 -- >>> import Grisette.Backend.SBV
 -- >>> :set -XOverloadedStrings
 
--- | A solver interface.
+-- | The current failures that can be returned by the solver.
+data SolvingFailure
+  = -- | Unsatisfiable: No model is available.
+    Unsat
+  | -- | Unknown: The solver cannot determine whether the formula is
+    -- satisfiable.
+    Unk
+  | -- | The solver has reached the maximum number of models to return.
+    ResultNumLimitReached
+  | -- | The solver has encountered an error.
+    SolvingError SomeException
+  | -- | The solver has been terminated.
+    Terminated
+  deriving (Show)
+
+-- | A monadic solver interface.
+--
+-- This interface abstract the monadic interface of a solver. All the operations
+-- performed in the monad are using a single solver instance. The solver
+-- instance is management by the monad's @run@ function.
+class MonadicSolver m where
+  monadicSolverPush :: Int -> m ()
+  monadicSolverPop :: Int -> m ()
+  monadicSolverSolve :: SymBool -> m (Either SolvingFailure Model)
+
+-- | The commands that can be sent to a solver.
+data SolverCommand
+  = SolverSolve SymBool
+  | SolverPush Int
+  | SolverPop Int
+  | SolverTerminate
+
+-- | A class that abstracts the solver interface.
+class Solver handle where
+  -- | Run a solver command.
+  solverRunCommand ::
+    (handle -> IO (Either SolvingFailure a)) ->
+    handle ->
+    SolverCommand ->
+    IO (Either SolvingFailure a)
+
+  -- | Solve a formula.
+  solverSolve :: handle -> SymBool -> IO (Either SolvingFailure Model)
+
+  -- | Push @n@ levels.
+  solverPush :: handle -> Int -> IO (Either SolvingFailure ())
+  solverPush handle n =
+    solverRunCommand (const $ return $ Right ()) handle $ SolverPush n
+
+  -- | Pop @n@ levels.
+  solverPop :: handle -> Int -> IO (Either SolvingFailure ())
+  solverPop handle n =
+    solverRunCommand (const $ return $ Right ()) handle $ SolverPop n
+
+  -- | Terminate the solver, wait until the last command is finished.
+  solverTerminate :: handle -> IO ()
+
+  -- | Force terminate the solver, do not wait for the last command to finish.
+  solverForceTerminate :: handle -> IO ()
+
+-- | A class that abstracts the creation of a solver instance based on a
+-- configuration.
+--
+-- The solver instance will need to be terminated by the user, with the solver
+-- interface.
 class
-  Solver config failure
-    | config -> failure
+  (Solver handle) =>
+  ConfigurableSolver config handle
+    | config -> handle
   where
-  -- | Solve a single formula. Find an assignment to it to make it true.
-  --
-  -- >>> solve (precise z3) ("a" &&~ ("b" :: SymInteger) ==~ 1)
-  -- Right (Model {a -> True :: Bool, b -> 1 :: Integer})
-  -- >>> solve (precise z3) ("a" &&~ nots "a")
-  -- Left Unsat
-  solve ::
-    -- | solver configuration
-    config ->
-    -- | formula to solve, the solver will try to make it true
-    SymBool ->
-    IO (Either failure Model)
+  newSolver :: config -> IO handle
 
-  -- | Solve a single formula while returning multiple models to make it true.
-  -- The maximum number of desired models are given.
-  --
-  -- > >>> solveMulti (precise z3) 4 ("a" ||~ "b")
-  -- > [Model {a -> True :: Bool, b -> False :: Bool},Model {a -> False :: Bool, b -> True :: Bool},Model {a -> True :: Bool, b -> True :: Bool}]
-  solveMulti ::
-    -- | solver configuration
-    config ->
-    -- | maximum number of models to return
-    Int ->
-    -- | formula to solve, the solver will try to make it true
-    SymBool ->
-    IO ([Model], failure)
+-- | Start a solver, run a computation with the solver, and terminate the
+-- solver after the computation finishes.
+withSolver ::
+  (ConfigurableSolver config handle) =>
+  config ->
+  (handle -> IO a) ->
+  IO a
+withSolver config = bracket (newSolver config) solverTerminate
 
-  -- | Solve a single formula while returning multiple models to make it true.
-  -- All models are returned.
-  --
-  -- > >>> solveAll (precise z3) ("a" ||~ "b")
-  -- > [Model {a -> True :: Bool, b -> False :: Bool},Model {a -> False :: Bool, b -> True :: Bool},Model {a -> True :: Bool, b -> True :: Bool}]
-  solveAll ::
-    -- | solver configuration
-    config ->
-    -- | formula to solve, the solver will try to make it true
-    SymBool ->
-    IO [Model]
+-- | Solve a single formula. Find an assignment to it to make it true.
+--
+-- >>> solve (precise z3) ("a" .&& ("b" :: SymInteger) .== 1)
+-- Right (Model {a -> True :: Bool, b -> 1 :: Integer})
+-- >>> solve (precise z3) ("a" .&& symNot "a")
+-- Left Unsat
+solve ::
+  (ConfigurableSolver config handle) =>
+  -- | solver configuration
+  config ->
+  -- | formula to solve, the solver will try to make it true
+  SymBool ->
+  IO (Either SolvingFailure Model)
+solve config formula = withSolver config (`solverSolve` formula)
 
+-- | Solve a single formula while returning multiple models to make it true.
+-- The maximum number of desired models are given.
+--
+-- > >>> solveMulti (precise z3) 4 ("a" .|| "b")
+-- > [Model {a -> True :: Bool, b -> False :: Bool},Model {a -> False :: Bool, b -> True :: Bool},Model {a -> True :: Bool, b -> True :: Bool}]
+solveMulti ::
+  (ConfigurableSolver config handle) =>
+  -- | solver configuration
+  config ->
+  -- | maximum number of models to return
+  Int ->
+  -- | formula to solve, the solver will try to make it true
+  SymBool ->
+  IO ([Model], SolvingFailure)
+solveMulti config numOfModelRequested formula =
+  withSolver config $ \solver -> do
+    firstModel <- solverSolve solver formula
+    case firstModel of
+      Left err -> return ([], err)
+      Right model -> do
+        (models, err) <- go solver model numOfModelRequested
+        return (model : models, err)
+  where
+    allSymbols = extractSymbolics formula :: SymbolSet
+    go solver prevModel n
+      | n <= 1 = return ([], ResultNumLimitReached)
+      | otherwise = do
+          let newFormula =
+                S.foldl'
+                  ( \acc (SomeTypedSymbol _ v) ->
+                      acc
+                        .|| (symNot (SymBool $ fromJust $ equation v prevModel))
+                  )
+                  (con False)
+                  (unSymbolSet allSymbols)
+          res <- solverSolve solver newFormula
+          case res of
+            Left err -> return ([], err)
+            Right model -> do
+              (models, err) <- go solver model (n - 1)
+              return (model : models, err)
+
 -- | A class that abstracts the union-like structures that contains exceptions.
 class UnionWithExcept t u e v | t -> u e v where
   -- | Extract a union of exceptions and values from the structure.
@@ -121,8 +238,8 @@
 -- >>> :{
 --   res :: ExceptT AssertionError UnionM ()
 --   res = do
---     symAssert $ x >~ 0       -- constrain that x is positive
---     symAssert $ x <~ 2       -- constrain that x is less than 2
+--     symAssert $ x .> 0       -- constrain that x is positive
+--     symAssert $ x .< 2       -- constrain that x is less than 2
 -- :}
 --
 -- >>> :{
@@ -136,15 +253,16 @@
   ( UnionWithExcept t u e v,
     UnionPrjOp u,
     Functor u,
-    Solver config failure
+    ConfigurableSolver config handle
   ) =>
   -- | solver configuration
   config ->
-  -- | mapping the results to symbolic boolean formulas, the solver would try to find a model to make the formula true
+  -- | mapping the results to symbolic boolean formulas, the solver would try to
+  -- find a model to make the formula true
   (Either e v -> SymBool) ->
   -- | the program to be solved, should be a union of exception and values
   t ->
-  IO (Either failure Model)
+  IO (Either SolvingFailure Model)
 solveExcept config f v = solve config (simpleMerge $ f <$> extractUnionExcept v)
 
 -- |
@@ -154,15 +272,17 @@
   ( UnionWithExcept t u e v,
     UnionPrjOp u,
     Functor u,
-    Solver config failure
+    ConfigurableSolver config handle
   ) =>
   -- | solver configuration
   config ->
   -- | maximum number of models to return
   Int ->
-  -- | mapping the results to symbolic boolean formulas, the solver would try to find a model to make the formula true
+  -- | mapping the results to symbolic boolean formulas, the solver would try to
+  -- find a model to make the formula true
   (Either e v -> SymBool) ->
   -- | the program to be solved, should be a union of exception and values
   t ->
-  IO ([Model], failure)
-solveMultiExcept config n f v = solveMulti config n (simpleMerge $ f <$> extractUnionExcept v)
+  IO ([Model], SolvingFailure)
+solveMultiExcept config n f v =
+  solveMulti config n (simpleMerge $ f <$> extractUnionExcept v)
diff --git a/src/Grisette/Core/Data/Class/Substitute.hs b/src/Grisette/Core/Data/Class/Substitute.hs
deleted file mode 100644
--- a/src/Grisette/Core/Data/Class/Substitute.hs
+++ /dev/null
@@ -1,289 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-
--- |
--- Module      :   Grisette.Core.Data.Class.Substitute
--- Copyright   :   (c) Sirui Lu 2021-2023
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Core.Data.Class.Substitute
-  ( -- * Substituting symbolic constants
-    SubstituteSym (..),
-    SubstituteSym' (..),
-  )
-where
-
-import Control.Monad.Except (ExceptT (ExceptT))
-import Control.Monad.Identity
-  ( Identity (Identity),
-    IdentityT (IdentityT),
-  )
-import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
-import qualified Control.Monad.Writer.Lazy as WriterLazy
-import qualified Control.Monad.Writer.Strict as WriterStrict
-import qualified Data.ByteString as B
-import Data.Functor.Sum (Sum)
-import Data.Int (Int16, Int32, Int64, Int8)
-import qualified Data.Text as T
-import Data.Word (Word16, Word32, Word64, Word8)
-import GHC.TypeNats (KnownNat, type (<=))
-import Generics.Deriving
-  ( Default (Default, unDefault),
-    Generic (Rep, from, to),
-    K1 (K1),
-    M1 (M1),
-    U1,
-    type (:*:) ((:*:)),
-    type (:+:) (L1, R1),
-  )
-import Generics.Deriving.Instances ()
-import Grisette.Core.Data.BV (IntN, SomeIntN, SomeWordN, WordN)
-import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
-  ( LinkedRep,
-    TypedSymbol,
-  )
-
--- $setup
--- >>> import Grisette.Core
--- >>> import Grisette.IR.SymPrim
-
--- | Substitution of symbolic constants.
---
--- >>> a = "a" :: TypedSymbol Bool
--- >>> v = "x" &&~ "y" :: SymBool
--- >>> substituteSym a v (["a" &&~ "b", "a"] :: [SymBool])
--- [(&& (&& x y) b),(&& x y)]
---
--- __Note 1:__ This type class can be derived for algebraic data types.
--- You may need the @DerivingVia@ and @DerivingStrategies@ extensions.
---
--- > data X = ... deriving Generic deriving SubstituteSym via (Default X)
-class SubstituteSym a where
-  -- Substitute a symbolic constant to some symbolic value
-  --
-  -- >>> substituteSym "a" ("c" &&~ "d" :: Sym Bool) ["a" &&~ "b" :: Sym Bool, "a"]
-  -- [(&& (&& c d) b),(&& c d)]
-  substituteSym :: (LinkedRep cb sb) => TypedSymbol cb -> sb -> a -> a
-
--- | Auxiliary class for 'SubstituteSym' instance derivation
-class SubstituteSym' a where
-  -- | Auxiliary function for 'substituteSym' derivation
-  substituteSym' :: (LinkedRep cb sb) => TypedSymbol cb -> sb -> a c -> a c
-
-instance
-  ( Generic a,
-    SubstituteSym' (Rep a)
-  ) =>
-  SubstituteSym (Default a)
-  where
-  substituteSym sym val = Default . to . substituteSym' sym val . from . unDefault
-
-instance SubstituteSym' U1 where
-  substituteSym' _ _ = id
-
-instance (SubstituteSym c) => SubstituteSym' (K1 i c) where
-  substituteSym' sym val (K1 v) = K1 $ substituteSym sym val v
-
-instance (SubstituteSym' a) => SubstituteSym' (M1 i c a) where
-  substituteSym' sym val (M1 v) = M1 $ substituteSym' sym val v
-
-instance (SubstituteSym' a, SubstituteSym' b) => SubstituteSym' (a :+: b) where
-  substituteSym' sym val (L1 l) = L1 $ substituteSym' sym val l
-  substituteSym' sym val (R1 r) = R1 $ substituteSym' sym val r
-
-instance (SubstituteSym' a, SubstituteSym' b) => SubstituteSym' (a :*: b) where
-  substituteSym' sym val (a :*: b) = substituteSym' sym val a :*: substituteSym' sym val b
-
-#define CONCRETE_SUBSTITUTESYM(type) \
-instance SubstituteSym type where \
-  substituteSym _ _ = id
-
-#define CONCRETE_SUBSTITUTESYM_BV(type) \
-instance (KnownNat n, 1 <= n) => SubstituteSym (type n) where \
-  substituteSym _ _ = id
-
-#if 1
-CONCRETE_SUBSTITUTESYM(Bool)
-CONCRETE_SUBSTITUTESYM(Integer)
-CONCRETE_SUBSTITUTESYM(Char)
-CONCRETE_SUBSTITUTESYM(Int)
-CONCRETE_SUBSTITUTESYM(Int8)
-CONCRETE_SUBSTITUTESYM(Int16)
-CONCRETE_SUBSTITUTESYM(Int32)
-CONCRETE_SUBSTITUTESYM(Int64)
-CONCRETE_SUBSTITUTESYM(Word)
-CONCRETE_SUBSTITUTESYM(Word8)
-CONCRETE_SUBSTITUTESYM(Word16)
-CONCRETE_SUBSTITUTESYM(Word32)
-CONCRETE_SUBSTITUTESYM(Word64)
-CONCRETE_SUBSTITUTESYM(SomeWordN)
-CONCRETE_SUBSTITUTESYM(SomeIntN)
-CONCRETE_SUBSTITUTESYM(B.ByteString)
-CONCRETE_SUBSTITUTESYM(T.Text)
-CONCRETE_SUBSTITUTESYM_BV(WordN)
-CONCRETE_SUBSTITUTESYM_BV(IntN)
-#endif
-
-instance SubstituteSym () where
-  substituteSym _ _ = id
-
--- Either
-deriving via
-  (Default (Either a b))
-  instance
-    ( SubstituteSym a,
-      SubstituteSym b
-    ) =>
-    SubstituteSym (Either a b)
-
--- Maybe
-deriving via (Default (Maybe a)) instance (SubstituteSym a) => SubstituteSym (Maybe a)
-
--- List
-deriving via (Default [a]) instance (SubstituteSym a) => SubstituteSym [a]
-
--- (,)
-deriving via
-  (Default (a, b))
-  instance
-    (SubstituteSym a, SubstituteSym b) =>
-    SubstituteSym (a, b)
-
--- (,,)
-deriving via
-  (Default (a, b, c))
-  instance
-    ( SubstituteSym a,
-      SubstituteSym b,
-      SubstituteSym c
-    ) =>
-    SubstituteSym (a, b, c)
-
--- (,,,)
-deriving via
-  (Default (a, b, c, d))
-  instance
-    ( SubstituteSym a,
-      SubstituteSym b,
-      SubstituteSym c,
-      SubstituteSym d
-    ) =>
-    SubstituteSym (a, b, c, d)
-
--- (,,,,)
-deriving via
-  (Default (a, b, c, d, e))
-  instance
-    ( SubstituteSym a,
-      SubstituteSym b,
-      SubstituteSym c,
-      SubstituteSym d,
-      SubstituteSym e
-    ) =>
-    SubstituteSym (a, b, c, d, e)
-
--- (,,,,,)
-deriving via
-  (Default (a, b, c, d, e, f))
-  instance
-    ( SubstituteSym a,
-      SubstituteSym b,
-      SubstituteSym c,
-      SubstituteSym d,
-      SubstituteSym e,
-      SubstituteSym f
-    ) =>
-    SubstituteSym (a, b, c, d, e, f)
-
--- (,,,,,,)
-deriving via
-  (Default (a, b, c, d, e, f, g))
-  instance
-    ( SubstituteSym a,
-      SubstituteSym b,
-      SubstituteSym c,
-      SubstituteSym d,
-      SubstituteSym e,
-      SubstituteSym f,
-      SubstituteSym g
-    ) =>
-    SubstituteSym (a, b, c, d, e, f, g)
-
--- (,,,,,,,)
-deriving via
-  (Default (a, b, c, d, e, f, g, h))
-  instance
-    ( SubstituteSym a,
-      SubstituteSym b,
-      SubstituteSym c,
-      SubstituteSym d,
-      SubstituteSym e,
-      SubstituteSym f,
-      SubstituteSym g,
-      SubstituteSym h
-    ) =>
-    SubstituteSym ((,,,,,,,) a b c d e f g h)
-
--- MaybeT
-instance
-  (SubstituteSym (m (Maybe a))) =>
-  SubstituteSym (MaybeT m a)
-  where
-  substituteSym sym val (MaybeT v) = MaybeT $ substituteSym sym val v
-
--- ExceptT
-instance
-  (SubstituteSym (m (Either e a))) =>
-  SubstituteSym (ExceptT e m a)
-  where
-  substituteSym sym val (ExceptT v) = ExceptT $ substituteSym sym val v
-
--- Sum
-deriving via
-  (Default (Sum f g a))
-  instance
-    (SubstituteSym (f a), SubstituteSym (g a)) =>
-    SubstituteSym (Sum f g a)
-
--- WriterT
-instance
-  (SubstituteSym (m (a, s))) =>
-  SubstituteSym (WriterLazy.WriterT s m a)
-  where
-  substituteSym sym val (WriterLazy.WriterT v) = WriterLazy.WriterT $ substituteSym sym val v
-
-instance
-  (SubstituteSym (m (a, s))) =>
-  SubstituteSym (WriterStrict.WriterT s m a)
-  where
-  substituteSym sym val (WriterStrict.WriterT v) = WriterStrict.WriterT $ substituteSym sym val v
-
--- Identity
-instance (SubstituteSym a) => SubstituteSym (Identity a) where
-  substituteSym sym val (Identity a) = Identity $ substituteSym sym val a
-
--- IdentityT
-instance (SubstituteSym (m a)) => SubstituteSym (IdentityT m a) where
-  substituteSym sym val (IdentityT a) = IdentityT $ substituteSym sym val a
-
-{-
-
-instance SubstituteSym (Sym a) where
-  substituteSym sym (Sym val) (Sym x) =
-    introSupportedPrimConstraint val $
-      introSupportedPrimConstraint x $
-        Sym $
-          substTerm sym val x
--}
diff --git a/src/Grisette/Core/Data/Class/SubstituteSym.hs b/src/Grisette/Core/Data/Class/SubstituteSym.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Core/Data/Class/SubstituteSym.hs
@@ -0,0 +1,318 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- |
+-- Module      :   Grisette.Core.Data.Class.SubstituteSym
+-- Copyright   :   (c) Sirui Lu 2021-2023
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Core.Data.Class.SubstituteSym
+  ( -- * Substituting symbolic constants
+    SubstituteSym (..),
+    SubstituteSym' (..),
+  )
+where
+
+import Control.Monad.Except (ExceptT (ExceptT))
+import Control.Monad.Identity
+  ( Identity (Identity),
+    IdentityT (IdentityT),
+  )
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import qualified Control.Monad.Writer.Lazy as WriterLazy
+import qualified Control.Monad.Writer.Strict as WriterStrict
+import qualified Data.ByteString as B
+import Data.Functor.Sum (Sum)
+import Data.Int (Int16, Int32, Int64, Int8)
+import qualified Data.Text as T
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.TypeNats (KnownNat, type (<=))
+import Generics.Deriving
+  ( Default (Default, unDefault),
+    Generic (Rep, from, to),
+    K1 (K1),
+    M1 (M1),
+    U1,
+    type (:*:) ((:*:)),
+    type (:+:) (L1, R1),
+  )
+import Generics.Deriving.Instances ()
+import Grisette.Core.Data.BV (IntN, SomeIntN, SomeWordN, WordN)
+import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
+  ( LinkedRep (underlyingTerm),
+    SupportedPrim,
+    TypedSymbol,
+  )
+import Grisette.IR.SymPrim.Data.Prim.InternedTerm.TermSubstitution (substTerm)
+import Grisette.IR.SymPrim.Data.SymPrim
+  ( SomeSymIntN (SomeSymIntN),
+    SomeSymWordN (SomeSymWordN),
+    SymBool (SymBool),
+    SymIntN (SymIntN),
+    SymInteger (SymInteger),
+    SymWordN (SymWordN),
+    type (-~>) (SymGeneralFun),
+    type (=~>) (SymTabularFun),
+  )
+
+-- $setup
+-- >>> import Grisette.Core
+-- >>> import Grisette.IR.SymPrim
+
+-- | Substitution of symbolic constants.
+--
+-- >>> a = "a" :: TypedSymbol Bool
+-- >>> v = "x" .&& "y" :: SymBool
+-- >>> substituteSym a v (["a" .&& "b", "a"] :: [SymBool])
+-- [(&& (&& x y) b),(&& x y)]
+--
+-- __Note 1:__ This type class can be derived for algebraic data types.
+-- You may need the @DerivingVia@ and @DerivingStrategies@ extensions.
+--
+-- > data X = ... deriving Generic deriving SubstituteSym via (Default X)
+class SubstituteSym a where
+  -- Substitute a symbolic constant to some symbolic value
+  --
+  -- >>> substituteSym "a" ("c" .&& "d" :: Sym Bool) ["a" .&& "b" :: Sym Bool, "a"]
+  -- [(&& (&& c d) b),(&& c d)]
+  substituteSym :: (LinkedRep cb sb) => TypedSymbol cb -> sb -> a -> a
+
+#define CONCRETE_SUBSTITUTESYM(type) \
+instance SubstituteSym type where \
+  substituteSym _ _ = id
+
+#define CONCRETE_SUBSTITUTESYM_BV(type) \
+instance (KnownNat n, 1 <= n) => SubstituteSym (type n) where \
+  substituteSym _ _ = id
+
+#if 1
+CONCRETE_SUBSTITUTESYM(Bool)
+CONCRETE_SUBSTITUTESYM(Integer)
+CONCRETE_SUBSTITUTESYM(Char)
+CONCRETE_SUBSTITUTESYM(Int)
+CONCRETE_SUBSTITUTESYM(Int8)
+CONCRETE_SUBSTITUTESYM(Int16)
+CONCRETE_SUBSTITUTESYM(Int32)
+CONCRETE_SUBSTITUTESYM(Int64)
+CONCRETE_SUBSTITUTESYM(Word)
+CONCRETE_SUBSTITUTESYM(Word8)
+CONCRETE_SUBSTITUTESYM(Word16)
+CONCRETE_SUBSTITUTESYM(Word32)
+CONCRETE_SUBSTITUTESYM(Word64)
+CONCRETE_SUBSTITUTESYM(SomeWordN)
+CONCRETE_SUBSTITUTESYM(SomeIntN)
+CONCRETE_SUBSTITUTESYM(B.ByteString)
+CONCRETE_SUBSTITUTESYM(T.Text)
+CONCRETE_SUBSTITUTESYM_BV(WordN)
+CONCRETE_SUBSTITUTESYM_BV(IntN)
+#endif
+
+instance SubstituteSym () where
+  substituteSym _ _ = id
+
+-- Either
+deriving via
+  (Default (Either a b))
+  instance
+    ( SubstituteSym a,
+      SubstituteSym b
+    ) =>
+    SubstituteSym (Either a b)
+
+-- Maybe
+deriving via (Default (Maybe a)) instance (SubstituteSym a) => SubstituteSym (Maybe a)
+
+-- List
+deriving via (Default [a]) instance (SubstituteSym a) => SubstituteSym [a]
+
+-- (,)
+deriving via
+  (Default (a, b))
+  instance
+    (SubstituteSym a, SubstituteSym b) =>
+    SubstituteSym (a, b)
+
+-- (,,)
+deriving via
+  (Default (a, b, c))
+  instance
+    ( SubstituteSym a,
+      SubstituteSym b,
+      SubstituteSym c
+    ) =>
+    SubstituteSym (a, b, c)
+
+-- (,,,)
+deriving via
+  (Default (a, b, c, d))
+  instance
+    ( SubstituteSym a,
+      SubstituteSym b,
+      SubstituteSym c,
+      SubstituteSym d
+    ) =>
+    SubstituteSym (a, b, c, d)
+
+-- (,,,,)
+deriving via
+  (Default (a, b, c, d, e))
+  instance
+    ( SubstituteSym a,
+      SubstituteSym b,
+      SubstituteSym c,
+      SubstituteSym d,
+      SubstituteSym e
+    ) =>
+    SubstituteSym (a, b, c, d, e)
+
+-- (,,,,,)
+deriving via
+  (Default (a, b, c, d, e, f))
+  instance
+    ( SubstituteSym a,
+      SubstituteSym b,
+      SubstituteSym c,
+      SubstituteSym d,
+      SubstituteSym e,
+      SubstituteSym f
+    ) =>
+    SubstituteSym (a, b, c, d, e, f)
+
+-- (,,,,,,)
+deriving via
+  (Default (a, b, c, d, e, f, g))
+  instance
+    ( SubstituteSym a,
+      SubstituteSym b,
+      SubstituteSym c,
+      SubstituteSym d,
+      SubstituteSym e,
+      SubstituteSym f,
+      SubstituteSym g
+    ) =>
+    SubstituteSym (a, b, c, d, e, f, g)
+
+-- (,,,,,,,)
+deriving via
+  (Default (a, b, c, d, e, f, g, h))
+  instance
+    ( SubstituteSym a,
+      SubstituteSym b,
+      SubstituteSym c,
+      SubstituteSym d,
+      SubstituteSym e,
+      SubstituteSym f,
+      SubstituteSym g,
+      SubstituteSym h
+    ) =>
+    SubstituteSym ((,,,,,,,) a b c d e f g h)
+
+-- MaybeT
+instance
+  (SubstituteSym (m (Maybe a))) =>
+  SubstituteSym (MaybeT m a)
+  where
+  substituteSym sym val (MaybeT v) = MaybeT $ substituteSym sym val v
+
+-- ExceptT
+instance
+  (SubstituteSym (m (Either e a))) =>
+  SubstituteSym (ExceptT e m a)
+  where
+  substituteSym sym val (ExceptT v) = ExceptT $ substituteSym sym val v
+
+-- Sum
+deriving via
+  (Default (Sum f g a))
+  instance
+    (SubstituteSym (f a), SubstituteSym (g a)) =>
+    SubstituteSym (Sum f g a)
+
+-- WriterT
+instance
+  (SubstituteSym (m (a, s))) =>
+  SubstituteSym (WriterLazy.WriterT s m a)
+  where
+  substituteSym sym val (WriterLazy.WriterT v) = WriterLazy.WriterT $ substituteSym sym val v
+
+instance
+  (SubstituteSym (m (a, s))) =>
+  SubstituteSym (WriterStrict.WriterT s m a)
+  where
+  substituteSym sym val (WriterStrict.WriterT v) = WriterStrict.WriterT $ substituteSym sym val v
+
+-- Identity
+instance (SubstituteSym a) => SubstituteSym (Identity a) where
+  substituteSym sym val (Identity a) = Identity $ substituteSym sym val a
+
+-- IdentityT
+instance (SubstituteSym (m a)) => SubstituteSym (IdentityT m a) where
+  substituteSym sym val (IdentityT a) = IdentityT $ substituteSym sym val a
+
+#define SUBSTITUTE_SYM_SIMPLE(symtype) \
+instance SubstituteSym symtype where \
+  substituteSym sym v (symtype t) = symtype $ substTerm sym (underlyingTerm v) t
+
+#define SUBSTITUTE_SYM_BV(symtype) \
+instance (KnownNat n, 1 <= n) => SubstituteSym (symtype n) where \
+  substituteSym sym v (symtype t) = symtype $ substTerm sym (underlyingTerm v) t
+
+#define SUBSTITUTE_SYM_FUN(op, cons) \
+instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => SubstituteSym (sa op sb) where \
+  substituteSym sym v (cons t) = cons $ substTerm sym (underlyingTerm v) t
+
+#define SUBSTITUTE_SYM_BV_SOME(somety, origty) \
+instance SubstituteSym somety where \
+  substituteSym sym v (somety (origty t)) = somety $ origty $ substTerm sym (underlyingTerm v) t
+
+#if 1
+SUBSTITUTE_SYM_SIMPLE(SymBool)
+SUBSTITUTE_SYM_SIMPLE(SymInteger)
+SUBSTITUTE_SYM_BV(SymIntN)
+SUBSTITUTE_SYM_BV(SymWordN)
+SUBSTITUTE_SYM_FUN(=~>, SymTabularFun)
+SUBSTITUTE_SYM_FUN(-~>, SymGeneralFun)
+SUBSTITUTE_SYM_BV_SOME(SomeSymIntN, SymIntN)
+SUBSTITUTE_SYM_BV_SOME(SomeSymWordN, SymWordN)
+#endif
+
+-- | Auxiliary class for 'SubstituteSym' instance derivation
+class SubstituteSym' a where
+  -- | Auxiliary function for 'substituteSym' derivation
+  substituteSym' :: (LinkedRep cb sb) => TypedSymbol cb -> sb -> a c -> a c
+
+instance
+  ( Generic a,
+    SubstituteSym' (Rep a)
+  ) =>
+  SubstituteSym (Default a)
+  where
+  substituteSym sym val = Default . to . substituteSym' sym val . from . unDefault
+
+instance SubstituteSym' U1 where
+  substituteSym' _ _ = id
+
+instance (SubstituteSym c) => SubstituteSym' (K1 i c) where
+  substituteSym' sym val (K1 v) = K1 $ substituteSym sym val v
+
+instance (SubstituteSym' a) => SubstituteSym' (M1 i c a) where
+  substituteSym' sym val (M1 v) = M1 $ substituteSym' sym val v
+
+instance (SubstituteSym' a, SubstituteSym' b) => SubstituteSym' (a :+: b) where
+  substituteSym' sym val (L1 l) = L1 $ substituteSym' sym val l
+  substituteSym' sym val (R1 r) = R1 $ substituteSym' sym val r
+
+instance (SubstituteSym' a, SubstituteSym' b) => SubstituteSym' (a :*: b) where
+  substituteSym' sym val (a :*: b) = substituteSym' sym val a :*: substituteSym' sym val b
diff --git a/src/Grisette/Core/Data/Class/SymRotate.hs b/src/Grisette/Core/Data/Class/SymRotate.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Core/Data/Class/SymRotate.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Grisette.Core.Data.Class.SymRotate
+  ( SymRotate (..),
+    DefaultFiniteBitsSymRotate (..),
+  )
+where
+
+import Data.Bits (Bits (isSigned, rotate), FiniteBits (finiteBitSize))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+
+class (Bits a) => SymRotate a where
+  symRotate :: a -> a -> a
+
+instance SymRotate Int where
+  symRotate = rotate
+
+newtype DefaultFiniteBitsSymRotate a = DefaultFiniteBitsSymRotate
+  { unDefaultFiniteBitsSymRotate :: a
+  }
+  deriving newtype (Eq, Bits)
+
+instance
+  (Integral a, FiniteBits a) =>
+  SymRotate (DefaultFiniteBitsSymRotate a)
+  where
+  symRotate (DefaultFiniteBitsSymRotate a) (DefaultFiniteBitsSymRotate s)
+    | isSigned a = DefaultFiniteBitsSymRotate $ symRotateSigned a s
+    | otherwise = DefaultFiniteBitsSymRotate $ symRotateUnsigned a s
+    where
+      symRotateUnsigned :: a -> a -> a
+      symRotateUnsigned a s =
+        rotate a (fromIntegral (s `mod` fromIntegral (finiteBitSize a)))
+      symRotateSigned :: a -> a -> a
+      symRotateSigned a s
+        | finiteBitSize s == 1 = a
+        | finiteBitSize s == 2 = rotate a (fromIntegral s)
+        | otherwise =
+            rotate a (fromIntegral (s `mod` fromIntegral (finiteBitSize a)))
+
+deriving via (DefaultFiniteBitsSymRotate Int8) instance SymRotate Int8
+
+deriving via (DefaultFiniteBitsSymRotate Int16) instance SymRotate Int16
+
+deriving via (DefaultFiniteBitsSymRotate Int32) instance SymRotate Int32
+
+deriving via (DefaultFiniteBitsSymRotate Int64) instance SymRotate Int64
+
+deriving via (DefaultFiniteBitsSymRotate Word8) instance SymRotate Word8
+
+deriving via (DefaultFiniteBitsSymRotate Word16) instance SymRotate Word16
+
+deriving via (DefaultFiniteBitsSymRotate Word32) instance SymRotate Word32
+
+deriving via (DefaultFiniteBitsSymRotate Word64) instance SymRotate Word64
+
+deriving via (DefaultFiniteBitsSymRotate Word) instance SymRotate Word
diff --git a/src/Grisette/Core/Data/Class/SymShift.hs b/src/Grisette/Core/Data/Class/SymShift.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Core/Data/Class/SymShift.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Grisette.Core.Data.Class.SymShift
+  ( SymShift (..),
+    DefaultFiniteBitsSymShift (..),
+  )
+where
+
+import Data.Bits (Bits (isSigned, shift), FiniteBits (finiteBitSize))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+
+class (Bits a) => SymShift a where
+  symShift :: a -> a -> a
+
+instance SymShift Int where
+  symShift a s
+    | s >= finiteBitSize s = 0
+    | s <= -finiteBitSize s = if a >= 0 then 0 else -1
+    | otherwise = shift a s
+
+newtype DefaultFiniteBitsSymShift a = DefaultFiniteBitsSymShift
+  { unDefaultFiniteBitsSymShift :: a
+  }
+  deriving newtype (Eq, Bits)
+
+instance
+  (Integral a, FiniteBits a) =>
+  SymShift (DefaultFiniteBitsSymShift a)
+  where
+  symShift (DefaultFiniteBitsSymShift a) (DefaultFiniteBitsSymShift s)
+    | isSigned a = DefaultFiniteBitsSymShift $ symShiftSigned a s
+    | otherwise = DefaultFiniteBitsSymShift $ symShiftUnsigned a s
+    where
+      symShiftUnsigned :: (Integral a, FiniteBits a) => a -> a -> a
+      symShiftUnsigned a s | s >= fromIntegral (finiteBitSize a) = 0
+      symShiftUnsigned a s = shift a (fromIntegral s)
+
+      symShiftSigned :: (Integral a, FiniteBits a) => a -> a -> a
+      symShiftSigned a s | finiteBitSize s == 1 = a
+      symShiftSigned a s
+        | finiteBitSize s == 2 =
+            if s == -2
+              then if a < 0 then -1 else 0
+              else shift a (fromIntegral s)
+      symShiftSigned a s | s >= fromIntegral (finiteBitSize a) = 0
+      symShiftSigned a s
+        | s <= fromIntegral (-finiteBitSize a) =
+            if a < 0 then -1 else 0
+      symShiftSigned a s = shift a (fromIntegral s)
+
+deriving via (DefaultFiniteBitsSymShift Int8) instance SymShift Int8
+
+deriving via (DefaultFiniteBitsSymShift Int16) instance SymShift Int16
+
+deriving via (DefaultFiniteBitsSymShift Int32) instance SymShift Int32
+
+deriving via (DefaultFiniteBitsSymShift Int64) instance SymShift Int64
+
+deriving via (DefaultFiniteBitsSymShift Word8) instance SymShift Word8
+
+deriving via (DefaultFiniteBitsSymShift Word16) instance SymShift Word16
+
+deriving via (DefaultFiniteBitsSymShift Word32) instance SymShift Word32
+
+deriving via (DefaultFiniteBitsSymShift Word64) instance SymShift Word64
+
+deriving via (DefaultFiniteBitsSymShift Word) instance SymShift Word
diff --git a/src/Grisette/Core/Data/Class/ToCon.hs b/src/Grisette/Core/Data/Class/ToCon.hs
--- a/src/Grisette/Core/Data/Class/ToCon.hs
+++ b/src/Grisette/Core/Data/Class/ToCon.hs
@@ -5,7 +5,10 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -48,7 +51,31 @@
 import GHC.TypeNats (KnownNat, type (<=))
 import Generics.Deriving (Default (Default))
 import Generics.Deriving.Instances ()
-import Grisette.Core.Data.BV (IntN, SomeIntN, SomeWordN, WordN)
+import Grisette.Core.Control.Exception (AssertionError, VerificationConditions)
+import Grisette.Core.Data.BV
+  ( IntN (IntN),
+    SomeIntN (SomeIntN),
+    SomeWordN (SomeWordN),
+    WordN (WordN),
+  )
+import Grisette.Core.Data.Class.Solvable (Solvable (conView), pattern Con)
+import Grisette.IR.SymPrim.Data.IntBitwidth (intBitwidthQ)
+import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
+  ( LinkedRep,
+    SupportedPrim,
+    type (-->),
+  )
+import Grisette.IR.SymPrim.Data.SymPrim
+  ( SomeSymIntN (SomeSymIntN),
+    SomeSymWordN (SomeSymWordN),
+    SymBool,
+    SymIntN,
+    SymInteger,
+    SymWordN,
+    type (-~>),
+    type (=~>),
+  )
+import Grisette.IR.SymPrim.Data.TabularFun (type (=->))
 
 -- $setup
 -- >>> import Grisette.Core
@@ -74,31 +101,6 @@
   -- Nothing
   toCon :: a -> Maybe b
 
-instance (Generic a, Generic b, ToCon' (Rep a) (Rep b)) => ToCon a (Default b) where
-  toCon v = fmap (Default . to) $ toCon' $ from v
-
-class ToCon' a b where
-  toCon' :: a c -> Maybe (b c)
-
-instance ToCon' U1 U1 where
-  toCon' = Just
-
-instance (ToCon a b) => ToCon' (K1 i a) (K1 i b) where
-  toCon' (K1 a) = K1 <$> toCon a
-
-instance (ToCon' a b) => ToCon' (M1 i c1 a) (M1 i c2 b) where
-  toCon' (M1 a) = M1 <$> toCon' a
-
-instance (ToCon' a1 a2, ToCon' b1 b2) => ToCon' (a1 :+: b1) (a2 :+: b2) where
-  toCon' (L1 a) = L1 <$> toCon' a
-  toCon' (R1 a) = R1 <$> toCon' a
-
-instance (ToCon' a1 a2, ToCon' b1 b2) => ToCon' (a1 :*: b1) (a2 :*: b2) where
-  toCon' (a :*: b) = do
-    ac <- toCon' a
-    bc <- toCon' b
-    return $ ac :*: bc
-
 #define CONCRETE_TOCON(type) \
 instance ToCon type type where \
   toCon = Just
@@ -234,3 +236,108 @@
 -- IdentityT
 instance (ToCon (m a) (m1 b)) => ToCon (IdentityT m a) (IdentityT m1 b) where
   toCon (IdentityT a) = IdentityT <$> toCon a
+
+#define TO_CON_SYMID_SIMPLE(symtype) \
+instance ToCon symtype symtype where \
+  toCon = Just
+
+#define TO_CON_SYMID_BV(symtype) \
+instance (KnownNat n, 1 <= n) => ToCon (symtype n) (symtype n) where \
+  toCon = Just
+
+#define TO_CON_SYMID_FUN(op) \
+instance (SupportedPrim a, SupportedPrim b) => ToCon (a op b) (a op b) where \
+  toCon = Just
+
+#if 1
+TO_CON_SYMID_SIMPLE(SymBool)
+TO_CON_SYMID_SIMPLE(SymInteger)
+TO_CON_SYMID_BV(SymIntN)
+TO_CON_SYMID_BV(SymWordN)
+TO_CON_SYMID_FUN(=~>)
+TO_CON_SYMID_FUN(-~>)
+TO_CON_SYMID_SIMPLE(SomeSymIntN)
+TO_CON_SYMID_SIMPLE(SomeSymWordN)
+
+#endif
+
+#define TO_CON_FROMSYM_SIMPLE(contype, symtype) \
+instance ToCon symtype contype where \
+  toCon = conView
+
+#define TO_CON_FROMSYM_BV(contype, symtype) \
+instance (KnownNat n, 1 <= n) => ToCon (symtype n) (contype n) where \
+  toCon = conView
+
+#define TO_CON_FROMSYM_FUN(conop, symop) \
+instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => ToCon (symop sa sb) (conop ca cb) where \
+  toCon = conView
+
+#define TO_CON_FROMSYM_BV_SOME(contype, symtype) \
+instance ToCon symtype contype where \
+  toCon (symtype v) = contype <$> conView v
+
+#if 1
+TO_CON_FROMSYM_SIMPLE(Bool, SymBool)
+TO_CON_FROMSYM_SIMPLE(Integer, SymInteger)
+TO_CON_FROMSYM_BV(IntN, SymIntN)
+TO_CON_FROMSYM_BV(WordN, SymWordN)
+TO_CON_FROMSYM_FUN((=->), (=~>))
+TO_CON_FROMSYM_FUN((-->), (-~>))
+TO_CON_FROMSYM_BV_SOME(SomeIntN, SomeSymIntN)
+TO_CON_FROMSYM_BV_SOME(SomeWordN, SomeSymWordN)
+#endif
+
+#define TOCON_MACHINE_INTEGER(sbvw, bvw, n, int) \
+instance ToCon (sbvw n) int where \
+  toCon (Con (bvw v :: bvw n)) = Just $ fromIntegral v; \
+  toCon _ = Nothing
+
+#if 1
+TOCON_MACHINE_INTEGER(SymIntN, IntN, 8, Int8)
+TOCON_MACHINE_INTEGER(SymIntN, IntN, 16, Int16)
+TOCON_MACHINE_INTEGER(SymIntN, IntN, 32, Int32)
+TOCON_MACHINE_INTEGER(SymIntN, IntN, 64, Int64)
+TOCON_MACHINE_INTEGER(SymWordN, WordN, 8, Word8)
+TOCON_MACHINE_INTEGER(SymWordN, WordN, 16, Word16)
+TOCON_MACHINE_INTEGER(SymWordN, WordN, 32, Word32)
+TOCON_MACHINE_INTEGER(SymWordN, WordN, 64, Word64)
+TOCON_MACHINE_INTEGER(SymIntN, IntN, $intBitwidthQ, Int)
+TOCON_MACHINE_INTEGER(SymWordN, WordN, $intBitwidthQ, Word)
+#endif
+
+deriving via
+  (Default AssertionError)
+  instance
+    ToCon AssertionError AssertionError
+
+deriving via
+  (Default VerificationConditions)
+  instance
+    ToCon VerificationConditions VerificationConditions
+
+-- Derivation of ToCon for generic types
+instance (Generic a, Generic b, ToCon' (Rep a) (Rep b)) => ToCon a (Default b) where
+  toCon v = fmap (Default . to) $ toCon' $ from v
+
+class ToCon' a b where
+  toCon' :: a c -> Maybe (b c)
+
+instance ToCon' U1 U1 where
+  toCon' = Just
+
+instance (ToCon a b) => ToCon' (K1 i a) (K1 i b) where
+  toCon' (K1 a) = K1 <$> toCon a
+
+instance (ToCon' a b) => ToCon' (M1 i c1 a) (M1 i c2 b) where
+  toCon' (M1 a) = M1 <$> toCon' a
+
+instance (ToCon' a1 a2, ToCon' b1 b2) => ToCon' (a1 :+: b1) (a2 :+: b2) where
+  toCon' (L1 a) = L1 <$> toCon' a
+  toCon' (R1 a) = R1 <$> toCon' a
+
+instance (ToCon' a1 a2, ToCon' b1 b2) => ToCon' (a1 :*: b1) (a2 :*: b2) where
+  toCon' (a :*: b) = do
+    ac <- toCon' a
+    bc <- toCon' b
+    return $ ac :*: bc
diff --git a/src/Grisette/Core/Data/Class/ToSym.hs b/src/Grisette/Core/Data/Class/ToSym.hs
--- a/src/Grisette/Core/Data/Class/ToSym.hs
+++ b/src/Grisette/Core/Data/Class/ToSym.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -50,7 +51,31 @@
     type (:*:) ((:*:)),
     type (:+:) (L1, R1),
   )
-import Grisette.Core.Data.BV (IntN, SomeIntN, SomeWordN, WordN)
+import Grisette.Core.Control.Exception (AssertionError, VerificationConditions)
+import Grisette.Core.Data.BV
+  ( IntN,
+    SomeIntN (SomeIntN),
+    SomeWordN (SomeWordN),
+    WordN,
+  )
+import Grisette.Core.Data.Class.Solvable (Solvable (con))
+import Grisette.IR.SymPrim.Data.IntBitwidth (intBitwidthQ)
+import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
+  ( LinkedRep,
+    SupportedPrim,
+    type (-->),
+  )
+import Grisette.IR.SymPrim.Data.SymPrim
+  ( SomeSymIntN (SomeSymIntN),
+    SomeSymWordN (SomeSymWordN),
+    SymBool,
+    SymIntN,
+    SymInteger,
+    SymWordN,
+    type (-~>),
+    type (=~>),
+  )
+import Grisette.IR.SymPrim.Data.TabularFun (type (=->))
 
 -- $setup
 -- >>> import Grisette.IR.SymPrim
@@ -66,28 +91,6 @@
   -- [false,true]
   toSym :: a -> b
 
-instance (Generic a, Generic b, ToSym' (Rep a) (Rep b)) => ToSym a (Default b) where
-  toSym = Default . to . toSym' . from
-
-class ToSym' a b where
-  toSym' :: a c -> b c
-
-instance ToSym' U1 U1 where
-  toSym' = id
-
-instance (ToSym a b) => ToSym' (K1 i a) (K1 i b) where
-  toSym' (K1 a) = K1 $ toSym a
-
-instance (ToSym' a b) => ToSym' (M1 i c1 a) (M1 i c2 b) where
-  toSym' (M1 a) = M1 $ toSym' a
-
-instance (ToSym' a1 a2, ToSym' b1 b2) => ToSym' (a1 :+: b1) (a2 :+: b2) where
-  toSym' (L1 a) = L1 $ toSym' a
-  toSym' (R1 b) = R1 $ toSym' b
-
-instance (ToSym' a1 a2, ToSym' b1 b2) => ToSym' (a1 :*: b1) (a2 :*: b2) where
-  toSym' (a :*: b) = toSym' a :*: toSym' b
-
 #define CONCRETE_TOSYM(type) \
 instance ToSym type type where \
   toSym = id
@@ -220,3 +223,127 @@
 -- IdentityT
 instance (ToSym (m a) (m1 b)) => ToSym (IdentityT m a) (IdentityT m1 b) where
   toSym (IdentityT v) = IdentityT $ toSym v
+
+#define TO_SYM_SYMID_SIMPLE(symtype) \
+instance ToSym symtype symtype where \
+  toSym = id
+
+#define TO_SYM_SYMID_BV(symtype) \
+instance (KnownNat n, 1 <= n) => ToSym (symtype n) (symtype n) where \
+  toSym = id
+
+#define TO_SYM_SYMID_FUN(op) \
+instance (SupportedPrim a, SupportedPrim b) => ToSym (a op b) (a op b) where \
+  toSym = id
+
+#if 1
+TO_SYM_SYMID_SIMPLE(SymBool)
+TO_SYM_SYMID_SIMPLE(SymInteger)
+TO_SYM_SYMID_BV(SymIntN)
+TO_SYM_SYMID_BV(SymWordN)
+TO_SYM_SYMID_FUN(=~>)
+TO_SYM_SYMID_FUN(-~>)
+TO_SYM_SYMID_SIMPLE(SomeSymIntN)
+TO_SYM_SYMID_SIMPLE(SomeSymWordN)
+#endif
+
+#define TO_SYM_FROMCON_SIMPLE(contype, symtype) \
+instance ToSym contype symtype where \
+  toSym = con
+
+#define TO_SYM_FROMCON_BV(contype, symtype) \
+instance (KnownNat n, 1 <= n) => ToSym (contype n) (symtype n) where \
+  toSym = con
+
+#define TO_SYM_FROMCON_FUN(conop, symop) \
+instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => ToSym (conop ca cb) (symop sa sb) where \
+  toSym = con
+
+#define TO_SYM_FROMCON_BV_SOME(contype, symtype) \
+instance ToSym contype symtype where \
+  toSym (contype v) = symtype (con v)
+
+#if 1
+TO_SYM_FROMCON_SIMPLE(Bool, SymBool)
+TO_SYM_FROMCON_SIMPLE(Integer, SymInteger)
+TO_SYM_FROMCON_BV(IntN, SymIntN)
+TO_SYM_FROMCON_BV(WordN, SymWordN)
+TO_SYM_FROMCON_FUN((=->), (=~>))
+TO_SYM_FROMCON_FUN((-->), (-~>))
+TO_SYM_FROMCON_BV_SOME(SomeIntN, SomeSymIntN)
+TO_SYM_FROMCON_BV_SOME(SomeWordN, SomeSymWordN)
+#endif
+
+#define TO_SYM_FROMBV_SOME(somesymbv, bv) \
+instance (KnownNat n, 1 <= n) => ToSym (bv n) somesymbv where \
+  toSym = somesymbv . con
+
+#if 1
+TO_SYM_FROMBV_SOME(SomeSymIntN, IntN)
+TO_SYM_FROMBV_SOME(SomeSymWordN, WordN)
+#endif
+
+#define TOSYM_MACHINE_INTEGER(int, bv) \
+instance ToSym int (bv) where \
+  toSym = fromIntegral
+
+#define TOSYM_MACHINE_INTEGER_SOME(int, somesymbv, bv, bitwidth) \
+instance ToSym int somesymbv where \
+  toSym v = somesymbv (con (fromIntegral v :: bv bitwidth))
+
+#if 1
+TOSYM_MACHINE_INTEGER(Int8, SymIntN 8)
+TOSYM_MACHINE_INTEGER(Int16, SymIntN 16)
+TOSYM_MACHINE_INTEGER(Int32, SymIntN 32)
+TOSYM_MACHINE_INTEGER(Int64, SymIntN 64)
+TOSYM_MACHINE_INTEGER(Word8, SymWordN 8)
+TOSYM_MACHINE_INTEGER(Word16, SymWordN 16)
+TOSYM_MACHINE_INTEGER(Word32, SymWordN 32)
+TOSYM_MACHINE_INTEGER(Word64, SymWordN 64)
+TOSYM_MACHINE_INTEGER(Int, SymIntN $intBitwidthQ)
+TOSYM_MACHINE_INTEGER(Word, SymWordN $intBitwidthQ)
+
+TOSYM_MACHINE_INTEGER_SOME(Int8, SomeSymIntN, IntN, 8)
+TOSYM_MACHINE_INTEGER_SOME(Int16, SomeSymIntN, IntN, 16)
+TOSYM_MACHINE_INTEGER_SOME(Int32, SomeSymIntN, IntN, 32)
+TOSYM_MACHINE_INTEGER_SOME(Int64, SomeSymIntN, IntN, 64)
+TOSYM_MACHINE_INTEGER_SOME(Word8, SomeSymWordN, WordN, 8)
+TOSYM_MACHINE_INTEGER_SOME(Word16, SomeSymWordN, WordN, 16)
+TOSYM_MACHINE_INTEGER_SOME(Word32, SomeSymWordN, WordN, 32)
+TOSYM_MACHINE_INTEGER_SOME(Word64, SomeSymWordN, WordN, 64)
+TOSYM_MACHINE_INTEGER_SOME(Int, SomeSymIntN, IntN, $intBitwidthQ)
+TOSYM_MACHINE_INTEGER_SOME(Word, SomeSymWordN, WordN, $intBitwidthQ)
+#endif
+
+-- Exception
+deriving via
+  (Default AssertionError)
+  instance
+    ToSym AssertionError AssertionError
+
+deriving via
+  (Default VerificationConditions)
+  instance
+    ToSym VerificationConditions VerificationConditions
+
+instance (Generic a, Generic b, ToSym' (Rep a) (Rep b)) => ToSym a (Default b) where
+  toSym = Default . to . toSym' . from
+
+class ToSym' a b where
+  toSym' :: a c -> b c
+
+instance ToSym' U1 U1 where
+  toSym' = id
+
+instance (ToSym a b) => ToSym' (K1 i a) (K1 i b) where
+  toSym' (K1 a) = K1 $ toSym a
+
+instance (ToSym' a b) => ToSym' (M1 i c1 a) (M1 i c2 b) where
+  toSym' (M1 a) = M1 $ toSym' a
+
+instance (ToSym' a1 a2, ToSym' b1 b2) => ToSym' (a1 :+: b1) (a2 :+: b2) where
+  toSym' (L1 a) = L1 $ toSym' a
+  toSym' (R1 b) = R1 $ toSym' b
+
+instance (ToSym' a1 a2, ToSym' b1 b2) => ToSym' (a1 :*: b1) (a2 :*: b2) where
+  toSym' (a :*: b) = toSym' a :*: toSym' b
diff --git a/src/Grisette/Core/Data/FileLocation.hs b/src/Grisette/Core/Data/FileLocation.hs
--- a/src/Grisette/Core/Data/FileLocation.hs
+++ b/src/Grisette/Core/Data/FileLocation.hs
@@ -25,6 +25,7 @@
 
 import Control.DeepSeq (NFData)
 import Data.Hashable (Hashable)
+import qualified Data.Text as T
 import Debug.Trace.LocationTH (__LOCATION__)
 import GHC.Generics (Generic)
 import Grisette.Core.Data.Class.GenSym (FreshIdent, nameWithInfo)
@@ -60,7 +61,7 @@
 -- a:<interactive>:...
 --
 -- The uniqueness is ensured for the call to 'nameWithLoc' at different location.
-nameWithLoc :: String -> SpliceQ FreshIdent
+nameWithLoc :: T.Text -> SpliceQ FreshIdent
 nameWithLoc s = [||nameWithInfo s (parseFileLocation $$(liftSplice $ unsafeTExpCoerce __LOCATION__))||]
 
 -- | Generate simply-named symbolic variables. The file location will be
@@ -78,7 +79,7 @@
 -- >>> let f _ = $$(slocsym "a") :: SymBool
 -- >>> f () == f ()
 -- True
-slocsym :: (Solvable c s) => String -> SpliceQ s
+slocsym :: (Solvable c s) => T.Text -> SpliceQ s
 slocsym nm = [||sinfosym nm (parseFileLocation $$(liftSplice $ unsafeTExpCoerce __LOCATION__))||]
 
 -- | Generate indexed symbolic variables. The file location will be attached to identifier.
@@ -89,5 +90,5 @@
 -- Calling 'ilocsymb' with the same name and index at different location will
 -- always generate different symbolic constants. Calling 'slocsymb' at the same
 -- location for multiple times will generate the same symbolic constants.
-ilocsym :: (Solvable c s) => String -> Int -> SpliceQ s
+ilocsym :: (Solvable c s) => T.Text -> Int -> SpliceQ s
 ilocsym nm idx = [||iinfosym nm idx (parseFileLocation $$(liftSplice $ unsafeTExpCoerce __LOCATION__))||]
diff --git a/src/Grisette/Core/Data/Union.hs b/src/Grisette/Core/Data/Union.hs
--- a/src/Grisette/Core/Data/Union.hs
+++ b/src/Grisette/Core/Data/Union.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
@@ -36,14 +37,12 @@
   )
 import Data.Hashable (Hashable (hashWithSalt))
 import GHC.Generics (Generic, Generic1)
-import Grisette.Core.Data.Class.Bool
-  ( ITEOp (ites),
-    LogicalOp (nots, (&&~), (||~)),
-  )
 import Grisette.Core.Data.Class.GPretty
   ( GPretty (gprettyPrec),
     condEnclose,
   )
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&), (.||)))
 import Grisette.Core.Data.Class.Mergeable
   ( Mergeable (rootStrategy),
     Mergeable1 (liftRootStrategy),
@@ -52,12 +51,18 @@
 import Grisette.Core.Data.Class.SimpleMergeable
   ( SimpleMergeable (mrgIte),
     SimpleMergeable1 (liftMrgIte),
-    UnionLike (mergeWithStrategy, mrgIfWithStrategy, mrgSingleWithStrategy, single, unionIf),
+    UnionLike
+      ( mergeWithStrategy,
+        mrgIfWithStrategy,
+        mrgSingleWithStrategy,
+        single,
+        unionIf
+      ),
     UnionPrjOp (ifView, leftMost, singleView),
     mrgIf,
   )
 import Grisette.Core.Data.Class.Solvable (pattern Con)
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim
+import Grisette.IR.SymPrim.Data.SymPrim
   ( AllSyms (allSymsS),
     SomeSym (SomeSym),
     SymBool,
@@ -73,9 +78,9 @@
 -- | The default union implementation.
 data Union a
   = -- | A single value
-    Single a
+    UnionSingle a
   | -- | A if value
-    If
+    UnionIf
       a
       -- ^ Cached leftmost value
       !Bool
@@ -89,8 +94,8 @@
   deriving (Generic, Eq, Lift, Generic1)
 
 instance Eq1 Union where
-  liftEq e (Single a) (Single b) = e a b
-  liftEq e (If l1 i1 c1 t1 f1) (If l2 i2 c2 t2 f2) =
+  liftEq e (UnionSingle a) (UnionSingle b) = e a b
+  liftEq e (UnionIf l1 i1 c1 t1 f1) (UnionIf l2 i2 c2 t2 f2) =
     e l1 l2 && i1 == i2 && c1 == c2 && liftEq e t1 t2 && liftEq e f1 f2
   liftEq _ _ _ = False
 
@@ -98,28 +103,34 @@
   rnf = rnf1
 
 instance NFData1 Union where
-  liftRnf _a (Single a) = _a a
-  liftRnf _a (If a bo b l r) = _a a `seq` rnf bo `seq` rnf b `seq` liftRnf _a l `seq` liftRnf _a r
+  liftRnf _a (UnionSingle a) = _a a
+  liftRnf _a (UnionIf a bo b l r) =
+    _a a `seq`
+      rnf bo `seq`
+        rnf b `seq`
+          liftRnf _a l `seq`
+            liftRnf _a r
 
--- | Build 'If' with leftmost cache correctly maintained.
+-- | Build 'UnionIf' with leftmost cache correctly maintained.
 --
--- Usually you should never directly try to build a 'If' with its constructor.
+-- Usually you should never directly try to build a 'UnionIf' with its
+-- constructor.
 ifWithLeftMost :: Bool -> SymBool -> Union a -> Union a -> Union a
 ifWithLeftMost _ (Con c) t f
   | c = t
   | otherwise = f
-ifWithLeftMost inv cond t f = If (leftMost t) inv cond t f
+ifWithLeftMost inv cond t f = UnionIf (leftMost t) inv cond t f
 {-# INLINE ifWithLeftMost #-}
 
 instance UnionPrjOp Union where
-  singleView (Single a) = Just a
+  singleView (UnionSingle a) = Just a
   singleView _ = Nothing
   {-# INLINE singleView #-}
-  ifView (If _ _ cond ifTrue ifFalse) = Just (cond, ifTrue, ifFalse)
+  ifView (UnionIf _ _ cond ifTrue ifFalse) = Just (cond, ifTrue, ifFalse)
   ifView _ = Nothing
   {-# INLINE ifView #-}
-  leftMost (Single a) = a
-  leftMost (If a _ _ _ _) = a
+  leftMost (UnionSingle a) = a
+  leftMost (UnionIf a _ _ _ _) = a
   {-# INLINE leftMost #-}
 
 instance (Mergeable a) => Mergeable (Union a) where
@@ -139,20 +150,26 @@
 instance UnionLike Union where
   mergeWithStrategy = fullReconstruct
   {-# INLINE mergeWithStrategy #-}
-  single = Single
+  single = UnionSingle
   {-# INLINE single #-}
   unionIf = ifWithLeftMost False
   {-# INLINE unionIf #-}
   mrgIfWithStrategy = ifWithStrategy
   {-# INLINE mrgIfWithStrategy #-}
-  mrgSingleWithStrategy _ = Single
+  mrgSingleWithStrategy _ = UnionSingle
   {-# INLINE mrgSingleWithStrategy #-}
 
 instance Show1 Union where
-  liftShowsPrec sp _ i (Single a) = showsUnaryWith sp "Single" i a
-  liftShowsPrec sp sl i (If _ _ cond t f) =
+  liftShowsPrec sp _ i (UnionSingle a) = showsUnaryWith sp "Single" i a
+  liftShowsPrec sp sl i (UnionIf _ _ cond t f) =
     showParen (i > 10) $
-      showString "If" . showChar ' ' . showsPrec 11 cond . showChar ' ' . sp1 11 t . showChar ' ' . sp1 11 f
+      showString "If"
+        . showChar ' '
+        . showsPrec 11 cond
+        . showChar ' '
+        . sp1 11 t
+        . showChar ' '
+        . sp1 11 f
     where
       sp1 = liftShowsPrec sp sl
 
@@ -160,8 +177,8 @@
   showsPrec = showsPrec1
 
 instance (GPretty a) => GPretty (Union a) where
-  gprettyPrec n (Single a) = gprettyPrec n a
-  gprettyPrec n (If _ _ cond t f) =
+  gprettyPrec n (UnionSingle a) = gprettyPrec n a
+  gprettyPrec n (UnionIf _ _ cond t f) =
     group $
       condEnclose (n > 10) "(" ")" $
         align $
@@ -174,21 +191,31 @@
               ]
 
 instance (Hashable a) => Hashable (Union a) where
-  s `hashWithSalt` (Single a) = s `hashWithSalt` (0 :: Int) `hashWithSalt` a
-  s `hashWithSalt` (If _ _ c l r) = s `hashWithSalt` (1 :: Int) `hashWithSalt` c `hashWithSalt` l `hashWithSalt` r
+  s `hashWithSalt` (UnionSingle a) =
+    s `hashWithSalt` (0 :: Int) `hashWithSalt` a
+  s `hashWithSalt` (UnionIf _ _ c l r) =
+    s
+      `hashWithSalt` (1 :: Int)
+      `hashWithSalt` c
+      `hashWithSalt` l
+      `hashWithSalt` r
 
 instance (AllSyms a) => AllSyms (Union a) where
-  allSymsS (Single v) = allSymsS v
-  allSymsS (If _ _ c t f) = \l -> SomeSym c : (allSymsS t . allSymsS f $ l)
+  allSymsS (UnionSingle v) = allSymsS v
+  allSymsS (UnionIf _ _ c t f) = \l -> SomeSym c : (allSymsS t . allSymsS f $ l)
 
 -- | Fully reconstruct a 'Union' to maintain the merged invariant.
 fullReconstruct :: MergingStrategy a -> Union a -> Union a
-fullReconstruct strategy (If _ False cond t f) =
-  ifWithStrategyInv strategy cond (fullReconstruct strategy t) (fullReconstruct strategy f)
+fullReconstruct strategy (UnionIf _ False cond t f) =
+  ifWithStrategyInv
+    strategy
+    cond
+    (fullReconstruct strategy t)
+    (fullReconstruct strategy f)
 fullReconstruct _ u = u
 {-# INLINE fullReconstruct #-}
 
--- | Use a specific strategy to build a 'If' value.
+-- | Use a specific strategy to build a 'UnionIf' value.
 --
 -- The merged invariant will be maintained in the result.
 ifWithStrategy ::
@@ -197,8 +224,10 @@
   Union a ->
   Union a ->
   Union a
-ifWithStrategy strategy cond t@(If _ False _ _ _) f = ifWithStrategy strategy cond (fullReconstruct strategy t) f
-ifWithStrategy strategy cond t f@(If _ False _ _ _) = ifWithStrategy strategy cond t (fullReconstruct strategy f)
+ifWithStrategy strategy cond t@(UnionIf _ False _ _ _) f =
+  ifWithStrategy strategy cond (fullReconstruct strategy t) f
+ifWithStrategy strategy cond t f@(UnionIf _ False _ _ _) =
+  ifWithStrategy strategy cond t (fullReconstruct strategy f)
 ifWithStrategy strategy cond t f = ifWithStrategyInv strategy cond t f
 {-# INLINE ifWithStrategy #-}
 
@@ -211,66 +240,66 @@
 ifWithStrategyInv _ (Con v) t f
   | v = t
   | otherwise = f
-ifWithStrategyInv strategy cond (If _ True condTrue tt _) f
+ifWithStrategyInv strategy cond (UnionIf _ True condTrue tt _) f
   | cond == condTrue = ifWithStrategyInv strategy cond tt f
--- {| nots cond == condTrue || cond == nots condTrue = ifWithStrategyInv strategy cond ft f
-ifWithStrategyInv strategy cond t (If _ True condFalse _ ff)
+-- {| symNot cond == condTrue || cond == symNot condTrue = ifWithStrategyInv strategy cond ft f
+ifWithStrategyInv strategy cond t (UnionIf _ True condFalse _ ff)
   | cond == condFalse = ifWithStrategyInv strategy cond t ff
--- {| nots cond == condTrue || cond == nots condTrue = ifWithStrategyInv strategy cond t tf -- buggy here condTrue
-ifWithStrategyInv (SimpleStrategy m) cond (Single l) (Single r) = Single $ m cond l r
+-- {| symNot cond == condTrue || cond == symNot condTrue = ifWithStrategyInv strategy cond t tf -- buggy here condTrue
+ifWithStrategyInv (SimpleStrategy m) cond (UnionSingle l) (UnionSingle r) = UnionSingle $ m cond l r
 ifWithStrategyInv strategy@(SortedStrategy idxFun substrategy) cond ifTrue ifFalse = case (ifTrue, ifFalse) of
-  (Single _, Single _) -> ssIf cond ifTrue ifFalse
-  (Single _, If {}) -> sgIf cond ifTrue ifFalse
-  (If {}, Single _) -> gsIf cond ifTrue ifFalse
-  _ -> ggIf cond ifTrue ifFalse
+  (UnionSingle _, UnionSingle _) -> ssUnionIf cond ifTrue ifFalse
+  (UnionSingle _, UnionIf {}) -> sgUnionIf cond ifTrue ifFalse
+  (UnionIf {}, UnionSingle _) -> gsUnionIf cond ifTrue ifFalse
+  _ -> ggUnionIf cond ifTrue ifFalse
   where
-    ssIf cond' ifTrue' ifFalse'
+    ssUnionIf cond' ifTrue' ifFalse'
       | idxt < idxf = ifWithLeftMost True cond' ifTrue' ifFalse'
       | idxt == idxf = ifWithStrategyInv (substrategy idxt) cond' ifTrue' ifFalse'
-      | otherwise = ifWithLeftMost True (nots cond') ifFalse' ifTrue'
+      | otherwise = ifWithLeftMost True (symNot cond') ifFalse' ifTrue'
       where
         idxt = idxFun $ leftMost ifTrue'
         idxf = idxFun $ leftMost ifFalse'
-    {-# INLINE ssIf #-}
-    sgIf cond' ifTrue' ifFalse'@(If _ True condf ft ff)
-      | idxft == idxff = ssIf cond' ifTrue' ifFalse'
+    {-# INLINE ssUnionIf #-}
+    sgUnionIf cond' ifTrue' ifFalse'@(UnionIf _ True condf ft ff)
+      | idxft == idxff = ssUnionIf cond' ifTrue' ifFalse'
       | idxt < idxft = ifWithLeftMost True cond' ifTrue' ifFalse'
-      | idxt == idxft = ifWithLeftMost True (cond' ||~ condf) (ifWithStrategyInv (substrategy idxt) cond' ifTrue' ft) ff
-      | otherwise = ifWithLeftMost True (nots cond' &&~ condf) ft (ifWithStrategyInv strategy cond' ifTrue' ff)
+      | idxt == idxft = ifWithLeftMost True (cond' .|| condf) (ifWithStrategyInv (substrategy idxt) cond' ifTrue' ft) ff
+      | otherwise = ifWithLeftMost True (symNot cond' .&& condf) ft (ifWithStrategyInv strategy cond' ifTrue' ff)
       where
         idxft = idxFun $ leftMost ft
         idxff = idxFun $ leftMost ff
         idxt = idxFun $ leftMost ifTrue'
-    sgIf _ _ _ = undefined
-    {-# INLINE sgIf #-}
-    gsIf cond' ifTrue'@(If _ True condt tt tf) ifFalse'
-      | idxtt == idxtf = ssIf cond' ifTrue' ifFalse'
-      | idxtt < idxf = ifWithLeftMost True (cond' &&~ condt) tt $ ifWithStrategyInv strategy cond' tf ifFalse'
-      | idxtt == idxf = ifWithLeftMost True (nots cond' ||~ condt) (ifWithStrategyInv (substrategy idxf) cond' tt ifFalse') tf
-      | otherwise = ifWithLeftMost True (nots cond') ifFalse' ifTrue'
+    sgUnionIf _ _ _ = undefined
+    {-# INLINE sgUnionIf #-}
+    gsUnionIf cond' ifTrue'@(UnionIf _ True condt tt tf) ifFalse'
+      | idxtt == idxtf = ssUnionIf cond' ifTrue' ifFalse'
+      | idxtt < idxf = ifWithLeftMost True (cond' .&& condt) tt $ ifWithStrategyInv strategy cond' tf ifFalse'
+      | idxtt == idxf = ifWithLeftMost True (symNot cond' .|| condt) (ifWithStrategyInv (substrategy idxf) cond' tt ifFalse') tf
+      | otherwise = ifWithLeftMost True (symNot cond') ifFalse' ifTrue'
       where
         idxtt = idxFun $ leftMost tt
         idxtf = idxFun $ leftMost tf
         idxf = idxFun $ leftMost ifFalse'
-    gsIf _ _ _ = undefined
-    {-# INLINE gsIf #-}
-    ggIf cond' ifTrue'@(If _ True condt tt tf) ifFalse'@(If _ True condf ft ff)
-      | idxtt == idxtf = sgIf cond' ifTrue' ifFalse'
-      | idxft == idxff = gsIf cond' ifTrue' ifFalse'
-      | idxtt < idxft = ifWithLeftMost True (cond' &&~ condt) tt $ ifWithStrategyInv strategy cond' tf ifFalse'
+    gsUnionIf _ _ _ = undefined
+    {-# INLINE gsUnionIf #-}
+    ggUnionIf cond' ifTrue'@(UnionIf _ True condt tt tf) ifFalse'@(UnionIf _ True condf ft ff)
+      | idxtt == idxtf = sgUnionIf cond' ifTrue' ifFalse'
+      | idxft == idxff = gsUnionIf cond' ifTrue' ifFalse'
+      | idxtt < idxft = ifWithLeftMost True (cond' .&& condt) tt $ ifWithStrategyInv strategy cond' tf ifFalse'
       | idxtt == idxft =
-          let newCond = ites cond' condt condf
-              newIfTrue = ifWithStrategyInv (substrategy idxtt) cond' tt ft
-              newIfFalse = ifWithStrategyInv strategy cond' tf ff
-           in ifWithLeftMost True newCond newIfTrue newIfFalse
-      | otherwise = ifWithLeftMost True (nots cond' &&~ condf) ft $ ifWithStrategyInv strategy cond' ifTrue' ff
+          let newCond = symIte cond' condt condf
+              newUnionIfTrue = ifWithStrategyInv (substrategy idxtt) cond' tt ft
+              newUnionIfFalse = ifWithStrategyInv strategy cond' tf ff
+           in ifWithLeftMost True newCond newUnionIfTrue newUnionIfFalse
+      | otherwise = ifWithLeftMost True (symNot cond' .&& condf) ft $ ifWithStrategyInv strategy cond' ifTrue' ff
       where
         idxtt = idxFun $ leftMost tt
         idxtf = idxFun $ leftMost tf
         idxft = idxFun $ leftMost ft
         idxff = idxFun $ leftMost ff
-    ggIf _ _ _ = undefined
-    {-# INLINE ggIf #-}
+    ggUnionIf _ _ _ = undefined
+    {-# INLINE ggUnionIf #-}
 ifWithStrategyInv NoStrategy cond ifTrue ifFalse = ifWithLeftMost True cond ifTrue ifFalse
 ifWithStrategyInv _ _ _ _ = error "Invariant violated"
 {-# INLINE ifWithStrategyInv #-}
diff --git a/src/Grisette/Experimental/GenSymConstrained.hs b/src/Grisette/Experimental/GenSymConstrained.hs
--- a/src/Grisette/Experimental/GenSymConstrained.hs
+++ b/src/Grisette/Experimental/GenSymConstrained.hs
@@ -42,7 +42,6 @@
   ( UnionM,
     liftToMonadUnion,
   )
-import Grisette.Core.Data.Class.Bool (LogicalOp ((||~)))
 import Grisette.Core.Data.Class.GenSym
   ( FreshIdent,
     GenSym (fresh),
@@ -54,8 +53,9 @@
     chooseUnionFresh,
     runFreshT,
   )
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp ((.||)))
 import Grisette.Core.Data.Class.Mergeable (Mergeable, Mergeable1)
-import Grisette.Core.Data.Class.SOrd (SOrd ((<~), (>=~)))
+import Grisette.Core.Data.Class.SOrd (SOrd ((.<), (.>=)))
 import Grisette.Core.Data.Class.SimpleMergeable
   ( UnionLike,
     merge,
@@ -136,13 +136,13 @@
   freshConstrained e (SOrdUpperBound u spec) = do
     s <- fresh spec
     v <- liftToMonadUnion s
-    mrgIf (v >=~ u) (throwError e) (return ())
+    mrgIf (v .>= u) (throwError e) (return ())
     mrgSingle $ mrgSingle v
 
 instance {-# OVERLAPPABLE #-} (SOrd a, Mergeable a, GenSymSimple spec a) => GenSymSimpleConstrained (SOrdUpperBound a spec) a where
   simpleFreshConstrained e (SOrdUpperBound u spec) = do
     s <- simpleFresh spec
-    mrgIf (s >=~ u) (throwError e) (return ())
+    mrgIf (s .>= u) (throwError e) (return ())
     mrgSingle s
 
 -- | Inclusive bound, generates the values with the specification, then filters
@@ -153,13 +153,13 @@
   freshConstrained e (SOrdLowerBound l spec) = do
     s <- fresh spec
     v <- liftToMonadUnion s
-    mrgIf (v <~ l) (throwError e) (return ())
+    mrgIf (v .< l) (throwError e) (return ())
     mrgSingle $ mrgSingle v
 
 instance {-# OVERLAPPABLE #-} (SOrd a, Mergeable a, GenSymSimple spec a) => GenSymSimpleConstrained (SOrdLowerBound a spec) a where
   simpleFreshConstrained e (SOrdLowerBound l spec) = do
     s <- simpleFresh spec
-    mrgIf (s <~ l) (throwError e) (return ())
+    mrgIf (s .< l) (throwError e) (return ())
     mrgSingle s
 
 -- | Left-inclusive, right-exclusive bound, generates the values with the
@@ -170,13 +170,13 @@
   freshConstrained e (SOrdBound l u spec) = do
     s <- fresh spec
     v <- liftToMonadUnion s
-    mrgIf (v <~ l ||~ v >=~ u) (throwError e) (return ())
+    mrgIf (v .< l .|| v .>= u) (throwError e) (return ())
     mrgSingle $ mrgSingle v
 
 instance {-# OVERLAPPABLE #-} (SOrd a, Mergeable a, GenSymSimple spec a) => GenSymSimpleConstrained (SOrdBound a spec) a where
   simpleFreshConstrained e (SOrdBound l u spec) = do
     s <- simpleFresh spec
-    mrgIf (s <~ l ||~ s >=~ u) (throwError e) (return ())
+    mrgIf (s .< l .|| s .>= u) (throwError e) (return ())
     mrgSingle s
 
 instance GenSymConstrained (SOrdBound Integer ()) Integer where
diff --git a/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/InternedCtors.hs b/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/InternedCtors.hs
--- a/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/InternedCtors.hs
+++ b/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/InternedCtors.hs
@@ -43,10 +43,12 @@
     orBitsTerm,
     xorBitsTerm,
     complementBitsTerm,
-    shiftBitsTerm,
-    rotateBitsTerm,
-    bvToSignedTerm,
-    bvToUnsignedTerm,
+    shiftLeftTerm,
+    shiftRightTerm,
+    rotateLeftTerm,
+    rotateRightTerm,
+    toSignedTerm,
+    toUnsignedTerm,
     bvconcatTerm,
     bvselectTerm,
     bvextendTerm,
@@ -67,7 +69,7 @@
 
 import Control.DeepSeq (NFData)
 import Data.Array ((!))
-import Data.Bits (Bits)
+import Data.Bits (Bits, FiniteBits)
 import qualified Data.HashMap.Strict as M
 import Data.Hashable (Hashable (hash))
 import Data.IORef (atomicModifyIORef')
@@ -78,12 +80,15 @@
   ( Cache (getCache),
     CacheState (CacheState),
   )
+import qualified Data.Text as T
 import GHC.IO (unsafeDupablePerformIO)
 import GHC.TypeNats (KnownNat, type (+), type (<=))
 import Grisette.Core.Data.Class.BitVector
-  ( BVSignConversion,
-    SizedBV,
+  ( SizedBV,
   )
+import Grisette.Core.Data.Class.SignConversion (SignConversion)
+import Grisette.Core.Data.Class.SymRotate (SymRotate)
+import Grisette.Core.Data.Class.SymShift (SymShift)
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
   ( BinaryOp,
     SupportedPrim,
@@ -98,8 +103,6 @@
         UBVConcatTerm,
         UBVExtendTerm,
         UBVSelectTerm,
-        UBVToSignedTerm,
-        UBVToUnsignedTerm,
         UBinaryTerm,
         UComplementBitsTerm,
         UConTerm,
@@ -119,13 +122,17 @@
         UQuotIntegralTerm,
         URemBoundedIntegralTerm,
         URemIntegralTerm,
-        URotateBitsTerm,
-        UShiftBitsTerm,
+        URotateLeftTerm,
+        URotateRightTerm,
+        UShiftLeftTerm,
+        UShiftRightTerm,
         USignumNumTerm,
         USymTerm,
         UTabularFunApplyTerm,
         UTernaryTerm,
         UTimesNumTerm,
+        UToSignedTerm,
+        UToUnsignedTerm,
         UUMinusNumTerm,
         UUnaryTerm,
         UXorBitsTerm
@@ -189,17 +196,17 @@
 symTerm t = internTerm $ USymTerm t
 {-# INLINE symTerm #-}
 
-ssymTerm :: (SupportedPrim t, Typeable t) => String -> Term t
+ssymTerm :: (SupportedPrim t, Typeable t) => T.Text -> Term t
 ssymTerm = symTerm . SimpleSymbol
 {-# INLINE ssymTerm #-}
 
-isymTerm :: (SupportedPrim t, Typeable t) => String -> Int -> Term t
+isymTerm :: (SupportedPrim t, Typeable t) => T.Text -> Int -> Term t
 isymTerm str idx = symTerm $ IndexedSymbol str idx
 {-# INLINE isymTerm #-}
 
 sinfosymTerm ::
   (SupportedPrim t, Typeable t, Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) =>
-  String ->
+  T.Text ->
   a ->
   Term t
 sinfosymTerm s info = symTerm $ WithInfo (SimpleSymbol s) info
@@ -207,7 +214,7 @@
 
 iinfosymTerm ::
   (SupportedPrim t, Typeable t, Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) =>
-  String ->
+  T.Text ->
   Int ->
   a ->
   Term t
@@ -278,39 +285,39 @@
 complementBitsTerm = internTerm . UComplementBitsTerm
 {-# INLINE complementBitsTerm #-}
 
-shiftBitsTerm :: (SupportedPrim a, Bits a) => Term a -> Int -> Term a
-shiftBitsTerm t n = internTerm $ UShiftBitsTerm t n
-{-# INLINE shiftBitsTerm #-}
+shiftLeftTerm :: (SupportedPrim a, Integral a, FiniteBits a, SymShift a) => Term a -> Term a -> Term a
+shiftLeftTerm t n = internTerm $ UShiftLeftTerm t n
+{-# INLINE shiftLeftTerm #-}
 
-rotateBitsTerm :: (SupportedPrim a, Bits a) => Term a -> Int -> Term a
-rotateBitsTerm t n = internTerm $ URotateBitsTerm t n
-{-# INLINE rotateBitsTerm #-}
+shiftRightTerm :: (SupportedPrim a, Integral a, FiniteBits a, SymShift a) => Term a -> Term a -> Term a
+shiftRightTerm t n = internTerm $ UShiftRightTerm t n
+{-# INLINE shiftRightTerm #-}
 
-bvToSignedTerm ::
-  ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-    forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-    Typeable ubv,
-    Typeable sbv,
-    KnownNat n,
-    1 <= n,
-    BVSignConversion (ubv n) (sbv n)
+rotateLeftTerm :: (SupportedPrim a, Integral a, FiniteBits a, SymRotate a) => Term a -> Term a -> Term a
+rotateLeftTerm t n = internTerm $ URotateLeftTerm t n
+{-# INLINE rotateLeftTerm #-}
+
+rotateRightTerm :: (SupportedPrim a, Integral a, FiniteBits a, SymRotate a) => Term a -> Term a -> Term a
+rotateRightTerm t n = internTerm $ URotateRightTerm t n
+{-# INLINE rotateRightTerm #-}
+
+toSignedTerm ::
+  ( SupportedPrim u,
+    SupportedPrim s,
+    SignConversion u s
   ) =>
-  Term (ubv n) ->
-  Term (sbv n)
-bvToSignedTerm = internTerm . UBVToSignedTerm
+  Term u ->
+  Term s
+toSignedTerm = internTerm . UToSignedTerm
 
-bvToUnsignedTerm ::
-  ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-    forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-    Typeable ubv,
-    Typeable sbv,
-    KnownNat n,
-    1 <= n,
-    BVSignConversion (ubv n) (sbv n)
+toUnsignedTerm ::
+  ( SupportedPrim u,
+    SupportedPrim s,
+    SignConversion u s
   ) =>
-  Term (sbv n) ->
-  Term (ubv n)
-bvToUnsignedTerm = internTerm . UBVToUnsignedTerm
+  Term s ->
+  Term u
+toUnsignedTerm = internTerm . UToUnsignedTerm
 
 bvconcatTerm ::
   ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n),
diff --git a/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/InternedCtors.hs-boot b/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/InternedCtors.hs-boot
--- a/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/InternedCtors.hs-boot
+++ b/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/InternedCtors.hs-boot
@@ -32,10 +32,12 @@
     orBitsTerm,
     xorBitsTerm,
     complementBitsTerm,
-    shiftBitsTerm,
-    rotateBitsTerm,
-    bvToSignedTerm,
-    bvToUnsignedTerm,
+    shiftLeftTerm,
+    shiftRightTerm,
+    rotateLeftTerm,
+    rotateRightTerm,
+    toSignedTerm,
+    toUnsignedTerm,
     bvconcatTerm,
     bvselectTerm,
     bvextendTerm,
@@ -55,14 +57,17 @@
 where
 
 import Control.DeepSeq (NFData)
-import Data.Bits (Bits)
+import Data.Bits (Bits, FiniteBits)
 import Data.Hashable (Hashable)
+import qualified Data.Text as T
 import Data.Typeable (Typeable)
 import GHC.TypeNats (KnownNat, type (+), type (<=))
 import Grisette.Core.Data.Class.BitVector
-  ( BVSignConversion,
-    SizedBV,
+  ( SizedBV,
   )
+import Grisette.Core.Data.Class.SignConversion (SignConversion)
+import Grisette.Core.Data.Class.SymRotate (SymRotate)
+import Grisette.Core.Data.Class.SymShift (SymShift)
 import {-# SOURCE #-} Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
   ( BinaryOp,
     SupportedPrim,
@@ -72,7 +77,7 @@
     UnaryOp,
     type (-->),
   )
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.TabularFun
+import Grisette.IR.SymPrim.Data.TabularFun
   ( type (=->),
   )
 import Language.Haskell.TH.Syntax (Lift)
@@ -100,16 +105,16 @@
   Term t
 conTerm :: (SupportedPrim t, Typeable t, Hashable t, Eq t, Show t) => t -> Term t
 symTerm :: (SupportedPrim t, Typeable t) => TypedSymbol t -> Term t
-ssymTerm :: (SupportedPrim t, Typeable t) => String -> Term t
-isymTerm :: (SupportedPrim t, Typeable t) => String -> Int -> Term t
+ssymTerm :: (SupportedPrim t, Typeable t) => T.Text -> Term t
+isymTerm :: (SupportedPrim t, Typeable t) => T.Text -> Int -> Term t
 sinfosymTerm ::
   (SupportedPrim t, Typeable t, Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) =>
-  String ->
+  T.Text ->
   a ->
   Term t
 iinfosymTerm ::
   (SupportedPrim t, Typeable t, Typeable a, Ord a, Lift a, NFData a, Show a, Hashable a) =>
-  String ->
+  T.Text ->
   Int ->
   a ->
   Term t
@@ -129,30 +134,24 @@
 orBitsTerm :: (SupportedPrim a, Bits a) => Term a -> Term a -> Term a
 xorBitsTerm :: (SupportedPrim a, Bits a) => Term a -> Term a -> Term a
 complementBitsTerm :: (SupportedPrim a, Bits a) => Term a -> Term a
-shiftBitsTerm :: (SupportedPrim a, Bits a) => Term a -> Int -> Term a
-rotateBitsTerm :: (SupportedPrim a, Bits a) => Term a -> Int -> Term a
-bvToSignedTerm ::
-  ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-    forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-    Typeable ubv,
-    Typeable sbv,
-    KnownNat n,
-    1 <= n,
-    BVSignConversion (ubv n) (sbv n)
+shiftLeftTerm :: (SupportedPrim a, Integral a, FiniteBits a, SymShift a) => Term a -> Term a -> Term a
+shiftRightTerm :: (SupportedPrim a, Integral a, FiniteBits a, SymShift a) => Term a -> Term a -> Term a
+rotateLeftTerm :: (SupportedPrim a, Integral a, FiniteBits a, SymRotate a) => Term a -> Term a -> Term a
+rotateRightTerm :: (SupportedPrim a, Integral a, FiniteBits a, SymRotate a) => Term a -> Term a -> Term a
+toSignedTerm ::
+  ( SupportedPrim u,
+    SupportedPrim s,
+    SignConversion u s
   ) =>
-  Term (ubv n) ->
-  Term (sbv n)
-bvToUnsignedTerm ::
-  ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-    forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-    Typeable ubv,
-    Typeable sbv,
-    KnownNat n,
-    1 <= n,
-    BVSignConversion (ubv n) (sbv n)
+  Term u ->
+  Term s
+toUnsignedTerm ::
+  ( SupportedPrim u,
+    SupportedPrim s,
+    SignConversion u s
   ) =>
-  Term (sbv n) ->
-  Term (ubv n)
+  Term s ->
+  Term u
 bvconcatTerm ::
   ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n),
     Typeable bv,
diff --git a/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/Term.hs b/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/Term.hs
--- a/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/Term.hs
+++ b/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/Term.hs
@@ -52,7 +52,7 @@
 where
 
 import Control.DeepSeq (NFData (rnf))
-import Data.Bits (Bits)
+import Data.Bits (Bits, FiniteBits)
 import Data.Function (on)
 import Data.Hashable (Hashable (hashWithSalt))
 import Data.Interned
@@ -62,15 +62,18 @@
   )
 import Data.Kind (Constraint)
 import Data.String (IsString (fromString))
+import qualified Data.Text as T
 import Data.Typeable (Proxy (Proxy), cast)
 import GHC.Generics (Generic)
 import GHC.TypeNats (KnownNat, Nat, type (+), type (<=))
 import Grisette.Core.Data.BV (IntN, WordN)
 import Grisette.Core.Data.Class.BitVector
-  ( BVSignConversion,
-    SizedBV,
+  ( SizedBV,
   )
 import Grisette.Core.Data.Class.Function (Function (Arg, Ret, (#)))
+import Grisette.Core.Data.Class.SignConversion (SignConversion)
+import Grisette.Core.Data.Class.SymRotate (SymRotate)
+import Grisette.Core.Data.Class.SymShift (SymShift)
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Caches
   ( typeMemoizedCache,
   )
@@ -79,8 +82,6 @@
     addNumTerm,
     andBitsTerm,
     andTerm,
-    bvToSignedTerm,
-    bvToUnsignedTerm,
     bvconcatTerm,
     bvextendTerm,
     bvselectTerm,
@@ -105,12 +106,16 @@
     quotIntegralTerm,
     remBoundedIntegralTerm,
     remIntegralTerm,
-    rotateBitsTerm,
-    shiftBitsTerm,
+    rotateLeftTerm,
+    rotateRightTerm,
+    shiftLeftTerm,
+    shiftRightTerm,
     signumNumTerm,
     symTerm,
     tabularFunApplyTerm,
     timesNumTerm,
+    toSignedTerm,
+    toUnsignedTerm,
     uminusNumTerm,
     xorBitsTerm,
   )
@@ -256,8 +261,8 @@
 -- >>> "a" :: TypedSymbol Bool
 -- a :: Bool
 data TypedSymbol t where
-  SimpleSymbol :: (SupportedPrim t) => String -> TypedSymbol t
-  IndexedSymbol :: (SupportedPrim t) => String -> Int -> TypedSymbol t
+  SimpleSymbol :: (SupportedPrim t) => T.Text -> TypedSymbol t
+  IndexedSymbol :: (SupportedPrim t) => T.Text -> Int -> TypedSymbol t
   WithInfo ::
     forall t a.
     ( SupportedPrim t,
@@ -296,13 +301,13 @@
   liftTyped (WithInfo s1 i1) = [||WithInfo s1 i1||]
 
 instance Show (TypedSymbol t) where
-  show (SimpleSymbol str) = str ++ " :: " ++ show (typeRep @t)
-  show (IndexedSymbol str i) = str ++ "@" ++ show i ++ " :: " ++ show (typeRep @t)
+  show (SimpleSymbol str) = T.unpack str ++ " :: " ++ show (typeRep @t)
+  show (IndexedSymbol str i) = T.unpack str ++ "@" ++ show i ++ " :: " ++ show (typeRep @t)
   show (WithInfo s info) = showUntyped s ++ ":" ++ show info ++ " :: " ++ show (typeRep @t)
 
 showUntyped :: TypedSymbol t -> String
-showUntyped (SimpleSymbol str) = str
-showUntyped (IndexedSymbol str i) = str ++ "@" ++ show i
+showUntyped (SimpleSymbol str) = T.unpack str
+showUntyped (IndexedSymbol str i) = T.unpack str ++ "@" ++ show i
 showUntyped (WithInfo s info) = showUntyped s ++ ":" ++ show info
 
 instance Hashable (TypedSymbol t) where
@@ -316,7 +321,7 @@
   rnf (WithInfo s info) = rnf s `seq` rnf info
 
 instance (SupportedPrim t) => IsString (TypedSymbol t) where
-  fromString = SimpleSymbol
+  fromString = SimpleSymbol . T.pack
 
 withSymbolSupported :: TypedSymbol t -> ((SupportedPrim t) => a) -> a
 withSymbolSupported (SimpleSymbol _) a = a
@@ -419,32 +424,26 @@
   OrBitsTerm :: (SupportedPrim t, Bits t) => {-# UNPACK #-} !Id -> !(Term t) -> !(Term t) -> Term t
   XorBitsTerm :: (SupportedPrim t, Bits t) => {-# UNPACK #-} !Id -> !(Term t) -> !(Term t) -> Term t
   ComplementBitsTerm :: (SupportedPrim t, Bits t) => {-# UNPACK #-} !Id -> !(Term t) -> Term t
-  ShiftBitsTerm :: (SupportedPrim t, Bits t) => {-# UNPACK #-} !Id -> !(Term t) -> {-# UNPACK #-} !Int -> Term t
-  RotateBitsTerm :: (SupportedPrim t, Bits t) => {-# UNPACK #-} !Id -> !(Term t) -> {-# UNPACK #-} !Int -> Term t
-  BVToSignedTerm ::
-    ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-      forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-      Typeable ubv,
-      Typeable sbv,
-      KnownNat n,
-      1 <= n,
-      BVSignConversion (ubv n) (sbv n)
+  ShiftLeftTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymShift t) => {-# UNPACK #-} !Id -> !(Term t) -> !(Term t) -> Term t
+  ShiftRightTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymShift t) => {-# UNPACK #-} !Id -> !(Term t) -> !(Term t) -> Term t
+  RotateLeftTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymRotate t) => {-# UNPACK #-} !Id -> !(Term t) -> !(Term t) -> Term t
+  RotateRightTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymRotate t) => {-# UNPACK #-} !Id -> !(Term t) -> !(Term t) -> Term t
+  ToSignedTerm ::
+    ( SupportedPrim u,
+      SupportedPrim s,
+      SignConversion u s
     ) =>
     {-# UNPACK #-} !Id ->
-    !(Term (ubv n)) ->
-    Term (sbv n)
-  BVToUnsignedTerm ::
-    ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-      forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-      Typeable ubv,
-      Typeable sbv,
-      KnownNat n,
-      1 <= n,
-      BVSignConversion (ubv n) (sbv n)
+    !(Term u) ->
+    Term s
+  ToUnsignedTerm ::
+    ( SupportedPrim u,
+      SupportedPrim s,
+      SignConversion u s
     ) =>
     {-# UNPACK #-} !Id ->
-    !(Term (sbv n)) ->
-    Term (ubv n)
+    !(Term s) ->
+    Term u
   BVConcatTerm ::
     ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n),
       Typeable bv,
@@ -542,10 +541,12 @@
   liftTyped (OrBitsTerm _ arg1 arg2) = [||orBitsTerm arg1 arg2||]
   liftTyped (XorBitsTerm _ arg1 arg2) = [||xorBitsTerm arg1 arg2||]
   liftTyped (ComplementBitsTerm _ arg) = [||complementBitsTerm arg||]
-  liftTyped (ShiftBitsTerm _ arg n) = [||shiftBitsTerm arg n||]
-  liftTyped (RotateBitsTerm _ arg n) = [||rotateBitsTerm arg n||]
-  liftTyped (BVToSignedTerm _ v) = [||bvToSignedTerm v||]
-  liftTyped (BVToUnsignedTerm _ v) = [||bvToUnsignedTerm v||]
+  liftTyped (ShiftLeftTerm _ arg n) = [||shiftLeftTerm arg n||]
+  liftTyped (ShiftRightTerm _ arg n) = [||shiftRightTerm arg n||]
+  liftTyped (RotateLeftTerm _ arg n) = [||rotateLeftTerm arg n||]
+  liftTyped (RotateRightTerm _ arg n) = [||rotateRightTerm arg n||]
+  liftTyped (ToSignedTerm _ v) = [||toSignedTerm v||]
+  liftTyped (ToUnsignedTerm _ v) = [||toUnsignedTerm v||]
   liftTyped (BVConcatTerm _ arg1 arg2) = [||bvconcatTerm arg1 arg2||]
   liftTyped (BVSelectTerm _ (_ :: TypeRep ix) (_ :: TypeRep w) arg) = [||bvselectTerm (Proxy @ix) (Proxy @w) arg||]
   liftTyped (BVExtendTerm _ signed (_ :: TypeRep n) arg) = [||bvextendTerm signed (Proxy @n) arg||]
@@ -618,10 +619,12 @@
   show (OrBitsTerm i arg1 arg2) = "OrBits{id=" ++ show i ++ ", arg1=" ++ show arg1 ++ ", arg2=" ++ show arg2 ++ "}"
   show (XorBitsTerm i arg1 arg2) = "XorBits{id=" ++ show i ++ ", arg1=" ++ show arg1 ++ ", arg2=" ++ show arg2 ++ "}"
   show (ComplementBitsTerm i arg) = "ComplementBits{id=" ++ show i ++ ", arg=" ++ show arg ++ "}"
-  show (ShiftBitsTerm i arg n) = "ShiftBits{id=" ++ show i ++ ", arg=" ++ show arg ++ ", n=" ++ show n ++ "}"
-  show (RotateBitsTerm i arg n) = "RotateBits{id=" ++ show i ++ ", arg=" ++ show arg ++ ", n=" ++ show n ++ "}"
-  show (BVToSignedTerm i arg) = "BVToSigned{id=" ++ show i ++ ", arg=" ++ show arg ++ "}"
-  show (BVToUnsignedTerm i arg) = "BVToUnsigned{id=" ++ show i ++ ", arg=" ++ show arg ++ "}"
+  show (ShiftLeftTerm i arg n) = "ShiftLeft{id=" ++ show i ++ ", arg=" ++ show arg ++ ", n=" ++ show n ++ "}"
+  show (ShiftRightTerm i arg n) = "ShiftRight{id=" ++ show i ++ ", arg=" ++ show arg ++ ", n=" ++ show n ++ "}"
+  show (RotateLeftTerm i arg n) = "RotateLeft{id=" ++ show i ++ ", arg=" ++ show arg ++ ", n=" ++ show n ++ "}"
+  show (RotateRightTerm i arg n) = "RotateRight{id=" ++ show i ++ ", arg=" ++ show arg ++ ", n=" ++ show n ++ "}"
+  show (ToSignedTerm i arg) = "ToSigned{id=" ++ show i ++ ", arg=" ++ show arg ++ "}"
+  show (ToUnsignedTerm i arg) = "ToUnsigned{id=" ++ show i ++ ", arg=" ++ show arg ++ "}"
   show (BVConcatTerm i arg1 arg2) = "BVConcat{id=" ++ show i ++ ", arg1=" ++ show arg1 ++ ", arg2=" ++ show arg2 ++ "}"
   show (BVSelectTerm i ix w arg) =
     "BVSelect{id=" ++ show i ++ ", ix=" ++ show ix ++ ", w=" ++ show w ++ ", arg=" ++ show arg ++ "}"
@@ -702,30 +705,24 @@
   UOrBitsTerm :: (SupportedPrim t, Bits t) => !(Term t) -> !(Term t) -> UTerm t
   UXorBitsTerm :: (SupportedPrim t, Bits t) => !(Term t) -> !(Term t) -> UTerm t
   UComplementBitsTerm :: (SupportedPrim t, Bits t) => !(Term t) -> UTerm t
-  UShiftBitsTerm :: (SupportedPrim t, Bits t) => !(Term t) -> {-# UNPACK #-} !Int -> UTerm t
-  URotateBitsTerm :: (SupportedPrim t, Bits t) => !(Term t) -> {-# UNPACK #-} !Int -> UTerm t
-  UBVToSignedTerm ::
-    ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-      forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-      Typeable ubv,
-      Typeable sbv,
-      KnownNat n,
-      1 <= n,
-      BVSignConversion (ubv n) (sbv n)
+  UShiftLeftTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymShift t) => !(Term t) -> !(Term t) -> UTerm t
+  UShiftRightTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymShift t) => !(Term t) -> !(Term t) -> UTerm t
+  URotateLeftTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymRotate t) => !(Term t) -> !(Term t) -> UTerm t
+  URotateRightTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymRotate t) => !(Term t) -> !(Term t) -> UTerm t
+  UToSignedTerm ::
+    ( SupportedPrim u,
+      SupportedPrim s,
+      SignConversion u s
     ) =>
-    !(Term (ubv n)) ->
-    UTerm (sbv n)
-  UBVToUnsignedTerm ::
-    ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-      forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-      Typeable ubv,
-      Typeable sbv,
-      KnownNat n,
-      1 <= n,
-      BVSignConversion (ubv n) (sbv n)
+    !(Term u) ->
+    UTerm s
+  UToUnsignedTerm ::
+    ( SupportedPrim u,
+      SupportedPrim s,
+      SignConversion u s
     ) =>
-    !(Term (sbv n)) ->
-    UTerm (ubv n)
+    !(Term s) ->
+    UTerm u
   UBVConcatTerm ::
     ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n),
       Typeable bv,
@@ -839,17 +836,17 @@
     DOrBitsTerm :: {-# UNPACK #-} !Id -> {-# UNPACK #-} !Id -> Description (Term t)
     DXorBitsTerm :: {-# UNPACK #-} !Id -> {-# UNPACK #-} !Id -> Description (Term t)
     DComplementBitsTerm :: {-# UNPACK #-} !Id -> Description (Term t)
-    DShiftBitsTerm :: {-# UNPACK #-} !Id -> {-# UNPACK #-} !Int -> Description (Term t)
-    DRotateBitsTerm :: {-# UNPACK #-} !Id -> {-# UNPACK #-} !Int -> Description (Term t)
+    DShiftLeftTerm :: {-# UNPACK #-} !Id -> {-# UNPACK #-} !Id -> Description (Term t)
+    DShiftRightTerm :: {-# UNPACK #-} !Id -> {-# UNPACK #-} !Id -> Description (Term t)
+    DRotateLeftTerm :: {-# UNPACK #-} !Id -> {-# UNPACK #-} !Id -> Description (Term t)
+    DRotateRightTerm :: {-# UNPACK #-} !Id -> {-# UNPACK #-} !Id -> Description (Term t)
     DBVConcatTerm :: TypeRep bv1 -> TypeRep bv2 -> {-# UNPACK #-} !Id -> {-# UNPACK #-} !Id -> Description (Term t)
-    DBVToSignedTerm ::
-      forall ubv sbv (n :: Nat).
-      !(TypeRep (ubv n), Id) ->
-      Description (Term (sbv n))
-    DBVToUnsignedTerm ::
-      forall sbv ubv (n :: Nat).
-      !(TypeRep (sbv n), Id) ->
-      Description (Term (ubv n))
+    DToSignedTerm ::
+      !(TypeRep u, Id) ->
+      Description (Term s)
+    DToUnsignedTerm ::
+      !(TypeRep s, Id) ->
+      Description (Term u)
     DBVSelectTerm ::
       forall bv (n :: Nat) (w :: Nat) (ix :: Nat).
       !(TypeRep ix) ->
@@ -906,10 +903,12 @@
   describe (UOrBitsTerm arg1 arg2) = DOrBitsTerm (identity arg1) (identity arg2)
   describe (UXorBitsTerm arg1 arg2) = DXorBitsTerm (identity arg1) (identity arg2)
   describe (UComplementBitsTerm arg) = DComplementBitsTerm (identity arg)
-  describe (UShiftBitsTerm arg n) = DShiftBitsTerm (identity arg) n
-  describe (URotateBitsTerm arg n) = DRotateBitsTerm (identity arg) n
-  describe (UBVToSignedTerm (arg :: Term bv)) = DBVToSignedTerm (typeRep :: TypeRep bv, identity arg)
-  describe (UBVToUnsignedTerm (arg :: Term bv)) = DBVToSignedTerm (typeRep :: TypeRep bv, identity arg)
+  describe (UShiftLeftTerm arg n) = DShiftLeftTerm (identity arg) (identity n)
+  describe (UShiftRightTerm arg n) = DShiftRightTerm (identity arg) (identity n)
+  describe (URotateLeftTerm arg n) = DRotateLeftTerm (identity arg) (identity n)
+  describe (URotateRightTerm arg n) = DRotateRightTerm (identity arg) (identity n)
+  describe (UToSignedTerm (arg :: Term bv)) = DToSignedTerm (typeRep :: TypeRep bv, identity arg)
+  describe (UToUnsignedTerm (arg :: Term bv)) = DToSignedTerm (typeRep :: TypeRep bv, identity arg)
   describe (UBVConcatTerm (arg1 :: bv1) (arg2 :: bv2)) =
     DBVConcatTerm (typeRep :: TypeRep bv1) (typeRep :: TypeRep bv2) (identity arg1) (identity arg2)
   describe (UBVSelectTerm (ix :: TypeRep ix) _ (arg :: Term arg)) =
@@ -952,10 +951,12 @@
       go (UOrBitsTerm arg1 arg2) = OrBitsTerm i arg1 arg2
       go (UXorBitsTerm arg1 arg2) = XorBitsTerm i arg1 arg2
       go (UComplementBitsTerm arg) = ComplementBitsTerm i arg
-      go (UShiftBitsTerm arg n) = ShiftBitsTerm i arg n
-      go (URotateBitsTerm arg n) = RotateBitsTerm i arg n
-      go (UBVToSignedTerm arg) = BVToSignedTerm i arg
-      go (UBVToUnsignedTerm arg) = BVToUnsignedTerm i arg
+      go (UShiftLeftTerm arg n) = ShiftLeftTerm i arg n
+      go (UShiftRightTerm arg n) = ShiftRightTerm i arg n
+      go (URotateLeftTerm arg n) = RotateLeftTerm i arg n
+      go (URotateRightTerm arg n) = RotateRightTerm i arg n
+      go (UToSignedTerm arg) = ToSignedTerm i arg
+      go (UToUnsignedTerm arg) = ToUnsignedTerm i arg
       go (UBVConcatTerm arg1 arg2) = BVConcatTerm i arg1 arg2
       go (UBVSelectTerm ix w arg) = BVSelectTerm i ix w arg
       go (UBVExtendTerm signed n arg) = BVExtendTerm i signed n arg
@@ -995,10 +996,12 @@
   DOrBitsTerm li1 li2 == DOrBitsTerm ri1 ri2 = li1 == ri1 && li2 == ri2
   DXorBitsTerm li1 li2 == DXorBitsTerm ri1 ri2 = li1 == ri1 && li2 == ri2
   DComplementBitsTerm li == DComplementBitsTerm ri = li == ri
-  DShiftBitsTerm li ln == DShiftBitsTerm ri rn = li == ri && ln == rn
-  DRotateBitsTerm li ln == DRotateBitsTerm ri rn = li == ri && ln == rn
-  DBVToSignedTerm li == DBVToSignedTerm ri = eqTypedId li ri
-  DBVToUnsignedTerm li == DBVToUnsignedTerm ri = eqTypedId li ri
+  DShiftLeftTerm li ln == DShiftLeftTerm ri rn = li == ri && ln == rn
+  DShiftRightTerm li ln == DShiftRightTerm ri rn = li == ri && ln == rn
+  DRotateLeftTerm li ln == DRotateLeftTerm ri rn = li == ri && ln == rn
+  DRotateRightTerm li ln == DRotateRightTerm ri rn = li == ri && ln == rn
+  DToSignedTerm li == DToSignedTerm ri = eqTypedId li ri
+  DToUnsignedTerm li == DToUnsignedTerm ri = eqTypedId li ri
   DBVConcatTerm lrep1 lrep2 li1 li2 == DBVConcatTerm rrep1 rrep2 ri1 ri2 =
     eqTypeRepBool lrep1 rrep1 && eqTypeRepBool lrep2 rrep2 && li1 == ri1 && li2 == ri2
   DBVSelectTerm lix li == DBVSelectTerm rix ri =
@@ -1055,10 +1058,12 @@
   hashWithSalt s (DOrBitsTerm id1 id2) = s `hashWithSalt` (18 :: Int) `hashWithSalt` id1 `hashWithSalt` id2
   hashWithSalt s (DXorBitsTerm id1 id2) = s `hashWithSalt` (19 :: Int) `hashWithSalt` id1 `hashWithSalt` id2
   hashWithSalt s (DComplementBitsTerm id1) = s `hashWithSalt` (20 :: Int) `hashWithSalt` id1
-  hashWithSalt s (DShiftBitsTerm id1 n) = s `hashWithSalt` (21 :: Int) `hashWithSalt` id1 `hashWithSalt` n
-  hashWithSalt s (DRotateBitsTerm id1 n) = s `hashWithSalt` (22 :: Int) `hashWithSalt` id1 `hashWithSalt` n
-  hashWithSalt s (DBVToSignedTerm id) = s `hashWithSalt` (23 :: Int) `hashWithSalt` id
-  hashWithSalt s (DBVToUnsignedTerm id) = s `hashWithSalt` (24 :: Int) `hashWithSalt` id
+  hashWithSalt s (DShiftLeftTerm id1 idn) = s `hashWithSalt` (38 :: Int) `hashWithSalt` id1 `hashWithSalt` idn
+  hashWithSalt s (DShiftRightTerm id1 idn) = s `hashWithSalt` (39 :: Int) `hashWithSalt` id1 `hashWithSalt` idn
+  hashWithSalt s (DRotateLeftTerm id1 idn) = s `hashWithSalt` (40 :: Int) `hashWithSalt` id1 `hashWithSalt` idn
+  hashWithSalt s (DRotateRightTerm id1 idn) = s `hashWithSalt` (41 :: Int) `hashWithSalt` id1 `hashWithSalt` idn
+  hashWithSalt s (DToSignedTerm id) = s `hashWithSalt` (23 :: Int) `hashWithSalt` id
+  hashWithSalt s (DToUnsignedTerm id) = s `hashWithSalt` (24 :: Int) `hashWithSalt` id
   hashWithSalt s (DBVConcatTerm rep1 rep2 id1 id2) =
     s `hashWithSalt` (25 :: Int) `hashWithSalt` rep1 `hashWithSalt` rep2 `hashWithSalt` id1 `hashWithSalt` id2
   hashWithSalt s (DBVSelectTerm ix id1) = s `hashWithSalt` (26 :: Int) `hashWithSalt` ix `hashWithSalt` id1
diff --git a/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/Term.hs-boot b/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/Term.hs-boot
--- a/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/Term.hs-boot
+++ b/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/Term.hs-boot
@@ -29,20 +29,23 @@
 where
 
 import Control.DeepSeq (NFData)
-import Data.Bits (Bits)
+import Data.Bits (Bits, FiniteBits)
 import Data.Hashable (Hashable)
 import Data.Interned (Cache, Id)
 import Data.Kind (Constraint)
+import qualified Data.Text as T
 import GHC.TypeNats (KnownNat, type (+), type (<=))
 import Grisette.Core.Data.Class.BitVector
-  ( BVSignConversion,
-    SizedBV,
+  ( SizedBV,
   )
+import Grisette.Core.Data.Class.SignConversion (SignConversion)
+import Grisette.Core.Data.Class.SymRotate (SymRotate)
+import Grisette.Core.Data.Class.SymShift (SymShift)
 import Grisette.IR.SymPrim.Data.Prim.ModelValue
   ( ModelValue,
     toModelValue,
   )
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.TabularFun
+import Grisette.IR.SymPrim.Data.TabularFun
   ( type (=->),
   )
 import Language.Haskell.TH.Syntax (Lift)
@@ -124,8 +127,8 @@
   pformatTernary :: tag -> Term arg1 -> Term arg2 -> Term arg3 -> String
 
 data TypedSymbol t where
-  SimpleSymbol :: (SupportedPrim t) => String -> TypedSymbol t
-  IndexedSymbol :: (SupportedPrim t) => String -> Int -> TypedSymbol t
+  SimpleSymbol :: (SupportedPrim t) => T.Text -> TypedSymbol t
+  IndexedSymbol :: (SupportedPrim t) => T.Text -> Int -> TypedSymbol t
   WithInfo ::
     forall t a.
     ( SupportedPrim t,
@@ -183,32 +186,26 @@
   OrBitsTerm :: (SupportedPrim t, Bits t) => {-# UNPACK #-} !Id -> !(Term t) -> !(Term t) -> Term t
   XorBitsTerm :: (SupportedPrim t, Bits t) => {-# UNPACK #-} !Id -> !(Term t) -> !(Term t) -> Term t
   ComplementBitsTerm :: (SupportedPrim t, Bits t) => {-# UNPACK #-} !Id -> !(Term t) -> Term t
-  ShiftBitsTerm :: (SupportedPrim t, Bits t) => {-# UNPACK #-} !Id -> !(Term t) -> {-# UNPACK #-} !Int -> Term t
-  RotateBitsTerm :: (SupportedPrim t, Bits t) => {-# UNPACK #-} !Id -> !(Term t) -> {-# UNPACK #-} !Int -> Term t
-  BVToSignedTerm ::
-    ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-      forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-      Typeable ubv,
-      Typeable sbv,
-      KnownNat n,
-      1 <= n,
-      BVSignConversion (ubv n) (sbv n)
+  ShiftLeftTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymShift t) => {-# UNPACK #-} !Id -> !(Term t) -> !(Term t) -> Term t
+  ShiftRightTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymShift t) => {-# UNPACK #-} !Id -> !(Term t) -> !(Term t) -> Term t
+  RotateLeftTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymRotate t) => {-# UNPACK #-} !Id -> !(Term t) -> !(Term t) -> Term t
+  RotateRightTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymRotate t) => {-# UNPACK #-} !Id -> !(Term t) -> !(Term t) -> Term t
+  ToSignedTerm ::
+    ( SupportedPrim u,
+      SupportedPrim s,
+      SignConversion u s
     ) =>
     {-# UNPACK #-} !Id ->
-    !(Term (ubv n)) ->
-    Term (sbv n)
-  BVToUnsignedTerm ::
-    ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-      forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-      Typeable ubv,
-      Typeable sbv,
-      KnownNat n,
-      1 <= n,
-      BVSignConversion (ubv n) (sbv n)
+    !(Term u) ->
+    Term s
+  ToUnsignedTerm ::
+    ( SupportedPrim u,
+      SupportedPrim s,
+      SignConversion u s
     ) =>
     {-# UNPACK #-} !Id ->
-    !(Term (sbv n)) ->
-    Term (ubv n)
+    !(Term s) ->
+    Term u
   BVConcatTerm ::
     ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n),
       Typeable bv,
@@ -313,30 +310,24 @@
   UOrBitsTerm :: (SupportedPrim t, Bits t) => !(Term t) -> !(Term t) -> UTerm t
   UXorBitsTerm :: (SupportedPrim t, Bits t) => !(Term t) -> !(Term t) -> UTerm t
   UComplementBitsTerm :: (SupportedPrim t, Bits t) => !(Term t) -> UTerm t
-  UShiftBitsTerm :: (SupportedPrim t, Bits t) => !(Term t) -> {-# UNPACK #-} !Int -> UTerm t
-  URotateBitsTerm :: (SupportedPrim t, Bits t) => !(Term t) -> {-# UNPACK #-} !Int -> UTerm t
-  UBVToSignedTerm ::
-    ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-      forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-      Typeable ubv,
-      Typeable sbv,
-      KnownNat n,
-      1 <= n,
-      BVSignConversion (ubv n) (sbv n)
+  UShiftLeftTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymShift t) => !(Term t) -> !(Term t) -> UTerm t
+  UShiftRightTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymShift t) => !(Term t) -> !(Term t) -> UTerm t
+  URotateLeftTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymRotate t) => !(Term t) -> !(Term t) -> UTerm t
+  URotateRightTerm :: (SupportedPrim t, Integral t, FiniteBits t, SymRotate t) => !(Term t) -> !(Term t) -> UTerm t
+  UToSignedTerm ::
+    ( SupportedPrim u,
+      SupportedPrim s,
+      SignConversion u s
     ) =>
-    !(Term (ubv n)) ->
-    UTerm (sbv n)
-  UBVToUnsignedTerm ::
-    ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-      forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-      Typeable ubv,
-      Typeable sbv,
-      KnownNat n,
-      1 <= n,
-      BVSignConversion (ubv n) (sbv n)
+    !(Term u) ->
+    UTerm s
+  UToUnsignedTerm ::
+    ( SupportedPrim u,
+      SupportedPrim s,
+      SignConversion u s
     ) =>
-    !(Term (sbv n)) ->
-    UTerm (ubv n)
+    !(Term s) ->
+    UTerm u
   UBVConcatTerm ::
     ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (bv n),
       Typeable bv,
diff --git a/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/TermSubstitution.hs b/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/TermSubstitution.hs
--- a/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/TermSubstitution.hs
+++ b/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/TermSubstitution.hs
@@ -36,8 +36,6 @@
         BVConcatTerm,
         BVExtendTerm,
         BVSelectTerm,
-        BVToSignedTerm,
-        BVToUnsignedTerm,
         BinaryTerm,
         ComplementBitsTerm,
         ConTerm,
@@ -57,13 +55,17 @@
         QuotIntegralTerm,
         RemBoundedIntegralTerm,
         RemIntegralTerm,
-        RotateBitsTerm,
-        ShiftBitsTerm,
+        RotateLeftTerm,
+        RotateRightTerm,
+        ShiftLeftTerm,
+        ShiftRightTerm,
         SignumNumTerm,
         SymTerm,
         TabularFunApplyTerm,
         TernaryTerm,
         TimesNumTerm,
+        ToSignedTerm,
+        ToUnsignedTerm,
         UMinusNumTerm,
         UnaryTerm,
         XorBitsTerm
@@ -78,15 +80,17 @@
   ( pevalBVConcatTerm,
     pevalBVExtendTerm,
     pevalBVSelectTerm,
-    pevalBVToSignedTerm,
-    pevalBVToUnsignedTerm,
+    pevalToSignedTerm,
+    pevalToUnsignedTerm,
   )
 import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bits
   ( pevalAndBitsTerm,
     pevalComplementBitsTerm,
     pevalOrBitsTerm,
-    pevalRotateBitsTerm,
-    pevalShiftBitsTerm,
+    pevalRotateLeftTerm,
+    pevalRotateRightTerm,
+    pevalShiftLeftTerm,
+    pevalShiftRightTerm,
     pevalXorBitsTerm,
   )
 import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bool
@@ -169,10 +173,12 @@
         OrBitsTerm _ op1 op2 -> SomeTerm $ pevalOrBitsTerm (gov op1) (gov op2)
         XorBitsTerm _ op1 op2 -> SomeTerm $ pevalXorBitsTerm (gov op1) (gov op2)
         ComplementBitsTerm _ op -> SomeTerm $ pevalComplementBitsTerm (gov op)
-        ShiftBitsTerm _ op n -> SomeTerm $ pevalShiftBitsTerm (gov op) n
-        RotateBitsTerm _ op n -> SomeTerm $ pevalRotateBitsTerm (gov op) n
-        BVToSignedTerm _ op -> SomeTerm $ pevalBVToSignedTerm op
-        BVToUnsignedTerm _ op -> SomeTerm $ pevalBVToUnsignedTerm op
+        ShiftLeftTerm _ op n -> SomeTerm $ pevalShiftLeftTerm (gov op) (gov n)
+        RotateLeftTerm _ op n -> SomeTerm $ pevalRotateLeftTerm (gov op) (gov n)
+        ShiftRightTerm _ op n -> SomeTerm $ pevalShiftRightTerm (gov op) (gov n)
+        RotateRightTerm _ op n -> SomeTerm $ pevalRotateRightTerm (gov op) (gov n)
+        ToSignedTerm _ op -> SomeTerm $ pevalToSignedTerm op
+        ToUnsignedTerm _ op -> SomeTerm $ pevalToUnsignedTerm op
         BVConcatTerm _ op1 op2 -> SomeTerm $ pevalBVConcatTerm (gov op1) (gov op2)
         BVSelectTerm _ ix w op -> SomeTerm $ pevalBVSelectTerm ix w (gov op)
         BVExtendTerm _ n signed op -> SomeTerm $ pevalBVExtendTerm n signed (gov op)
diff --git a/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/TermUtils.hs b/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/TermUtils.hs
--- a/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/TermUtils.hs
+++ b/src/Grisette/IR/SymPrim/Data/Prim/InternedTerm/TermUtils.hs
@@ -59,8 +59,6 @@
         BVConcatTerm,
         BVExtendTerm,
         BVSelectTerm,
-        BVToSignedTerm,
-        BVToUnsignedTerm,
         BinaryTerm,
         ComplementBitsTerm,
         ConTerm,
@@ -80,13 +78,17 @@
         QuotIntegralTerm,
         RemBoundedIntegralTerm,
         RemIntegralTerm,
-        RotateBitsTerm,
-        ShiftBitsTerm,
+        RotateLeftTerm,
+        RotateRightTerm,
+        ShiftLeftTerm,
+        ShiftRightTerm,
         SignumNumTerm,
         SymTerm,
         TabularFunApplyTerm,
         TernaryTerm,
         TimesNumTerm,
+        ToSignedTerm,
+        ToUnsignedTerm,
         UMinusNumTerm,
         UnaryTerm,
         XorBitsTerm
@@ -123,10 +125,12 @@
 identityWithTypeRep (OrBitsTerm i _ _) = (typeRep (Proxy @t), i)
 identityWithTypeRep (XorBitsTerm i _ _) = (typeRep (Proxy @t), i)
 identityWithTypeRep (ComplementBitsTerm i _) = (typeRep (Proxy @t), i)
-identityWithTypeRep (ShiftBitsTerm i _ _) = (typeRep (Proxy @t), i)
-identityWithTypeRep (RotateBitsTerm i _ _) = (typeRep (Proxy @t), i)
-identityWithTypeRep (BVToSignedTerm i _) = (typeRep (Proxy @t), i)
-identityWithTypeRep (BVToUnsignedTerm i _) = (typeRep (Proxy @t), i)
+identityWithTypeRep (ShiftLeftTerm i _ _) = (typeRep (Proxy @t), i)
+identityWithTypeRep (ShiftRightTerm i _ _) = (typeRep (Proxy @t), i)
+identityWithTypeRep (RotateLeftTerm i _ _) = (typeRep (Proxy @t), i)
+identityWithTypeRep (RotateRightTerm i _ _) = (typeRep (Proxy @t), i)
+identityWithTypeRep (ToSignedTerm i _) = (typeRep (Proxy @t), i)
+identityWithTypeRep (ToUnsignedTerm i _) = (typeRep (Proxy @t), i)
 identityWithTypeRep (BVConcatTerm i _ _) = (typeRep (Proxy @t), i)
 identityWithTypeRep (BVSelectTerm i _ _ _) = (typeRep (Proxy @t), i)
 identityWithTypeRep (BVExtendTerm i _ _ _) = (typeRep (Proxy @t), i)
@@ -164,10 +168,12 @@
 introSupportedPrimConstraint OrBitsTerm {} x = x
 introSupportedPrimConstraint XorBitsTerm {} x = x
 introSupportedPrimConstraint ComplementBitsTerm {} x = x
-introSupportedPrimConstraint ShiftBitsTerm {} x = x
-introSupportedPrimConstraint RotateBitsTerm {} x = x
-introSupportedPrimConstraint BVToSignedTerm {} x = x
-introSupportedPrimConstraint BVToUnsignedTerm {} x = x
+introSupportedPrimConstraint ShiftLeftTerm {} x = x
+introSupportedPrimConstraint RotateLeftTerm {} x = x
+introSupportedPrimConstraint ShiftRightTerm {} x = x
+introSupportedPrimConstraint RotateRightTerm {} x = x
+introSupportedPrimConstraint ToSignedTerm {} x = x
+introSupportedPrimConstraint ToUnsignedTerm {} x = x
 introSupportedPrimConstraint BVConcatTerm {} x = x
 introSupportedPrimConstraint BVSelectTerm {} x = x
 introSupportedPrimConstraint BVExtendTerm {} x = x
@@ -218,10 +224,12 @@
     go (SomeTerm (OrBitsTerm _ arg1 arg2)) = goBinary arg1 arg2
     go (SomeTerm (XorBitsTerm _ arg1 arg2)) = goBinary arg1 arg2
     go (SomeTerm (ComplementBitsTerm _ arg)) = goUnary arg
-    go (SomeTerm (ShiftBitsTerm _ arg _)) = goUnary arg
-    go (SomeTerm (RotateBitsTerm _ arg _)) = goUnary arg
-    go (SomeTerm (BVToSignedTerm _ arg)) = goUnary arg
-    go (SomeTerm (BVToUnsignedTerm _ arg)) = goUnary arg
+    go (SomeTerm (ShiftLeftTerm _ arg n1)) = goBinary arg n1
+    go (SomeTerm (ShiftRightTerm _ arg n1)) = goBinary arg n1
+    go (SomeTerm (RotateLeftTerm _ arg n1)) = goBinary arg n1
+    go (SomeTerm (RotateRightTerm _ arg n1)) = goBinary arg n1
+    go (SomeTerm (ToSignedTerm _ arg)) = goUnary arg
+    go (SomeTerm (ToUnsignedTerm _ arg)) = goUnary arg
     go (SomeTerm (BVConcatTerm _ arg1 arg2)) = goBinary arg1 arg2
     go (SomeTerm (BVSelectTerm _ _ _ arg)) = goUnary arg
     go (SomeTerm (BVExtendTerm _ _ _ arg)) = goUnary arg
@@ -273,10 +281,12 @@
 castTerm t@OrBitsTerm {} = cast t
 castTerm t@XorBitsTerm {} = cast t
 castTerm t@ComplementBitsTerm {} = cast t
-castTerm t@ShiftBitsTerm {} = cast t
-castTerm t@RotateBitsTerm {} = cast t
-castTerm t@BVToSignedTerm {} = cast t
-castTerm t@BVToUnsignedTerm {} = cast t
+castTerm t@ShiftLeftTerm {} = cast t
+castTerm t@ShiftRightTerm {} = cast t
+castTerm t@RotateLeftTerm {} = cast t
+castTerm t@RotateRightTerm {} = cast t
+castTerm t@ToSignedTerm {} = cast t
+castTerm t@ToUnsignedTerm {} = cast t
 castTerm t@BVConcatTerm {} = cast t
 castTerm t@BVSelectTerm {} = cast t
 castTerm t@BVExtendTerm {} = cast t
@@ -314,10 +324,12 @@
 pformat (OrBitsTerm _ arg1 arg2) = "(| " ++ pformat arg1 ++ " " ++ pformat arg2 ++ ")"
 pformat (XorBitsTerm _ arg1 arg2) = "(^ " ++ pformat arg1 ++ " " ++ pformat arg2 ++ ")"
 pformat (ComplementBitsTerm _ arg) = "(~ " ++ pformat arg ++ ")"
-pformat (ShiftBitsTerm _ arg n) = "(shift " ++ pformat arg ++ " " ++ show n ++ ")"
-pformat (RotateBitsTerm _ arg n) = "(rotate " ++ pformat arg ++ " " ++ show n ++ ")"
-pformat (BVToSignedTerm _ arg) = "(bvu2s " ++ pformat arg ++ " " ++ ")"
-pformat (BVToUnsignedTerm _ arg) = "(bvs2u " ++ pformat arg ++ " " ++ ")"
+pformat (ShiftLeftTerm _ arg n) = "(shl " ++ pformat arg ++ " " ++ pformat n ++ ")"
+pformat (ShiftRightTerm _ arg n) = "(shr " ++ pformat arg ++ " " ++ pformat n ++ ")"
+pformat (RotateLeftTerm _ arg n) = "(rotl " ++ pformat arg ++ " " ++ pformat n ++ ")"
+pformat (RotateRightTerm _ arg n) = "(rotr " ++ pformat arg ++ " " ++ pformat n ++ ")"
+pformat (ToSignedTerm _ arg) = "(u2s " ++ pformat arg ++ " " ++ ")"
+pformat (ToUnsignedTerm _ arg) = "(s2u " ++ pformat arg ++ " " ++ ")"
 pformat (BVConcatTerm _ arg1 arg2) = "(bvconcat " ++ pformat arg1 ++ " " ++ pformat arg2 ++ ")"
 pformat (BVSelectTerm _ ix w arg) = "(bvselect " ++ show ix ++ " " ++ show w ++ " " ++ pformat arg ++ ")"
 pformat (BVExtendTerm _ signed n arg) =
@@ -363,10 +375,12 @@
     go t@(OrBitsTerm _ arg1 arg2) = goBinary t arg1 arg2
     go t@(XorBitsTerm _ arg1 arg2) = goBinary t arg1 arg2
     go t@(ComplementBitsTerm _ arg) = goUnary t arg
-    go t@(ShiftBitsTerm _ arg _) = goUnary t arg
-    go t@(RotateBitsTerm _ arg _) = goUnary t arg
-    go t@(BVToSignedTerm _ arg) = goUnary t arg
-    go t@(BVToUnsignedTerm _ arg) = goUnary t arg
+    go t@(ShiftLeftTerm _ arg n) = goBinary t arg n
+    go t@(ShiftRightTerm _ arg n) = goBinary t arg n
+    go t@(RotateLeftTerm _ arg n) = goBinary t arg n
+    go t@(RotateRightTerm _ arg n) = goBinary t arg n
+    go t@(ToSignedTerm _ arg) = goUnary t arg
+    go t@(ToUnsignedTerm _ arg) = goUnary t arg
     go t@(BVConcatTerm _ arg1 arg2) = goBinary t arg1 arg2
     go t@(BVSelectTerm _ _ _ arg) = goUnary t arg
     go t@(BVExtendTerm _ _ _ arg) = goUnary t arg
diff --git a/src/Grisette/IR/SymPrim/Data/Prim/Model.hs b/src/Grisette/IR/SymPrim/Data/Prim/Model.hs
--- a/src/Grisette/IR/SymPrim/Data/Prim/Model.hs
+++ b/src/Grisette/IR/SymPrim/Data/Prim/Model.hs
@@ -34,9 +34,6 @@
 import Data.List (sort, sortOn)
 import Data.Proxy (Proxy (Proxy))
 import GHC.Generics (Generic)
-import Grisette.Core.Data.Class.ExtractSymbolics
-  ( ExtractSymbolics (extractSymbolics),
-  )
 import Grisette.Core.Data.Class.ModelOps
   ( ModelOps
       ( emptyModel,
@@ -81,8 +78,6 @@
         BVConcatTerm,
         BVExtendTerm,
         BVSelectTerm,
-        BVToSignedTerm,
-        BVToUnsignedTerm,
         BinaryTerm,
         ComplementBitsTerm,
         ConTerm,
@@ -102,13 +97,17 @@
         QuotIntegralTerm,
         RemBoundedIntegralTerm,
         RemIntegralTerm,
-        RotateBitsTerm,
-        ShiftBitsTerm,
+        RotateLeftTerm,
+        RotateRightTerm,
+        ShiftLeftTerm,
+        ShiftRightTerm,
         SignumNumTerm,
         SymTerm,
         TabularFunApplyTerm,
         TernaryTerm,
         TimesNumTerm,
+        ToSignedTerm,
+        ToUnsignedTerm,
         UMinusNumTerm,
         UnaryTerm,
         XorBitsTerm
@@ -130,15 +129,17 @@
   ( pevalBVConcatTerm,
     pevalBVExtendTerm,
     pevalBVSelectTerm,
-    pevalBVToSignedTerm,
-    pevalBVToUnsignedTerm,
+    pevalToSignedTerm,
+    pevalToUnsignedTerm,
   )
 import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bits
   ( pevalAndBitsTerm,
     pevalComplementBitsTerm,
     pevalOrBitsTerm,
-    pevalRotateBitsTerm,
-    pevalShiftBitsTerm,
+    pevalRotateLeftTerm,
+    pevalRotateRightTerm,
+    pevalShiftLeftTerm,
+    pevalShiftRightTerm,
     pevalXorBitsTerm,
   )
 import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bool
@@ -368,9 +369,6 @@
       . insertSymbol sym1
       $ emptySet
 
-instance ExtractSymbolics SymbolSet where
-  extractSymbolics = id
-
 instance ModelOps Model SymbolSet TypedSymbol where
   emptyModel = Model M.empty
   isEmptyModel (Model m) = M.null m
@@ -460,14 +458,14 @@
     go (SomeTerm (XorBitsTerm _ arg1 arg2)) =
       goBinary pevalXorBitsTerm arg1 arg2
     go (SomeTerm (ComplementBitsTerm _ arg)) = goUnary pevalComplementBitsTerm arg
-    go (SomeTerm (ShiftBitsTerm _ arg n)) =
-      goUnary (`pevalShiftBitsTerm` n) arg
-    go (SomeTerm (RotateBitsTerm _ arg n)) =
-      goUnary (`pevalRotateBitsTerm` n) arg
-    go (SomeTerm (BVToSignedTerm _ arg)) =
-      goUnary pevalBVToSignedTerm arg
-    go (SomeTerm (BVToUnsignedTerm _ arg)) =
-      goUnary pevalBVToUnsignedTerm arg
+    go (SomeTerm (ShiftLeftTerm _ arg n)) = goBinary pevalShiftLeftTerm arg n
+    go (SomeTerm (RotateLeftTerm _ arg n)) = goBinary pevalRotateLeftTerm arg n
+    go (SomeTerm (ShiftRightTerm _ arg n)) = goBinary pevalShiftRightTerm arg n
+    go (SomeTerm (RotateRightTerm _ arg n)) = goBinary pevalRotateRightTerm arg n
+    go (SomeTerm (ToSignedTerm _ arg)) =
+      goUnary pevalToSignedTerm arg
+    go (SomeTerm (ToUnsignedTerm _ arg)) =
+      goUnary pevalToUnsignedTerm arg
     go (SomeTerm (BVConcatTerm _ arg1 arg2)) =
       goBinary pevalBVConcatTerm arg1 arg2
     go (SomeTerm (BVSelectTerm _ ix w arg)) =
diff --git a/src/Grisette/IR/SymPrim/Data/Prim/Model.hs-boot b/src/Grisette/IR/SymPrim/Data/Prim/Model.hs-boot
deleted file mode 100644
--- a/src/Grisette/IR/SymPrim/Data/Prim/Model.hs-boot
+++ /dev/null
@@ -1,15 +0,0 @@
-module Grisette.IR.SymPrim.Data.Prim.Model
-  ( SymbolSet (..),
-  )
-where
-
-import qualified Data.HashSet as S
-import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
-  ( SomeTypedSymbol,
-  )
-
-newtype SymbolSet = SymbolSet {unSymbolSet :: S.HashSet SomeTypedSymbol}
-
-instance Monoid SymbolSet
-
-instance Semigroup SymbolSet
diff --git a/src/Grisette/IR/SymPrim/Data/Prim/PartialEval/BV.hs b/src/Grisette/IR/SymPrim/Data/Prim/PartialEval/BV.hs
--- a/src/Grisette/IR/SymPrim/Data/Prim/PartialEval/BV.hs
+++ b/src/Grisette/IR/SymPrim/Data/Prim/PartialEval/BV.hs
@@ -19,8 +19,8 @@
 -- Stability   :   Experimental
 -- Portability :   GHC only
 module Grisette.IR.SymPrim.Data.Prim.PartialEval.BV
-  ( pevalBVToSignedTerm,
-    pevalBVToUnsignedTerm,
+  ( pevalToSignedTerm,
+    pevalToUnsignedTerm,
     pevalBVConcatTerm,
     pevalBVSelectTerm,
     pevalBVExtendTerm,
@@ -32,20 +32,20 @@
 import Data.Typeable (Typeable)
 import GHC.TypeNats (KnownNat, type (+), type (<=))
 import Grisette.Core.Data.Class.BitVector
-  ( BVSignConversion (toSigned, toUnsigned),
-    SizedBV (sizedBVConcat, sizedBVSelect, sizedBVSext, sizedBVZext),
+  ( SizedBV (sizedBVConcat, sizedBVSelect, sizedBVSext, sizedBVZext),
   )
+import Grisette.Core.Data.Class.SignConversion (SignConversion (toSigned, toUnsigned))
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.InternedCtors
-  ( bvToSignedTerm,
-    bvToUnsignedTerm,
-    bvconcatTerm,
+  ( bvconcatTerm,
     bvextendTerm,
     bvselectTerm,
     conTerm,
+    toSignedTerm,
+    toUnsignedTerm,
   )
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
   ( SupportedPrim,
-    Term (BVToSignedTerm, BVToUnsignedTerm, ConTerm),
+    Term (ConTerm, ToSignedTerm, ToUnsignedTerm),
   )
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.TermUtils
   ( castTerm,
@@ -56,76 +56,46 @@
   )
 
 -- ToSigned
-pevalBVToSignedTerm ::
-  ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-    forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-    Typeable ubv,
-    Typeable sbv,
-    KnownNat n,
-    1 <= n,
-    BVSignConversion (ubv n) (sbv n)
+pevalToSignedTerm ::
+  ( SupportedPrim u,
+    SupportedPrim s,
+    SignConversion u s
   ) =>
-  Term (ubv n) ->
-  Term (sbv n)
-pevalBVToSignedTerm = unaryUnfoldOnce doPevalBVToSignedTerm bvToSignedTerm
+  Term u ->
+  Term s
+pevalToSignedTerm = unaryUnfoldOnce doPevalToSignedTerm toSignedTerm
 
-doPevalBVToSignedTerm ::
-  ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-    forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-    Typeable ubv,
-    Typeable sbv,
-    KnownNat n,
-    1 <= n,
-    BVSignConversion (ubv n) (sbv n)
+doPevalToSignedTerm ::
+  ( SupportedPrim u,
+    SupportedPrim s,
+    SignConversion u s
   ) =>
-  Term (ubv n) ->
-  Maybe (Term (sbv n))
-doPevalBVToSignedTerm (ConTerm _ b) = Just $ conTerm $ toSigned b
-doPevalBVToSignedTerm (BVToUnsignedTerm _ b) = Just b >>= castTerm
-doPevalBVToSignedTerm _ = Nothing
+  Term u ->
+  Maybe (Term s)
+doPevalToSignedTerm (ConTerm _ b) = Just $ conTerm $ toSigned b
+doPevalToSignedTerm (ToUnsignedTerm _ b) = Just b >>= castTerm
+doPevalToSignedTerm _ = Nothing
 
 -- ToUnsigned
-{-
-bvToUnsignedTerm ::
-  ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-    forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-    Typeable sbv,
-    Typeable ubv,
-    KnownNat n,
-    1 <= n,
-    BVToUnsigned (sbv n) (ubv n)
-  ) =>
-  Term (sbv n) ->
-  Term (ubv n)
-bvToUnsignedTerm = internTerm . UBVToUnsignedTerm
--}
-pevalBVToUnsignedTerm ::
-  ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-    forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-    Typeable ubv,
-    Typeable sbv,
-    KnownNat n,
-    1 <= n,
-    BVSignConversion (ubv n) (sbv n)
+pevalToUnsignedTerm ::
+  ( SupportedPrim u,
+    SupportedPrim s,
+    SignConversion u s
   ) =>
-  Term (sbv n) ->
-  Term (ubv n)
-pevalBVToUnsignedTerm = unaryUnfoldOnce doPevalBVToUnsignedTerm bvToUnsignedTerm
+  Term s ->
+  Term u
+pevalToUnsignedTerm = unaryUnfoldOnce doPevalToUnsignedTerm toUnsignedTerm
 
-doPevalBVToUnsignedTerm ::
-  ( forall n. (KnownNat n, 1 <= n) => SupportedPrim (ubv n),
-    forall n. (KnownNat n, 1 <= n) => SupportedPrim (sbv n),
-    Typeable ubv,
-    Typeable sbv,
-    KnownNat n,
-    1 <= n,
-    BVSignConversion (ubv n) (sbv n)
+doPevalToUnsignedTerm ::
+  ( SupportedPrim u,
+    SupportedPrim s,
+    SignConversion u s
   ) =>
-  Term (sbv n) ->
-  Maybe (Term (ubv n))
-doPevalBVToUnsignedTerm (ConTerm _ b) = Just $ conTerm $ toUnsigned b
-doPevalBVToUnsignedTerm (BVToSignedTerm _ b) = Just b >>= castTerm
-doPevalBVToUnsignedTerm _ = Nothing
+  Term s ->
+  Maybe (Term u)
+doPevalToUnsignedTerm (ConTerm _ b) = Just $ conTerm $ toUnsigned b
+doPevalToUnsignedTerm (ToSignedTerm _ b) = Just b >>= castTerm
+doPevalToUnsignedTerm _ = Nothing
 
 -- select
 pevalBVSelectTerm ::
diff --git a/src/Grisette/IR/SymPrim/Data/Prim/PartialEval/Bits.hs b/src/Grisette/IR/SymPrim/Data/Prim/PartialEval/Bits.hs
--- a/src/Grisette/IR/SymPrim/Data/Prim/PartialEval/Bits.hs
+++ b/src/Grisette/IR/SymPrim/Data/Prim/PartialEval/Bits.hs
@@ -20,36 +20,46 @@
     pevalOrBitsTerm,
     pevalXorBitsTerm,
     pevalComplementBitsTerm,
-    pevalShiftBitsTerm,
-    pevalRotateBitsTerm,
+    pevalShiftLeftTerm,
+    pevalShiftRightTerm,
+    pevalRotateLeftTerm,
+    pevalRotateRightTerm,
   )
 where
 
 import Data.Bits
   ( Bits
-      ( bitSizeMaybe,
-        complement,
-        rotate,
-        shift,
+      ( complement,
+        isSigned,
+        rotateR,
+        shiftR,
         xor,
         zeroBits,
         (.&.),
         (.|.)
       ),
+    FiniteBits (finiteBitSize),
   )
 import Data.Typeable (Typeable, cast)
+import Grisette.Core.Data.Class.SymRotate (SymRotate (symRotate))
+import Grisette.Core.Data.Class.SymShift (SymShift (symShift))
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.InternedCtors
   ( andBitsTerm,
     complementBitsTerm,
     conTerm,
     orBitsTerm,
-    rotateBitsTerm,
-    shiftBitsTerm,
+    rotateLeftTerm,
+    rotateRightTerm,
+    shiftLeftTerm,
+    shiftRightTerm,
     xorBitsTerm,
   )
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
   ( SupportedPrim,
-    Term (ComplementBitsTerm, ConTerm, RotateBitsTerm, ShiftBitsTerm),
+    Term
+      ( ComplementBitsTerm,
+        ConTerm
+      ),
   )
 import Grisette.IR.SymPrim.Data.Prim.PartialEval.Unfold
   ( binaryUnfoldOnce,
@@ -121,37 +131,79 @@
 doPevalComplementBitsTerm _ = Nothing
 
 -- shift
-pevalShiftBitsTerm :: forall a. (Bits a, SupportedPrim a) => Term a -> Int -> Term a
-pevalShiftBitsTerm t n = unaryUnfoldOnce (`doPevalShiftBitsTerm` n) (`shiftBitsTerm` n) t
+pevalShiftLeftTerm :: forall a. (Integral a, SymShift a, FiniteBits a, SupportedPrim a) => Term a -> Term a -> Term a
+pevalShiftLeftTerm t n = unaryUnfoldOnce (`doPevalShiftLeftTerm` n) (`shiftLeftTerm` n) t
 
-doPevalShiftBitsTerm :: forall a. (Bits a, SupportedPrim a) => Term a -> Int -> Maybe (Term a)
-doPevalShiftBitsTerm (ConTerm _ a) n = Just $ conTerm $ shift a n
-doPevalShiftBitsTerm x 0 = Just x
-doPevalShiftBitsTerm _ a
-  | case bitSizeMaybe (zeroBits :: a) of
-      Just b -> a >= b
-      Nothing -> False =
+doPevalShiftLeftTerm :: forall a. (Integral a, SymShift a, FiniteBits a, SupportedPrim a) => Term a -> Term a -> Maybe (Term a)
+doPevalShiftLeftTerm (ConTerm _ a) (ConTerm _ n)
+  | n >= 0 =
+      if (fromIntegral n :: Integer) >= fromIntegral (finiteBitSize n)
+        then Just $ conTerm zeroBits
+        else Just $ conTerm $ symShift a n
+doPevalShiftLeftTerm x (ConTerm _ 0) = Just x
+-- TODO: Need to handle the overflow case.
+-- doPevalShiftLeftTerm (ShiftLeftTerm _ x (ConTerm _ n)) (ConTerm _ n1)
+--   | n >= 0 && n1 >= 0 = Just $ pevalShiftLeftTerm x (conTerm $ n + n1)
+doPevalShiftLeftTerm _ (ConTerm _ n)
+  | n >= 0 && (fromIntegral n :: Integer) >= fromIntegral (finiteBitSize n) =
       Just $ conTerm zeroBits
-doPevalShiftBitsTerm (ShiftBitsTerm _ x n) n1
-  | (n >= 0 && n1 >= 0) || (n <= 0 && n1 <= 0) = Just $ shiftBitsTerm x (n + n1)
-doPevalShiftBitsTerm _ _ = Nothing
+doPevalShiftLeftTerm _ _ = Nothing
 
--- rotate
-pevalRotateBitsTerm :: forall a. (Bits a, SupportedPrim a) => Term a -> Int -> Term a
-pevalRotateBitsTerm t n = unaryUnfoldOnce (`doPevalRotateBitsTerm` n) (`rotateBitsTerm` n) t
+pevalShiftRightTerm :: forall a. (Integral a, SymShift a, FiniteBits a, SupportedPrim a) => Term a -> Term a -> Term a
+pevalShiftRightTerm t n = unaryUnfoldOnce (`doPevalShiftRightTerm` n) (`shiftRightTerm` n) t
 
-doPevalRotateBitsTerm :: forall a. (Bits a, SupportedPrim a) => Term a -> Int -> Maybe (Term a)
-doPevalRotateBitsTerm (ConTerm _ a) n = Just $ conTerm $ rotate a n
-doPevalRotateBitsTerm x 0 = Just x
-doPevalRotateBitsTerm x a
-  | case bsize of
-      Just s -> s /= 0 && (a >= s || a < 0)
-      Nothing -> False = do
-      cbsize <- bsize
-      if a >= cbsize
-        then Just $ pevalRotateBitsTerm x (a - cbsize)
-        else Just $ pevalRotateBitsTerm x (a + cbsize)
+doPevalShiftRightTerm :: forall a. (Integral a, SymShift a, FiniteBits a, SupportedPrim a) => Term a -> Term a -> Maybe (Term a)
+doPevalShiftRightTerm (ConTerm _ a) (ConTerm _ n)
+  | n >= 0 && not (isSigned a) =
+      if (fromIntegral n :: Integer) >= fromIntegral (finiteBitSize n)
+        then Just $ conTerm zeroBits
+        else Just $ conTerm $ shiftR a (fromIntegral n)
+doPevalShiftRightTerm (ConTerm _ a) (ConTerm _ n)
+  | n >= 0 = Just $ conTerm $ symShift a (-n) -- if n >= 0 then -n must be in the range
+doPevalShiftRightTerm x (ConTerm _ 0) = Just x
+-- doPevalShiftRightTerm (ShiftRightTerm _ x (ConTerm _ n)) (ConTerm _ n1)
+--   | n >= 0 && n1 >= 0 = Just $ pevalShiftRightTerm x (conTerm $ n + n1)
+doPevalShiftRightTerm _ (ConTerm _ n)
+  | not (isSigned n)
+      && (fromIntegral n :: Integer) >= fromIntegral (finiteBitSize n) =
+      Just $ conTerm zeroBits
+doPevalShiftRightTerm _ _ = Nothing
+
+pevalRotateLeftTerm :: forall a. (Integral a, SymRotate a, FiniteBits a, SupportedPrim a) => Term a -> Term a -> Term a
+pevalRotateLeftTerm t n = unaryUnfoldOnce (`doPevalRotateLeftTerm` n) (`rotateLeftTerm` n) t
+
+doPevalRotateLeftTerm :: forall a. (Integral a, SymRotate a, FiniteBits a, SupportedPrim a) => Term a -> Term a -> Maybe (Term a)
+doPevalRotateLeftTerm (ConTerm _ a) (ConTerm _ n)
+  | n >= 0 = Just $ conTerm $ symRotate a n -- Just $ conTerm $ rotateL a (fromIntegral n)
+doPevalRotateLeftTerm x (ConTerm _ 0) = Just x
+-- doPevalRotateLeftTerm (RotateLeftTerm _ x (ConTerm _ n)) (ConTerm _ n1)
+--   | n >= 0 && n1 >= 0 = Just $ pevalRotateLeftTerm x (conTerm $ n + n1)
+doPevalRotateLeftTerm x (ConTerm _ n)
+  | n >= 0 && (fromIntegral n :: Integer) >= fromIntegral bs =
+      Just $ pevalRotateLeftTerm x (conTerm $ n `mod` fromIntegral bs)
   where
-    bsize = bitSizeMaybe (zeroBits :: a)
-doPevalRotateBitsTerm (RotateBitsTerm _ x n) n1 = Just $ rotateBitsTerm x (n + n1)
-doPevalRotateBitsTerm _ _ = Nothing
+    bs = finiteBitSize n
+doPevalRotateLeftTerm _ _ = Nothing
+
+pevalRotateRightTerm :: forall a. (Integral a, SymRotate a, FiniteBits a, SupportedPrim a) => Term a -> Term a -> Term a
+pevalRotateRightTerm t n = unaryUnfoldOnce (`doPevalRotateRightTerm` n) (`rotateRightTerm` n) t
+
+doPevalRotateRightTerm :: forall a. (Integral a, SymRotate a, FiniteBits a, SupportedPrim a) => Term a -> Term a -> Maybe (Term a)
+doPevalRotateRightTerm (ConTerm _ a) (ConTerm _ n)
+  | n >= 0 =
+      Just . conTerm $
+        rotateR
+          a
+          ( fromIntegral $
+              (fromIntegral n :: Integer)
+                `mod` fromIntegral (finiteBitSize n)
+          )
+doPevalRotateRightTerm x (ConTerm _ 0) = Just x
+-- doPevalRotateRightTerm (RotateRightTerm _ x (ConTerm _ n)) (ConTerm _ n1)
+--   | n >= 0 && n1 >= 0 = Just $ pevalRotateRightTerm x (conTerm $ n + n1)
+doPevalRotateRightTerm x (ConTerm _ n)
+  | n >= 0 && (fromIntegral n :: Integer) >= fromIntegral bs =
+      Just $ pevalRotateRightTerm x (conTerm $ n `mod` fromIntegral bs)
+  where
+    bs = finiteBitSize n
+doPevalRotateRightTerm _ _ = Nothing
diff --git a/src/Grisette/IR/SymPrim/Data/Prim/PartialEval/Num.hs b/src/Grisette/IR/SymPrim/Data/Prim/PartialEval/Num.hs
--- a/src/Grisette/IR/SymPrim/Data/Prim/PartialEval/Num.hs
+++ b/src/Grisette/IR/SymPrim/Data/Prim/PartialEval/Num.hs
@@ -33,6 +33,7 @@
 where
 
 import Data.Typeable (Typeable, cast, eqT, type (:~:) (Refl))
+import Grisette.Core.Data.BV (WordN)
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.InternedCtors
   ( absNumTerm,
     addNumTerm,
@@ -58,6 +59,7 @@
     unaryUnfoldOnce,
   )
 import Grisette.IR.SymPrim.Data.Prim.Utils (pattern Dyn)
+import qualified Type.Reflection as R
 import Unsafe.Coerce (unsafeCoerce)
 
 numConTermView :: (Num b, Typeable b) => Term a -> Maybe b
@@ -157,7 +159,15 @@
 pevalAbsNumTerm :: (SupportedPrim a, Num a) => Term a -> Term a
 pevalAbsNumTerm = unaryUnfoldOnce doPevalAbsNumTerm absNumTerm
 
+isUnsignedBV :: R.TypeRep a -> Bool
+isUnsignedBV (R.App s _) =
+  case R.eqTypeRep s $ R.typeRep @WordN of
+    Just R.HRefl -> True
+    _ -> False
+isUnsignedBV _ = False
+
 doPevalAbsNumTerm :: forall a. (Num a, SupportedPrim a) => Term a -> Maybe (Term a)
+doPevalAbsNumTerm x | isUnsignedBV (R.typeRep @a) = Just x
 doPevalAbsNumTerm (ConTerm _ a) = Just $ conTerm $ abs a
 doPevalAbsNumTerm (UMinusNumTerm _ v) = Just $ pevalAbsNumTerm v
 doPevalAbsNumTerm t@(AbsNumTerm _ (_ :: Term a)) = Just t
diff --git a/src/Grisette/IR/SymPrim/Data/SymPrim.hs b/src/Grisette/IR/SymPrim/Data/SymPrim.hs
--- a/src/Grisette/IR/SymPrim/Data/SymPrim.hs
+++ b/src/Grisette/IR/SymPrim/Data/SymPrim.hs
@@ -6,15 +6,14 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
@@ -58,7 +57,7 @@
 where
 
 import Control.DeepSeq (NFData (rnf))
-import Control.Monad.Except (ExceptT (ExceptT), MonadError (throwError))
+import Control.Monad.Except (ExceptT (ExceptT))
 import Control.Monad.Identity
   ( Identity (Identity),
     IdentityT (IdentityT),
@@ -124,74 +123,26 @@
     VerificationConditions,
   )
 import Grisette.Core.Data.BV
-  ( IntN (IntN),
-    SomeIntN (SomeIntN),
-    SomeWordN (SomeWordN),
-    WordN (WordN),
+  ( IntN,
+    WordN,
   )
 import Grisette.Core.Data.Class.BitVector
   ( BV (bvConcat, bvExt, bvSelect, bvSext, bvZext),
-    BVSignConversion (toSigned, toUnsigned),
     SizedBV (sizedBVConcat, sizedBVExt, sizedBVSelect, sizedBVSext, sizedBVZext),
   )
-import Grisette.Core.Data.Class.Bool
-  ( LogicalOp (nots, (&&~), (||~)),
-    SEq ((/=~), (==~)),
-  )
-import Grisette.Core.Data.Class.Evaluate (EvaluateSym (evaluateSym))
-import Grisette.Core.Data.Class.ExtractSymbolics
-  ( ExtractSymbolics (extractSymbolics),
-  )
-import Grisette.Core.Data.Class.Function (Function (Arg, Ret, (#)))
-import Grisette.Core.Data.Class.GPretty (GPretty (gpretty))
+import Grisette.Core.Data.Class.Function (Apply (FunType, apply), Function (Arg, Ret, (#)))
 import Grisette.Core.Data.Class.ModelOps
   ( ModelOps (emptyModel, insertValue),
     ModelRep (buildModel),
   )
-import Grisette.Core.Data.Class.SOrd (SOrd (symCompare, (<=~), (<~), (>=~), (>~)))
-import Grisette.Core.Data.Class.SafeArith
-  ( ArithException (DivideByZero, Overflow, Underflow),
-    SafeDivision
-      ( safeDiv,
-        safeDiv',
-        safeDivMod,
-        safeDivMod',
-        safeMod,
-        safeMod',
-        safeQuot,
-        safeQuot',
-        safeQuotRem,
-        safeQuotRem',
-        safeRem,
-        safeRem'
-      ),
-    SafeLinearArith
-      ( safeAdd,
-        safeAdd',
-        safeMinus,
-        safeMinus',
-        safeNeg,
-        safeNeg'
-      ),
-    SymIntegerOp,
-  )
-import Grisette.Core.Data.Class.SimpleMergeable (mrgIf)
+import Grisette.Core.Data.Class.SignConversion (SignConversion (toSigned, toUnsigned))
 import Grisette.Core.Data.Class.Solvable
   ( Solvable (con, conView, iinfosym, isym, sinfosym, ssym),
     pattern Con,
   )
-import Grisette.Core.Data.Class.Substitute (SubstituteSym (substituteSym))
-import Grisette.Core.Data.Class.ToCon (ToCon (toCon))
-import Grisette.Core.Data.Class.ToSym (ToSym (toSym))
-import Grisette.IR.SymPrim.Data.IntBitwidth (intBitwidthQ)
-import Grisette.IR.SymPrim.Data.Prim.InternedTerm.InternedCtors
-  ( conTerm,
-    iinfosymTerm,
-    isymTerm,
-    sinfosymTerm,
-    ssymTerm,
-    symTerm,
-  )
+import Grisette.Core.Data.Class.SymRotate (SymRotate (symRotate))
+import Grisette.Core.Data.Class.SymShift (SymShift (symShift))
+import Grisette.IR.SymPrim.Data.Prim.InternedTerm.InternedCtors (conTerm, iinfosymTerm, isymTerm, sinfosymTerm, ssymTerm, symTerm)
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.SomeTerm
   ( SomeTerm (SomeTerm),
   )
@@ -202,62 +153,51 @@
     SymRep (SymType),
     Term (ConTerm, SymTerm),
     TypedSymbol (WithInfo),
-    prettyPrintTerm,
     type (-->) (GeneralFun),
   )
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.TermSubstitution
   ( substTerm,
   )
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.TermUtils
-  ( extractSymbolicsTerm,
-    pformat,
+  ( pformat,
     someTermsSize,
     termSize,
     termsSize,
   )
 import Grisette.IR.SymPrim.Data.Prim.Model
   ( Model,
-    SymbolSet (SymbolSet),
-    evaluateTerm,
   )
 import Grisette.IR.SymPrim.Data.Prim.PartialEval.BV
   ( pevalBVConcatTerm,
     pevalBVExtendTerm,
     pevalBVSelectTerm,
-    pevalBVToSignedTerm,
-    pevalBVToUnsignedTerm,
+    pevalToSignedTerm,
+    pevalToUnsignedTerm,
   )
 import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bits
   ( pevalAndBitsTerm,
     pevalComplementBitsTerm,
     pevalOrBitsTerm,
-    pevalRotateBitsTerm,
-    pevalShiftBitsTerm,
+    pevalRotateLeftTerm,
+    pevalRotateRightTerm,
+    pevalShiftLeftTerm,
+    pevalShiftRightTerm,
     pevalXorBitsTerm,
   )
 import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bool
   ( pevalEqvTerm,
+    pevalITETerm,
+    pevalOrTerm,
   )
 import Grisette.IR.SymPrim.Data.Prim.PartialEval.GeneralFun
   ( pevalGeneralFunApplyTerm,
   )
-import Grisette.IR.SymPrim.Data.Prim.PartialEval.Integral
-  ( pevalDivBoundedIntegralTerm,
-    pevalDivIntegralTerm,
-    pevalModBoundedIntegralTerm,
-    pevalModIntegralTerm,
-    pevalQuotBoundedIntegralTerm,
-    pevalQuotIntegralTerm,
-    pevalRemBoundedIntegralTerm,
-    pevalRemIntegralTerm,
-  )
+import Grisette.IR.SymPrim.Data.Prim.PartialEval.Integral (pevalModBoundedIntegralTerm)
 import Grisette.IR.SymPrim.Data.Prim.PartialEval.Num
   ( pevalAbsNumTerm,
     pevalAddNumTerm,
     pevalGeNumTerm,
-    pevalGtNumTerm,
     pevalLeNumTerm,
-    pevalLtNumTerm,
     pevalMinusNumTerm,
     pevalSignumNumTerm,
     pevalTimesNumTerm,
@@ -267,7 +207,6 @@
   ( pevalTabularFunApplyTerm,
   )
 import Grisette.IR.SymPrim.Data.TabularFun (type (=->))
-import Grisette.Lib.Control.Monad (mrgReturn)
 import Grisette.Utils.Parameterized
   ( KnownProof (KnownProof),
     LeqProof (LeqProof),
@@ -290,7 +229,7 @@
 -- >>> :set -XOverloadedStrings
 -- >>> "a" :: SymBool
 -- a
--- >>> "a" &&~ "b" :: SymBool
+-- >>> "a" .&& "b" :: SymBool
 -- (&& a b)
 --
 -- More symbolic operations are available. Please refer to the documentation
@@ -312,50 +251,6 @@
 #define QID(a) a
 #define QRIGHT(a) QID(a)'
 
-#define SAFE_DIVISION_FUNC(name, type, op) \
-name (type l) rs@(type r) = \
-  mrgIf \
-    (rs ==~ con 0) \
-    (throwError DivideByZero) \
-    (mrgReturn $ type $ op l r); \
-QRIGHT(name) t (type l) rs@(type r) = \
-  mrgIf \
-    (rs ==~ con 0) \
-    (throwError (t DivideByZero)) \
-    (mrgReturn $ type $ op l r)
-
-#define SAFE_DIVISION_FUNC2(name, type, op1, op2) \
-name (type l) rs@(type r) = \
-  mrgIf \
-    (rs ==~ con 0) \
-    (throwError DivideByZero) \
-    (mrgReturn (type $ op1 l r, type $ op2 l r)); \
-QRIGHT(name) t (type l) rs@(type r) = \
-  mrgIf \
-    (rs ==~ con 0) \
-    (throwError (t DivideByZero)) \
-    (mrgReturn (type $ op1 l r, type $ op2 l r))
-
-#if 1
-instance SafeDivision ArithException SymInteger where
-  SAFE_DIVISION_FUNC(safeDiv, SymInteger, pevalDivIntegralTerm)
-  SAFE_DIVISION_FUNC(safeMod, SymInteger, pevalModIntegralTerm)
-  SAFE_DIVISION_FUNC(safeQuot, SymInteger, pevalQuotIntegralTerm)
-  SAFE_DIVISION_FUNC(safeRem, SymInteger, pevalRemIntegralTerm)
-  SAFE_DIVISION_FUNC2(safeDivMod, SymInteger, pevalDivIntegralTerm, pevalModIntegralTerm)
-  SAFE_DIVISION_FUNC2(safeQuotRem, SymInteger, pevalQuotIntegralTerm, pevalRemIntegralTerm)
-#endif
-
-instance SafeLinearArith ArithException SymInteger where
-  safeAdd ls rs = mrgReturn $ ls + rs
-  safeAdd' _ ls rs = mrgReturn $ ls + rs
-  safeNeg v = mrgReturn $ -v
-  safeNeg' _ v = mrgReturn $ -v
-  safeMinus ls rs = mrgReturn $ ls - rs
-  safeMinus' _ ls rs = mrgReturn $ ls - rs
-
-instance SymIntegerOp SymInteger
-
 -- | Symbolic signed bit vector type. Indexed with the bit width.
 -- Signedness affects the semantics of the operations, including
 -- comparison/extension, etc.
@@ -367,7 +262,7 @@
 -- 0b101110
 -- >>> sizedBVExt (Proxy @6) (con 0b101 :: SymIntN 3)
 -- 0b111101
--- >>> (8 :: SymIntN 4) <~ (7 :: SymIntN 4)
+-- >>> (8 :: SymIntN 4) .< (7 :: SymIntN 4)
 -- true
 --
 -- More symbolic operations are available. Please refer to the documentation
@@ -375,96 +270,6 @@
 newtype SymIntN (n :: Nat) = SymIntN {underlyingIntNTerm :: Term (IntN n)}
   deriving (Lift, NFData, Generic)
 
-#define SAFE_DIVISION_FUNC_BOUNDED_SIGNED(name, type, op) \
-name ls@(type l) rs@(type r) = \
-  mrgIf \
-    (rs ==~ con 0) \
-    (throwError DivideByZero) \
-    (mrgIf (rs ==~ con (-1) &&~ ls ==~ con minBound) \
-      (throwError Overflow) \
-      (mrgReturn $ type $ op l r)); \
-QRIGHT(name) t ls@(type l) rs@(type r) = \
-  mrgIf \
-    (rs ==~ con 0) \
-    (throwError (t DivideByZero)) \
-    (mrgIf (rs ==~ con (-1) &&~ ls ==~ con minBound) \
-      (throwError (t Overflow)) \
-      (mrgReturn $ type $ op l r))
-
-#define SAFE_DIVISION_FUNC2_BOUNDED_SIGNED(name, type, op1, op2) \
-name ls@(type l) rs@(type r) = \
-  mrgIf \
-    (rs ==~ con 0) \
-    (throwError DivideByZero) \
-    (mrgIf (rs ==~ con (-1) &&~ ls ==~ con minBound) \
-      (throwError Overflow) \
-      (mrgReturn (type $ op1 l r, type $ op2 l r))); \
-QRIGHT(name) t ls@(type l) rs@(type r) = \
-  mrgIf \
-    (rs ==~ con 0) \
-    (throwError (t DivideByZero)) \
-    (mrgIf (rs ==~ con (-1) &&~ ls ==~ con minBound) \
-      (throwError (t Overflow)) \
-      (mrgReturn (type $ op1 l r, type $ op2 l r)))
-
-#if 1
-instance (KnownNat n, 1 <= n) => SafeDivision ArithException (SymIntN n) where
-  SAFE_DIVISION_FUNC_BOUNDED_SIGNED(safeDiv, SymIntN, pevalDivBoundedIntegralTerm)
-  SAFE_DIVISION_FUNC(safeMod, SymIntN, pevalModBoundedIntegralTerm)
-  SAFE_DIVISION_FUNC_BOUNDED_SIGNED(safeQuot, SymIntN, pevalQuotBoundedIntegralTerm)
-  SAFE_DIVISION_FUNC(safeRem, SymIntN, pevalRemBoundedIntegralTerm)
-  SAFE_DIVISION_FUNC2_BOUNDED_SIGNED(safeDivMod, SymIntN, pevalDivBoundedIntegralTerm, pevalModBoundedIntegralTerm)
-  SAFE_DIVISION_FUNC2_BOUNDED_SIGNED(safeQuotRem, SymIntN, pevalQuotBoundedIntegralTerm, pevalRemBoundedIntegralTerm)
-#endif
-
-instance (KnownNat n, 1 <= n) => SafeLinearArith ArithException (SymIntN n) where
-  safeAdd ls rs =
-    mrgIf
-      (ls >~ 0)
-      (mrgIf (rs >~ 0 &&~ res <~ 0) (throwError Overflow) (return res))
-      ( mrgIf
-          (ls <~ 0 &&~ rs <~ 0 &&~ res >=~ 0)
-          (throwError Underflow)
-          (mrgReturn res)
-      )
-    where
-      res = ls + rs
-  safeAdd' f ls rs =
-    mrgIf
-      (ls >~ 0)
-      (mrgIf (rs >~ 0 &&~ res <~ 0) (throwError $ f Overflow) (return res))
-      ( mrgIf
-          (ls <~ 0 &&~ rs <~ 0 &&~ res >=~ 0)
-          (throwError $ f Underflow)
-          (mrgReturn res)
-      )
-    where
-      res = ls + rs
-  safeNeg v = mrgIf (v ==~ con minBound) (throwError Overflow) (mrgReturn $ -v)
-  safeNeg' f v = mrgIf (v ==~ con minBound) (throwError $ f Overflow) (mrgReturn $ -v)
-  safeMinus ls rs =
-    mrgIf
-      (ls >=~ 0)
-      (mrgIf (rs <~ 0 &&~ res <~ 0) (throwError Overflow) (return res))
-      ( mrgIf
-          (ls <~ 0 &&~ rs >~ 0 &&~ res >~ 0)
-          (throwError Underflow)
-          (mrgReturn res)
-      )
-    where
-      res = ls - rs
-  safeMinus' f ls rs =
-    mrgIf
-      (ls >=~ 0)
-      (mrgIf (rs <~ 0 &&~ res <~ 0) (throwError $ f Overflow) (return res))
-      ( mrgIf
-          (ls <~ 0 &&~ rs >~ 0 &&~ res >~ 0)
-          (throwError $ f Underflow)
-          (mrgReturn res)
-      )
-    where
-      res = ls - rs
-
 -- | Symbolic signed bit vector type. Not indexed, but the bit width is
 -- fixed at the creation time.
 --
@@ -527,7 +332,7 @@
 -- 0b101110
 -- >>> sizedBVExt (Proxy @6) (con 0b101 :: SymWordN 3)
 -- 0b000101
--- >>> (8 :: SymWordN 4) <~ (7 :: SymWordN 4)
+-- >>> (8 :: SymWordN 4) .< (7 :: SymWordN 4)
 -- false
 --
 -- More symbolic operations are available. Please refer to the documentation
@@ -535,48 +340,6 @@
 newtype SymWordN (n :: Nat) = SymWordN {underlyingWordNTerm :: Term (WordN n)}
   deriving (Lift, NFData, Generic)
 
-#if 1
-instance (KnownNat n, 1 <= n) => SafeDivision ArithException (SymWordN n) where
-  SAFE_DIVISION_FUNC(safeDiv, SymWordN, pevalDivIntegralTerm)
-  SAFE_DIVISION_FUNC(safeMod, SymWordN, pevalModIntegralTerm)
-  SAFE_DIVISION_FUNC(safeQuot, SymWordN, pevalQuotIntegralTerm)
-  SAFE_DIVISION_FUNC(safeRem, SymWordN, pevalRemIntegralTerm)
-  SAFE_DIVISION_FUNC2(safeDivMod, SymWordN, pevalDivIntegralTerm, pevalModIntegralTerm)
-  SAFE_DIVISION_FUNC2(safeQuotRem, SymWordN, pevalQuotIntegralTerm, pevalRemIntegralTerm)
-#endif
-
-instance (KnownNat n, 1 <= n) => SafeLinearArith ArithException (SymWordN n) where
-  safeAdd ls rs =
-    mrgIf
-      (ls >~ res ||~ rs >~ res)
-      (throwError Overflow)
-      (mrgReturn res)
-    where
-      res = ls + rs
-  safeAdd' f ls rs =
-    mrgIf
-      (ls >~ res ||~ rs >~ res)
-      (throwError $ f Overflow)
-      (mrgReturn res)
-    where
-      res = ls + rs
-  safeNeg v = mrgIf (v /=~ 0) (throwError Underflow) (mrgReturn v)
-  safeNeg' f v = mrgIf (v /=~ 0) (throwError $ f Underflow) (mrgReturn v)
-  safeMinus ls rs =
-    mrgIf
-      (rs >~ ls)
-      (throwError Underflow)
-      (mrgReturn res)
-    where
-      res = ls - rs
-  safeMinus' f ls rs =
-    mrgIf
-      (rs >~ ls)
-      (throwError $ f Underflow)
-      (mrgReturn res)
-    where
-      res = ls - rs
-
 -- | Symbolic unsigned bit vector type. Not indexed, but the bit width is
 -- fixed at the creation time.
 --
@@ -706,6 +469,10 @@
   type Ret (sa =~> sb) = sb
   (SymTabularFun f) # t = wrapTerm $ pevalTabularFunApplyTerm f (underlyingTerm t)
 
+instance (LinkedRep ca sa, LinkedRep ct st, Apply st) => Apply (sa =~> st) where
+  type FunType (sa =~> st) = sa -> FunType st
+  apply uf a = apply (uf # a)
+
 -- |
 -- Symbolic general function type.
 --
@@ -747,6 +514,10 @@
   type Ret (sa -~> sb) = sb
   (SymGeneralFun f) # t = wrapTerm $ pevalGeneralFunApplyTerm f (underlyingTerm t)
 
+instance (LinkedRep ca sa, LinkedRep ct st, Apply st) => Apply (sa -~> st) where
+  type FunType (sa -~> st) = sa -> FunType st
+  apply uf a = apply (uf # a)
+
 -- | Construction of general symbolic functions.
 --
 -- >>> f = "a" --> "a" + 1 :: Integer --> Integer
@@ -774,34 +545,63 @@
 
 -- Aggregate instances
 
--- Prettyprint
-#define GPRETTY_SYM_SIMPLE(symtype) \
-instance GPretty symtype where \
-  gpretty (symtype t) = prettyPrintTerm t
+instance Apply SymBool where
+  type FunType SymBool = SymBool
+  apply = id
 
-#define GPRETTY_SYM_BV(symtype) \
-instance (KnownNat n, 1 <= n) => GPretty (symtype n) where \
-  gpretty (symtype t) = prettyPrintTerm t
+instance Apply SymInteger where
+  type FunType SymInteger = SymInteger
+  apply = id
 
-#define GPRETTY_SYM_FUN(op, cons) \
-instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb)\
-  => GPretty (sa op sb) where \
-  gpretty (cons t) = prettyPrintTerm t
+instance (KnownNat n, 1 <= n) => Apply (SymIntN n) where
+  type FunType (SymIntN n) = SymIntN n
+  apply = id
 
-#define GPRETTY_SYM_SOME_BV(symtype) \
-instance GPretty symtype where \
-  gpretty (symtype t) = gpretty t
+instance (KnownNat n, 1 <= n) => Apply (SymWordN n) where
+  type FunType (SymWordN n) = SymWordN n
+  apply = id
 
+#define SOLVABLE_SIMPLE(contype, symtype) \
+instance Solvable contype symtype where \
+  con = symtype . conTerm; \
+  ssym = symtype . ssymTerm; \
+  isym str i = symtype $ isymTerm str i; \
+  sinfosym str info = symtype $ sinfosymTerm str info; \
+  iinfosym str i info = symtype $ iinfosymTerm str i info; \
+  conView (symtype (ConTerm _ t)) = Just t; \
+  conView _ = Nothing
+
+#define SOLVABLE_BV(contype, symtype) \
+instance (KnownNat n, 1 <= n) => Solvable (contype n) (symtype n) where \
+  con = symtype . conTerm; \
+  ssym = symtype . ssymTerm; \
+  isym str i = symtype $ isymTerm str i; \
+  sinfosym str info = symtype $ sinfosymTerm str info; \
+  iinfosym str i info = symtype $ iinfosymTerm str i info; \
+  conView (symtype (ConTerm _ t)) = Just t; \
+  conView _ = Nothing
+
+#define SOLVABLE_FUN(symop, conop, symcons) \
+instance \
+  (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => \
+  Solvable (conop ca cb) (symop sa sb) where \
+  con = symcons . conTerm; \
+  ssym = symcons . ssymTerm; \
+  isym str i = symcons $ isymTerm str i; \
+  sinfosym str info = symcons $ sinfosymTerm str info; \
+  iinfosym str i info = symcons $ iinfosymTerm str i info; \
+  conView (symcons (ConTerm _ t)) = Just t; \
+  conView _ = Nothing
+
 #if 1
-GPRETTY_SYM_SIMPLE(SymBool)
-GPRETTY_SYM_SIMPLE(SymInteger)
-GPRETTY_SYM_BV(SymIntN)
-GPRETTY_SYM_BV(SymWordN)
-GPRETTY_SYM_FUN(=~>, SymTabularFun)
-GPRETTY_SYM_FUN(-~>, SymGeneralFun)
-GPRETTY_SYM_SOME_BV(SomeSymIntN)
-GPRETTY_SYM_SOME_BV(SomeSymWordN)
+SOLVABLE_SIMPLE(Bool, SymBool)
+SOLVABLE_SIMPLE(Integer, SymInteger)
+SOLVABLE_BV(IntN, SymIntN)
+SOLVABLE_BV(WordN, SymWordN)
+SOLVABLE_FUN((=~>), (=->), SymTabularFun)
+SOLVABLE_FUN((-~>), (-->), SymGeneralFun)
 #endif
+
 -- Num
 
 #define NUM_BV(symtype) \
@@ -859,9 +659,13 @@
   {-# INLINE xor #-}; \
   complement (symtype n) = symtype $ pevalComplementBitsTerm n; \
   {-# INLINE complement #-}; \
-  shift (symtype n) i = symtype $ pevalShiftBitsTerm n i; \
+  shift (symtype n) i | i > 0 = symtype $ pevalShiftLeftTerm n (conTerm $ fromIntegral i); \
+  shift (symtype n) i | i < 0 = symtype $ pevalShiftRightTerm n (conTerm $ fromIntegral (-i)); \
+  shift (symtype n) _ = symtype n; \
   {-# INLINE shift #-}; \
-  rotate (symtype n) i = symtype $ pevalRotateBitsTerm n i; \
+  rotate (symtype n) i | i > 0 = symtype $ pevalRotateLeftTerm n (conTerm $ fromIntegral i); \
+  rotate (symtype n) i | i < 0 = symtype $ pevalRotateRightTerm n (conTerm $ fromIntegral (-i)); \
+  rotate (symtype n) _ = symtype n; \
   {-# INLINE rotate #-}; \
   bitSize = finiteBitSize; \
   {-# INLINE bitSize #-}; \
@@ -1045,15 +849,15 @@
 
 #define IS_STRING_SIMPLE(symtype) \
 instance IsString symtype where \
-  fromString = ssym
+  fromString = ssym . fromString
 
 #define IS_STRING_BV(symtype) \
 instance (KnownNat n, 1 <= n) => IsString (symtype n) where \
-  fromString = ssym
+  fromString = ssym . fromString
 
 #define IS_STRING_FUN(op, cons) \
 instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => IsString (sa op sb) where \
-  fromString = ssym
+  fromString = ssym . fromString
 
 #if 1
 IS_STRING_SIMPLE(SymBool)
@@ -1064,381 +868,6 @@
 IS_STRING_FUN(-~>, SymGeneralFun)
 #endif
 
--- Solvable
-
-#define SOLVABLE_SIMPLE(contype, symtype) \
-instance Solvable contype symtype where \
-  con = symtype . conTerm; \
-  ssym = symtype . ssymTerm; \
-  isym str i = symtype $ isymTerm str i; \
-  sinfosym str info = symtype $ sinfosymTerm str info; \
-  iinfosym str i info = symtype $ iinfosymTerm str i info; \
-  conView (symtype (ConTerm _ t)) = Just t; \
-  conView _ = Nothing
-
-#define SOLVABLE_BV(contype, symtype) \
-instance (KnownNat n, 1 <= n) => Solvable (contype n) (symtype n) where \
-  con = symtype . conTerm; \
-  ssym = symtype . ssymTerm; \
-  isym str i = symtype $ isymTerm str i; \
-  sinfosym str info = symtype $ sinfosymTerm str info; \
-  iinfosym str i info = symtype $ iinfosymTerm str i info; \
-  conView (symtype (ConTerm _ t)) = Just t; \
-  conView _ = Nothing
-
-#define SOLVABLE_FUN(symop, conop, symcons) \
-instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => Solvable (conop ca cb) (symop sa sb) where \
-  con = symcons . conTerm; \
-  ssym = symcons . ssymTerm; \
-  isym str i = symcons $ isymTerm str i; \
-  sinfosym str info = symcons $ sinfosymTerm str info; \
-  iinfosym str i info = symcons $ iinfosymTerm str i info; \
-  conView (symcons (ConTerm _ t)) = Just t; \
-  conView _ = Nothing
-
-#if 1
-SOLVABLE_SIMPLE(Bool, SymBool)
-SOLVABLE_SIMPLE(Integer, SymInteger)
-SOLVABLE_BV(IntN, SymIntN)
-SOLVABLE_BV(WordN, SymWordN)
-SOLVABLE_FUN((=~>), (=->), SymTabularFun)
-SOLVABLE_FUN((-~>), (-->), SymGeneralFun)
-#endif
-
--- ToSym and ToCon
-
-#define TO_SYM_SYMID_SIMPLE(symtype) \
-instance ToSym symtype symtype where \
-  toSym = id
-
-#define TO_SYM_SYMID_BV(symtype) \
-instance (KnownNat n, 1 <= n) => ToSym (symtype n) (symtype n) where \
-  toSym = id
-
-#define TO_SYM_SYMID_FUN(op) \
-instance (SupportedPrim a, SupportedPrim b) => ToSym (a op b) (a op b) where \
-  toSym = id
-
-#if 1
-TO_SYM_SYMID_SIMPLE(SymBool)
-TO_SYM_SYMID_SIMPLE(SymInteger)
-TO_SYM_SYMID_BV(SymIntN)
-TO_SYM_SYMID_BV(SymWordN)
-TO_SYM_SYMID_FUN(=~>)
-TO_SYM_SYMID_FUN(-~>)
-TO_SYM_SYMID_SIMPLE(SomeSymIntN)
-TO_SYM_SYMID_SIMPLE(SomeSymWordN)
-#endif
-
-#define TO_SYM_FROMCON_SIMPLE(contype, symtype) \
-instance ToSym contype symtype where \
-  toSym = con
-
-#define TO_SYM_FROMCON_BV(contype, symtype) \
-instance (KnownNat n, 1 <= n) => ToSym (contype n) (symtype n) where \
-  toSym = con
-
-#define TO_SYM_FROMCON_FUN(conop, symop) \
-instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => ToSym (conop ca cb) (symop sa sb) where \
-  toSym = con
-
-#define TO_SYM_FROMCON_BV_SOME(contype, symtype) \
-instance ToSym contype symtype where \
-  toSym (contype v) = symtype (con v)
-
-#if 1
-TO_SYM_FROMCON_SIMPLE(Bool, SymBool)
-TO_SYM_FROMCON_SIMPLE(Integer, SymInteger)
-TO_SYM_FROMCON_BV(IntN, SymIntN)
-TO_SYM_FROMCON_BV(WordN, SymWordN)
-TO_SYM_FROMCON_FUN((=->), (=~>))
-TO_SYM_FROMCON_FUN((-->), (-~>))
-TO_SYM_FROMCON_BV_SOME(SomeIntN, SomeSymIntN)
-TO_SYM_FROMCON_BV_SOME(SomeWordN, SomeSymWordN)
-#endif
-
-#define TO_CON_SYMID_SIMPLE(symtype) \
-instance ToCon symtype symtype where \
-  toCon = Just
-
-#define TO_CON_SYMID_BV(symtype) \
-instance (KnownNat n, 1 <= n) => ToCon (symtype n) (symtype n) where \
-  toCon = Just
-
-#define TO_CON_SYMID_FUN(op) \
-instance (SupportedPrim a, SupportedPrim b) => ToCon (a op b) (a op b) where \
-  toCon = Just
-
-#if 1
-TO_CON_SYMID_SIMPLE(SymBool)
-TO_CON_SYMID_SIMPLE(SymInteger)
-TO_CON_SYMID_BV(SymIntN)
-TO_CON_SYMID_BV(SymWordN)
-TO_CON_SYMID_FUN(=~>)
-TO_CON_SYMID_FUN(-~>)
-TO_CON_SYMID_SIMPLE(SomeSymIntN)
-TO_CON_SYMID_SIMPLE(SomeSymWordN)
-#endif
-
-#define TO_CON_FROMSYM_SIMPLE(contype, symtype) \
-instance ToCon symtype contype where \
-  toCon = conView
-
-#define TO_CON_FROMSYM_BV(contype, symtype) \
-instance (KnownNat n, 1 <= n) => ToCon (symtype n) (contype n) where \
-  toCon = conView
-
-#define TO_CON_FROMSYM_FUN(conop, symop) \
-instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => ToCon (symop sa sb) (conop ca cb) where \
-  toCon = conView
-
-#define TO_CON_FROMSYM_BV_SOME(contype, symtype) \
-instance ToCon symtype contype where \
-  toCon (symtype v) = contype <$> conView v
-
-#if 1
-TO_CON_FROMSYM_SIMPLE(Bool, SymBool)
-TO_CON_FROMSYM_SIMPLE(Integer, SymInteger)
-TO_CON_FROMSYM_BV(IntN, SymIntN)
-TO_CON_FROMSYM_BV(WordN, SymWordN)
-TO_CON_FROMSYM_FUN((=->), (=~>))
-TO_CON_FROMSYM_FUN((-->), (-~>))
-TO_CON_FROMSYM_BV_SOME(SomeIntN, SomeSymIntN)
-TO_CON_FROMSYM_BV_SOME(SomeWordN, SomeSymWordN)
-#endif
-
-#define TO_SYM_FROMBV_SOME(somesymbv, bv) \
-instance (KnownNat n, 1 <= n) => ToSym (bv n) somesymbv where \
-  toSym = somesymbv . con
-
-#if 1
-TO_SYM_FROMBV_SOME(SomeSymIntN, IntN)
-TO_SYM_FROMBV_SOME(SomeSymWordN, WordN)
-#endif
-
-#define TOSYM_MACHINE_INTEGER(int, bv) \
-instance ToSym int (bv) where \
-  toSym = fromIntegral
-
-#define TOSYM_MACHINE_INTEGER_SOME(int, somesymbv, bv, bitwidth) \
-instance ToSym int somesymbv where \
-  toSym v = somesymbv (con (fromIntegral v :: bv bitwidth))
-
-#define TOCON_MACHINE_INTEGER(sbvw, bvw, n, int) \
-instance ToCon (sbvw n) int where \
-  toCon (Con (bvw v :: bvw n)) = Just $ fromIntegral v; \
-  toCon _ = Nothing
-
-#if 1
-TOSYM_MACHINE_INTEGER(Int8, SymIntN 8)
-TOSYM_MACHINE_INTEGER(Int16, SymIntN 16)
-TOSYM_MACHINE_INTEGER(Int32, SymIntN 32)
-TOSYM_MACHINE_INTEGER(Int64, SymIntN 64)
-TOSYM_MACHINE_INTEGER(Word8, SymWordN 8)
-TOSYM_MACHINE_INTEGER(Word16, SymWordN 16)
-TOSYM_MACHINE_INTEGER(Word32, SymWordN 32)
-TOSYM_MACHINE_INTEGER(Word64, SymWordN 64)
-TOSYM_MACHINE_INTEGER(Int, SymIntN $intBitwidthQ)
-TOSYM_MACHINE_INTEGER(Word, SymWordN $intBitwidthQ)
-
-TOSYM_MACHINE_INTEGER_SOME(Int8, SomeSymIntN, IntN, 8)
-TOSYM_MACHINE_INTEGER_SOME(Int16, SomeSymIntN, IntN, 16)
-TOSYM_MACHINE_INTEGER_SOME(Int32, SomeSymIntN, IntN, 32)
-TOSYM_MACHINE_INTEGER_SOME(Int64, SomeSymIntN, IntN, 64)
-TOSYM_MACHINE_INTEGER_SOME(Word8, SomeSymWordN, WordN, 8)
-TOSYM_MACHINE_INTEGER_SOME(Word16, SomeSymWordN, WordN, 16)
-TOSYM_MACHINE_INTEGER_SOME(Word32, SomeSymWordN, WordN, 32)
-TOSYM_MACHINE_INTEGER_SOME(Word64, SomeSymWordN, WordN, 64)
-TOSYM_MACHINE_INTEGER_SOME(Int, SomeSymIntN, IntN, $intBitwidthQ)
-TOSYM_MACHINE_INTEGER_SOME(Word, SomeSymWordN, WordN, $intBitwidthQ)
-
-TOCON_MACHINE_INTEGER(SymIntN, IntN, 8, Int8)
-TOCON_MACHINE_INTEGER(SymIntN, IntN, 16, Int16)
-TOCON_MACHINE_INTEGER(SymIntN, IntN, 32, Int32)
-TOCON_MACHINE_INTEGER(SymIntN, IntN, 64, Int64)
-TOCON_MACHINE_INTEGER(SymWordN, WordN, 8, Word8)
-TOCON_MACHINE_INTEGER(SymWordN, WordN, 16, Word16)
-TOCON_MACHINE_INTEGER(SymWordN, WordN, 32, Word32)
-TOCON_MACHINE_INTEGER(SymWordN, WordN, 64, Word64)
-TOCON_MACHINE_INTEGER(SymIntN, IntN, $intBitwidthQ, Int)
-TOCON_MACHINE_INTEGER(SymWordN, WordN, $intBitwidthQ, Word)
-#endif
-
--- Evaluate
-
-#define EVALUATE_SYM_SIMPLE(symtype) \
-instance EvaluateSym symtype where \
-  evaluateSym fillDefault model (symtype t) = symtype $ evaluateTerm fillDefault model t
-
-#define EVALUATE_SYM_BV(symtype) \
-instance (KnownNat n, 1 <= n) => EvaluateSym (symtype n) where \
-  evaluateSym fillDefault model (symtype t) = symtype $ evaluateTerm fillDefault model t
-
-#define EVALUATE_SYM_FUN(op, cons) \
-instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => EvaluateSym (sa op sb) where \
-  evaluateSym fillDefault model (cons t) = cons $ evaluateTerm fillDefault model t
-
-#define EVALUATE_SYM_BV_SOME(somety, origty) \
-instance EvaluateSym somety where \
-  evaluateSym fillDefault model (somety (origty t)) = somety $ origty $ evaluateTerm fillDefault model t
-
-#if 1
-EVALUATE_SYM_SIMPLE(SymBool)
-EVALUATE_SYM_SIMPLE(SymInteger)
-EVALUATE_SYM_BV(SymIntN)
-EVALUATE_SYM_BV(SymWordN)
-EVALUATE_SYM_FUN(=~>, SymTabularFun)
-EVALUATE_SYM_FUN(-~>, SymGeneralFun)
-EVALUATE_SYM_BV_SOME(SomeSymIntN, SymIntN)
-EVALUATE_SYM_BV_SOME(SomeSymWordN, SymWordN)
-#endif
-
--- ExtractSymbolics
-
-#define EXTRACT_SYMBOLICS_SIMPLE(symtype) \
-instance ExtractSymbolics symtype where \
-  extractSymbolics (symtype t) = SymbolSet $ extractSymbolicsTerm t
-
-#define EXTRACT_SYMBOLICS_BV(symtype) \
-instance (KnownNat n, 1 <= n) => ExtractSymbolics (symtype n) where \
-  extractSymbolics (symtype t) = SymbolSet $ extractSymbolicsTerm t
-
-#define EXTRACT_SYMBOLICS_FUN(op, cons) \
-instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => ExtractSymbolics (sa op sb) where \
-  extractSymbolics (cons t) = SymbolSet $ extractSymbolicsTerm t
-
-#define EXTRACT_SYMBOLICS_BV_SOME(somety, origty) \
-instance ExtractSymbolics somety where \
-  extractSymbolics (somety (origty t)) = SymbolSet $ extractSymbolicsTerm t
-
-#if 1
-EXTRACT_SYMBOLICS_SIMPLE(SymBool)
-EXTRACT_SYMBOLICS_SIMPLE(SymInteger)
-EXTRACT_SYMBOLICS_BV(SymIntN)
-EXTRACT_SYMBOLICS_BV(SymWordN)
-EXTRACT_SYMBOLICS_FUN(=~>, SymTabularFun)
-EXTRACT_SYMBOLICS_FUN(-~>, SymGeneralFun)
-EXTRACT_SYMBOLICS_BV_SOME(SomeSymIntN, SymIntN)
-EXTRACT_SYMBOLICS_BV_SOME(SomeSymWordN, SymWordN)
-#endif
-
--- SEq
-
-#define SEQ_SIMPLE(symtype) \
-instance SEq symtype where \
-  (symtype l) ==~ (symtype r) = SymBool $ pevalEqvTerm l r
-
-#define SEQ_BV(symtype) \
-instance (KnownNat n, 1 <= n) => SEq (symtype n) where \
-  (symtype l) ==~ (symtype r) = SymBool $ pevalEqvTerm l r
-
-#define SEQ_BV_SOME(somety, origty) \
-instance SEq somety where \
-  somety (l :: origty l) ==~ somety (r :: origty r) = \
-    (case sameNat (Proxy @l) (Proxy @r) of \
-      Just Refl -> l ==~ r; \
-      Nothing -> con False); \
-  {-# INLINE (==~) #-}; \
-  somety (l :: origty l) /=~ somety (r :: origty r) = \
-    (case sameNat (Proxy @l) (Proxy @r) of \
-      Just Refl -> l /=~ r; \
-      Nothing -> con True); \
-  {-# INLINE (/=~) #-}
-
-#if 1
-SEQ_SIMPLE(SymBool)
-SEQ_SIMPLE(SymInteger)
-SEQ_BV(SymIntN)
-SEQ_BV(SymWordN)
-SEQ_BV_SOME(SomeSymIntN, SymIntN)
-SEQ_BV_SOME(SomeSymWordN, SymWordN)
-#endif
-
--- SOrd
-
-#define SORD_SIMPLE(symtype) \
-instance SOrd symtype where \
-  (symtype a) <=~ (symtype b) = SymBool $ pevalLeNumTerm a b; \
-  (symtype a) <~ (symtype b) = SymBool $ pevalLtNumTerm a b; \
-  (symtype a) >=~ (symtype b) = SymBool $ pevalGeNumTerm a b; \
-  (symtype a) >~ (symtype b) = SymBool $ pevalGtNumTerm a b; \
-  a `symCompare` b = mrgIf \
-    (a <~ b) \
-    (mrgReturn LT) \
-    (mrgIf (a ==~ b) (mrgReturn EQ) (mrgReturn GT))
-
-#define SORD_BV(symtype) \
-instance (KnownNat n, 1 <= n) => SOrd (symtype n) where \
-  (symtype a) <=~ (symtype b) = SymBool $ pevalLeNumTerm a b; \
-  (symtype a) <~ (symtype b) = SymBool $ pevalLtNumTerm a b; \
-  (symtype a) >=~ (symtype b) = SymBool $ pevalGeNumTerm a b; \
-  (symtype a) >~ (symtype b) = SymBool $ pevalGtNumTerm a b; \
-  a `symCompare` b = mrgIf \
-    (a <~ b) \
-    (mrgReturn LT) \
-    (mrgIf (a ==~ b) (mrgReturn EQ) (mrgReturn GT))
-
-#define SORD_BV_SOME(somety, bf) \
-instance SOrd somety where \
-  (<=~) = bf (<=~) "<=~"; \
-  {-# INLINE (<=~) #-}; \
-  (<~) = bf (<~) "<~"; \
-  {-# INLINE (<~) #-}; \
-  (>=~) = bf (>=~) ">=~"; \
-  {-# INLINE (>=~) #-}; \
-  (>~) = bf (>~) ">~"; \
-  {-# INLINE (>~) #-}; \
-  symCompare = bf symCompare "symCompare"; \
-  {-# INLINE symCompare #-}
-
-instance SOrd SymBool where
-  l <=~ r = nots l ||~ r
-  l <~ r = nots l &&~ r
-  l >=~ r = l ||~ nots r
-  l >~ r = l &&~ nots r
-  symCompare l r =
-    mrgIf
-      (nots l &&~ r)
-      (mrgReturn LT)
-      (mrgIf (l ==~ r) (mrgReturn EQ) (mrgReturn GT))
-
-#if 1
-SORD_SIMPLE(SymInteger)
-SORD_BV(SymIntN)
-SORD_BV(SymWordN)
-SORD_BV_SOME(SomeSymIntN, binSomeSymIntN)
-SORD_BV_SOME(SomeSymWordN, binSomeSymWordN)
-#endif
-
--- SubstituteSym
-
-#define SUBSTITUTE_SYM_SIMPLE(symtype) \
-instance SubstituteSym symtype where \
-  substituteSym sym v (symtype t) = symtype $ substTerm sym (underlyingTerm v) t
-
-#define SUBSTITUTE_SYM_BV(symtype) \
-instance (KnownNat n, 1 <= n) => SubstituteSym (symtype n) where \
-  substituteSym sym v (symtype t) = symtype $ substTerm sym (underlyingTerm v) t
-
-#define SUBSTITUTE_SYM_FUN(op, cons) \
-instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => SubstituteSym (sa op sb) where \
-  substituteSym sym v (cons t) = cons $ substTerm sym (underlyingTerm v) t
-
-#define SUBSTITUTE_SYM_BV_SOME(somety, origty) \
-instance SubstituteSym somety where \
-  substituteSym sym v (somety (origty t)) = somety $ origty $ substTerm sym (underlyingTerm v) t
-
-#if 1
-SUBSTITUTE_SYM_SIMPLE(SymBool)
-SUBSTITUTE_SYM_SIMPLE(SymInteger)
-SUBSTITUTE_SYM_BV(SymIntN)
-SUBSTITUTE_SYM_BV(SymWordN)
-SUBSTITUTE_SYM_FUN(=~>, SymTabularFun)
-SUBSTITUTE_SYM_FUN(-~>, SymGeneralFun)
-SUBSTITUTE_SYM_BV_SOME(SomeSymIntN, SymIntN)
-SUBSTITUTE_SYM_BV_SOME(SomeSymWordN, SymWordN)
-#endif
-
 -- SizedBV
 
 #define BVCONCAT_SIZED(symtype) \
@@ -1559,13 +988,72 @@
 
 -- BVSignConversion
 
-instance (KnownNat n, 1 <= n) => BVSignConversion (SymWordN n) (SymIntN n) where
-  toSigned (SymWordN n) = SymIntN $ pevalBVToSignedTerm n
-  toUnsigned (SymIntN n) = SymWordN $ pevalBVToUnsignedTerm n
+instance (KnownNat n, 1 <= n) => SignConversion (SymWordN n) (SymIntN n) where
+  toSigned (SymWordN n) = SymIntN $ pevalToSignedTerm n
+  toUnsigned (SymIntN n) = SymWordN $ pevalToUnsignedTerm n
 
-instance BVSignConversion SomeSymWordN SomeSymIntN where
+instance SignConversion SomeSymWordN SomeSymIntN where
   toSigned (SomeSymWordN n) = SomeSymIntN $ toSigned n
   toUnsigned (SomeSymIntN n) = SomeSymWordN $ toUnsigned n
+
+-- SymShift
+instance (KnownNat n, 1 <= n) => SymShift (SymWordN n) where
+  symShift (SymWordN a) (SymWordN s) = SymWordN $ pevalShiftLeftTerm a s
+
+instance (KnownNat n, 1 <= n) => SymShift (SymIntN n) where
+  symShift a _ | finiteBitSize a == 1 = a
+  symShift as@(SymIntN a) (SymIntN s)
+    | finiteBitSize as == 2 =
+        SymIntN $
+          pevalITETerm
+            (pevalGeNumTerm s (conTerm 0))
+            (pevalShiftLeftTerm a s)
+            ( pevalITETerm
+                (pevalEqvTerm s (conTerm (-2)))
+                ( pevalITETerm
+                    (pevalGeNumTerm a (conTerm 0))
+                    (conTerm 0)
+                    (conTerm (-1))
+                )
+                (pevalShiftRightTerm a (pevalUMinusNumTerm s))
+            )
+  symShift (SymIntN a) (SymIntN s) =
+    SymIntN $
+      pevalITETerm
+        (pevalGeNumTerm s (conTerm 0))
+        (pevalShiftLeftTerm a s)
+        ( pevalITETerm
+            (pevalLeNumTerm s (conTerm (-bs)))
+            (pevalShiftRightTerm a (conTerm bs))
+            (pevalShiftRightTerm a (pevalUMinusNumTerm s))
+        )
+    where
+      bs = fromIntegral (finiteBitSize (0 :: IntN n)) :: IntN n
+
+-- SymRotate
+instance (KnownNat n, 1 <= n) => SymRotate (SymWordN n) where
+  symRotate (SymWordN a) (SymWordN s) = SymWordN (pevalRotateLeftTerm a s)
+
+instance (KnownNat n, 1 <= n) => SymRotate (SymIntN n) where
+  symRotate a _ | finiteBitSize a == 1 = a
+  symRotate as@(SymIntN a) (SymIntN s)
+    | finiteBitSize as == 2 =
+        SymIntN $
+          pevalITETerm
+            ( pevalOrTerm
+                (pevalEqvTerm s (conTerm 0))
+                (pevalEqvTerm s (conTerm (-2)))
+            )
+            a
+            (pevalRotateLeftTerm a (conTerm 1))
+  symRotate as@(SymIntN a) (SymIntN s) =
+    SymIntN $
+      pevalRotateLeftTerm
+        a
+        ( pevalModBoundedIntegralTerm
+            s
+            (conTerm (fromIntegral $ finiteBitSize as))
+        )
 
 -- ModelRep
 
diff --git a/src/Grisette/IR/SymPrim/Data/SymPrim.hs-boot b/src/Grisette/IR/SymPrim/Data/SymPrim.hs-boot
deleted file mode 100644
--- a/src/Grisette/IR/SymPrim/Data/SymPrim.hs-boot
+++ /dev/null
@@ -1,136 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-module Grisette.IR.SymPrim.Data.SymPrim
-  ( SymBool (..),
-    SymInteger (..),
-    SymIntN (..),
-    SymWordN (..),
-    SomeSymIntN (..),
-    SomeSymWordN (..),
-    type (=~>) (..),
-    type (-~>) (..),
-    SomeSym (..),
-    AllSyms (..),
-    unarySomeSymIntN,
-    unarySomeSymIntNR1,
-    binSomeSymIntN,
-    binSomeSymIntNR1,
-    binSomeSymIntNR2,
-    unarySomeSymWordN,
-    unarySomeSymWordNR1,
-    binSomeSymWordN,
-    binSomeSymWordNR1,
-    binSomeSymWordNR2,
-  )
-where
-
-import Control.DeepSeq (NFData)
-import Data.Hashable (Hashable)
-import GHC.TypeNats (KnownNat, Nat, type (<=))
-import Grisette.Core.Data.BV (IntN, WordN)
-import Grisette.Core.Data.Class.Evaluate (EvaluateSym)
-import Grisette.Core.Data.Class.ExtractSymbolics
-  ( ExtractSymbolics,
-  )
-import Grisette.Core.Data.Class.GPretty (GPretty)
-import Grisette.Core.Data.Class.Solvable (Solvable)
-import {-# SOURCE #-} Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
-  ( LinkedRep,
-    SupportedPrim,
-    Term,
-    type (-->),
-  )
-import Grisette.IR.SymPrim.Data.TabularFun (type (=->))
-import Language.Haskell.TH.Syntax (Lift)
-
-newtype SymBool = SymBool {underlyingBoolTerm :: Term Bool}
-
-newtype SymIntN (n :: Nat) = SymIntN {underlyingIntNTerm :: Term (IntN n)}
-
-newtype SymWordN (n :: Nat) = SymWordN {underlyingWordNTerm :: Term (WordN n)}
-
-data SomeSymIntN where
-  SomeSymIntN :: (KnownNat n, 1 <= n) => SymIntN n -> SomeSymIntN
-
-data SomeSymWordN where
-  SomeSymWordN :: (KnownNat n, 1 <= n) => SymWordN n -> SomeSymWordN
-
-data sa =~> sb where
-  SymTabularFun :: (LinkedRep ca sa, LinkedRep cb sb) => Term (ca =-> cb) -> sa =~> sb
-
-data sa -~> sb where
-  SymGeneralFun :: (LinkedRep ca sa, LinkedRep cb sb) => Term (ca --> cb) -> sa -~> sb
-
-unarySomeSymIntN :: (forall n. (KnownNat n, 1 <= n) => SymIntN n -> r) -> String -> SomeSymIntN -> r
-unarySomeSymIntNR1 :: (forall n. (KnownNat n, 1 <= n) => SymIntN n -> SymIntN n) -> String -> SomeSymIntN -> SomeSymIntN
-binSomeSymIntN :: (forall n. (KnownNat n, 1 <= n) => SymIntN n -> SymIntN n -> r) -> String -> SomeSymIntN -> SomeSymIntN -> r
-binSomeSymIntNR1 :: (forall n. (KnownNat n, 1 <= n) => SymIntN n -> SymIntN n -> SymIntN n) -> String -> SomeSymIntN -> SomeSymIntN -> SomeSymIntN
-binSomeSymIntNR2 :: (forall n. (KnownNat n, 1 <= n) => SymIntN n -> SymIntN n -> (SymIntN n, SymIntN n)) -> String -> SomeSymIntN -> SomeSymIntN -> (SomeSymIntN, SomeSymIntN)
-unarySomeSymWordN :: (forall n. (KnownNat n, 1 <= n) => SymWordN n -> r) -> String -> SomeSymWordN -> r
-unarySomeSymWordNR1 :: (forall n. (KnownNat n, 1 <= n) => SymWordN n -> SymWordN n) -> String -> SomeSymWordN -> SomeSymWordN
-binSomeSymWordN :: (forall n. (KnownNat n, 1 <= n) => SymWordN n -> SymWordN n -> r) -> String -> SomeSymWordN -> SomeSymWordN -> r
-binSomeSymWordNR1 :: (forall n. (KnownNat n, 1 <= n) => SymWordN n -> SymWordN n -> SymWordN n) -> String -> SomeSymWordN -> SomeSymWordN -> SomeSymWordN
-binSomeSymWordNR2 :: (forall n. (KnownNat n, 1 <= n) => SymWordN n -> SymWordN n -> (SymWordN n, SymWordN n)) -> String -> SomeSymWordN -> SomeSymWordN -> (SomeSymWordN, SomeSymWordN)
-
-instance Solvable Bool SymBool
-
-instance LinkedRep Bool SymBool
-
-instance Eq SymBool
-
-instance Lift SymBool
-
-instance NFData SymBool
-
-instance Show SymBool
-
-instance Hashable SymBool
-
-instance EvaluateSym SymBool
-
-instance ExtractSymbolics SymBool
-
-instance GPretty SymBool
-
-newtype SymInteger = SymInteger {underlyingIntegerTerm :: Term Integer}
-
-instance Solvable Integer SymInteger
-
-instance Eq SymInteger
-
-instance Lift SymInteger
-
-instance NFData SymInteger
-
-instance Show SymInteger
-
-instance Hashable SymInteger
-
-instance EvaluateSym SymInteger
-
-instance ExtractSymbolics SymInteger
-
-instance (KnownNat n, 1 <= n) => Solvable (WordN n) (SymWordN n)
-
-instance (KnownNat n, 1 <= n) => Solvable (IntN n) (SymIntN n)
-
-instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => Solvable (ca --> cb) (sa -~> sb)
-
-instance (SupportedPrim ca, SupportedPrim cb, LinkedRep ca sa, LinkedRep cb sb) => Solvable (ca =-> cb) (sa =~> sb)
-
-data SomeSym where
-  SomeSym :: (LinkedRep con sym) => sym -> SomeSym
-
-class AllSyms a where
-  allSymsS :: a -> [SomeSym] -> [SomeSym]
-  allSymsS a l = allSyms a ++ l
-  allSyms :: a -> [SomeSym]
-  allSyms a = allSymsS a []
-  {-# MINIMAL allSymsS | allSyms #-}
diff --git a/src/Grisette/IR/SymPrim/Data/TabularFun.hs-boot b/src/Grisette/IR/SymPrim/Data/TabularFun.hs-boot
deleted file mode 100644
--- a/src/Grisette/IR/SymPrim/Data/TabularFun.hs-boot
+++ /dev/null
@@ -1,22 +0,0 @@
-{-# LANGUAGE TypeOperators #-}
-
-module Grisette.IR.SymPrim.Data.TabularFun
-  ( type (=->) (..),
-  )
-where
-
-import Control.DeepSeq (NFData)
-import Data.Hashable (Hashable)
-import Language.Haskell.TH.Syntax (Lift)
-
-data (=->) a b = TabularFun {funcTable :: [(a, b)], defaultFuncValue :: b}
-
-instance (Eq a, Eq b) => Eq (a =-> b)
-
-instance (Show a, Show b) => Show (a =-> b)
-
-instance (Hashable a, Hashable b) => Hashable (a =-> b)
-
-instance (Lift a, Lift b) => Lift (a =-> b)
-
-instance (NFData a, NFData b) => NFData (a =-> b)
diff --git a/src/Grisette/Lib/Base.hs b/src/Grisette/Lib/Base.hs
--- a/src/Grisette/Lib/Base.hs
+++ b/src/Grisette/Lib/Base.hs
@@ -15,8 +15,8 @@
     mrgReturnWithStrategy,
     mrgBindWithStrategy,
     mrgReturn,
-    (>>=~),
-    (>>~),
+    (.>>=),
+    (.>>),
     mrgFoldM,
     mrgMzero,
     mrgMplus,
@@ -41,7 +41,7 @@
     mrgSequence,
 
     -- ** Symbolic versions for operations in "Data.List"
-    (!!~),
+    (.!!),
     symFilter,
     symTake,
     symDrop,
@@ -56,8 +56,8 @@
     mrgMzero,
     mrgReturn,
     mrgReturnWithStrategy,
-    (>>=~),
-    (>>~),
+    (.>>),
+    (.>>=),
   )
 import Grisette.Lib.Data.Foldable
   ( mrgFoldlM,
@@ -73,7 +73,7 @@
   ( symDrop,
     symFilter,
     symTake,
-    (!!~),
+    (.!!),
   )
 import Grisette.Lib.Data.Traversable
   ( mrgFor,
diff --git a/src/Grisette/Lib/Control/Monad.hs b/src/Grisette/Lib/Control/Monad.hs
--- a/src/Grisette/Lib/Control/Monad.hs
+++ b/src/Grisette/Lib/Control/Monad.hs
@@ -16,8 +16,8 @@
     mrgReturnWithStrategy,
     mrgBindWithStrategy,
     mrgReturn,
-    (>>=~),
-    (>>~),
+    (.>>=),
+    (.>>),
     mrgFoldM,
     mrgMzero,
     mrgMplus,
@@ -53,9 +53,9 @@
 {-# INLINE mrgReturn #-}
 
 -- | '>>=' with 'MergingStrategy' knowledge propagation.
-(>>=~) :: (MonadUnion u, Mergeable b) => u a -> (a -> u b) -> u b
-a >>=~ f = merge $ a >>= f
-{-# INLINE (>>=~) #-}
+(.>>=) :: (MonadUnion u, Mergeable b) => u a -> (a -> u b) -> u b
+a .>>= f = merge $ a >>= f
+{-# INLINE (.>>=) #-}
 
 -- | 'foldM' with 'MergingStrategy' knowledge propagation.
 mrgFoldM :: (MonadUnion m, Mergeable b, Foldable t) => (b -> a -> m b) -> b -> t a -> m b
@@ -65,9 +65,9 @@
 -- | '>>' with 'MergingStrategy' knowledge propagation.
 --
 -- This is usually more efficient than calling the original '>>' and merge the results.
-(>>~) :: forall m a b. (MonadUnion m, Mergeable b) => m a -> m b -> m b
-a >>~ f = merge $ mrgFmap (const ()) a >> f
-{-# INLINE (>>~) #-}
+(.>>) :: forall m a b. (MonadUnion m, Mergeable b) => m a -> m b -> m b
+a .>> f = merge $ mrgFmap (const ()) a >> f
+{-# INLINE (.>>) #-}
 
 -- | 'mzero' with 'MergingStrategy' knowledge propagation.
 mrgMzero :: forall m a. (MonadUnion m, Mergeable a, MonadPlus m) => m a
diff --git a/src/Grisette/Lib/Control/Monad.hs-boot b/src/Grisette/Lib/Control/Monad.hs-boot
--- a/src/Grisette/Lib/Control/Monad.hs-boot
+++ b/src/Grisette/Lib/Control/Monad.hs-boot
@@ -5,9 +5,9 @@
   ( mrgReturnWithStrategy,
     mrgBindWithStrategy,
     mrgReturn,
-    (>>=~),
+    (.>>=),
     mrgFoldM,
-    (>>~),
+    (.>>),
     mrgMzero,
     mrgMplus,
     mrgFmap,
@@ -24,9 +24,9 @@
 mrgReturnWithStrategy :: (MonadUnion u) => MergingStrategy a -> a -> u a
 mrgBindWithStrategy :: (MonadUnion u) => MergingStrategy b -> u a -> (a -> u b) -> u b
 mrgReturn :: (MonadUnion u, Mergeable a) => a -> u a
-(>>=~) :: (MonadUnion u, Mergeable b) => u a -> (a -> u b) -> u b
+(.>>=) :: (MonadUnion u, Mergeable b) => u a -> (a -> u b) -> u b
 mrgFoldM :: (MonadUnion m, Mergeable b, Foldable t) => (b -> a -> m b) -> b -> t a -> m b
-(>>~) :: forall m a b. (MonadUnion m, Mergeable b) => m a -> m b -> m b
+(.>>) :: forall m a b. (MonadUnion m, Mergeable b) => m a -> m b -> m b
 mrgMzero :: forall m a. (MonadUnion m, Mergeable a, MonadPlus m) => m a
 mrgMplus :: forall m a. (MonadUnion m, Mergeable a, MonadPlus m) => m a -> m a -> m a
 mrgFmap :: (MonadUnion f, Mergeable b, Functor f) => (a -> b) -> f a -> f b
diff --git a/src/Grisette/Lib/Control/Monad/State/Class.hs b/src/Grisette/Lib/Control/Monad/State/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Lib/Control/Monad/State/Class.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE Trustworthy #-}
+
+-- |
+-- Module      :   Grisette.Lib.Control.Monad.State.Class
+-- Copyright   :   (c) Sirui Lu 2023
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Lib.Control.Monad.State.Class
+  ( -- * mrg* variants for operations in "Control.Monad.State.Class"
+    mrgGet,
+    mrgPut,
+    mrgState,
+    mrgModify,
+    mrgModify',
+    mrgGets,
+  )
+where
+
+import Control.Monad.State.Class (MonadState (get, put))
+import Grisette.Core.Data.Class.Mergeable (Mergeable)
+import Grisette.Core.Data.Class.SimpleMergeable (UnionLike, merge)
+import Grisette.Lib.Control.Monad (mrgReturn)
+
+-- | 'Control.Monad.State.Class.get' with 'MergingStrategy' knowledge
+-- propagation.
+mrgGet :: (MonadState s m, UnionLike m, Mergeable s) => m s
+mrgGet = merge get
+{-# INLINE mrgGet #-}
+
+-- | 'Control.Monad.State.Class.put' with 'MergingStrategy' knowledge
+-- propagation.
+mrgPut :: (MonadState s m, UnionLike m) => s -> m ()
+mrgPut = merge . put
+{-# INLINE mrgPut #-}
+
+-- | 'Control.Monad.State.Class.state' with 'MergingStrategy' knowledge
+-- propagation.
+mrgState ::
+  (MonadState s m, UnionLike m, Mergeable s, Mergeable a) =>
+  (s -> (a, s)) ->
+  m a
+mrgState f = do
+  s <- mrgGet
+  let ~(a, s') = f s
+  mrgPut s'
+  mrgReturn a
+
+-- | 'Control.Monad.State.Class.modify' with 'MergingStrategy' knowledge
+-- propagation.
+mrgModify :: (MonadState s m, UnionLike m, Mergeable s) => (s -> s) -> m ()
+mrgModify f = mrgState (\s -> ((), f s))
+{-# INLINE mrgModify #-}
+
+-- | 'Control.Monad.State.Class.modify'' with 'MergingStrategy' knowledge
+-- propagation.
+mrgModify' :: (MonadState s m, UnionLike m, Mergeable s) => (s -> s) -> m ()
+mrgModify' f = do
+  s' <- mrgGet
+  mrgPut $! f s'
+{-# INLINE mrgModify' #-}
+
+-- | 'Control.Monad.State.Class.gets' with 'MergingStrategy' knowledge
+-- propagation.
+mrgGets ::
+  (MonadState s m, UnionLike m, Mergeable s, Mergeable a) =>
+  (s -> a) ->
+  m a
+mrgGets f = do
+  s <- mrgGet
+  mrgReturn $ f s
+{-# INLINE mrgGets #-}
diff --git a/src/Grisette/Lib/Control/Monad/Trans.hs b/src/Grisette/Lib/Control/Monad/Trans.hs
--- a/src/Grisette/Lib/Control/Monad/Trans.hs
+++ b/src/Grisette/Lib/Control/Monad/Trans.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE Trustworthy #-}
+{-# OPTIONS_GHC -Wno-missing-import-lists #-}
 
 -- |
 -- Module      :   Grisette.Lib.Control.Monad.Trans
@@ -11,21 +12,8 @@
 -- Stability   :   Experimental
 -- Portability :   GHC only
 module Grisette.Lib.Control.Monad.Trans
-  ( -- * mrg* variants for operations in "Control.Monad.Trans"
-    mrgLift,
+  ( module Grisette.Lib.Control.Monad.Trans.Class,
   )
 where
 
-import Control.Monad.Trans (MonadTrans (lift))
-import Grisette.Core.Control.Monad.Union (MonadUnion)
-import Grisette.Core.Data.Class.Mergeable (Mergeable)
-import Grisette.Core.Data.Class.SimpleMergeable (merge)
-
--- | 'lift' with 'MergingStrategy' knowledge propagation.
-mrgLift ::
-  forall t m a.
-  (MonadUnion (t m), MonadTrans t, Monad m, Mergeable a) =>
-  m a ->
-  t m a
-mrgLift v = merge $ lift v
-{-# INLINE mrgLift #-}
+import Grisette.Lib.Control.Monad.Trans.Class
diff --git a/src/Grisette/Lib/Control/Monad/Trans/Class.hs b/src/Grisette/Lib/Control/Monad/Trans/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Lib/Control/Monad/Trans/Class.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE Trustworthy #-}
+
+-- |
+-- Module      :   Grisette.Lib.Control.Monad.Trans.Class
+-- Copyright   :   (c) Sirui Lu 2021-2023
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Lib.Control.Monad.Trans.Class
+  ( -- * mrg* variants for operations in "Control.Monad.Trans.Class"
+    mrgLift,
+  )
+where
+
+import Control.Monad.Trans (MonadTrans (lift))
+import Grisette.Core.Control.Monad.Union (MonadUnion)
+import Grisette.Core.Data.Class.Mergeable (Mergeable)
+import Grisette.Core.Data.Class.SimpleMergeable (merge)
+
+-- | 'lift' with 'MergingStrategy' knowledge propagation.
+mrgLift ::
+  forall t m a.
+  (MonadUnion (t m), MonadTrans t, Monad m, Mergeable a) =>
+  m a ->
+  t m a
+mrgLift v = merge $ lift v
+{-# INLINE mrgLift #-}
diff --git a/src/Grisette/Lib/Control/Monad/Trans/State.hs b/src/Grisette/Lib/Control/Monad/Trans/State.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Lib/Control/Monad/Trans/State.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE Trustworthy #-}
+{-# OPTIONS_GHC -Wno-missing-import-lists #-}
+
+-- |
+-- Module      :   Grisette.Lib.Control.Monad.Trans.State
+-- Copyright   :   (c) Sirui Lu 2023
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Lib.Control.Monad.Trans.State
+  ( module Grisette.Lib.Control.Monad.Trans.State.Lazy,
+  )
+where
+
+import Grisette.Lib.Control.Monad.Trans.State.Lazy
diff --git a/src/Grisette/Lib/Control/Monad/Trans/State/Lazy.hs b/src/Grisette/Lib/Control/Monad/Trans/State/Lazy.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Lib/Control/Monad/Trans/State/Lazy.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE Trustworthy #-}
+
+-- |
+-- Module      :   Grisette.Lib.Control.Monad.Trans.State.Lazy
+-- Copyright   :   (c) Sirui Lu 2023
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Lib.Control.Monad.Trans.State.Lazy
+  ( -- * mrg* variants for operations in "Control.Monad.Trans.State.Lazy"
+    mrgState,
+    mrgRunStateT,
+    mrgEvalStateT,
+    mrgExecStateT,
+    mrgMapStateT,
+    mrgWithStateT,
+    mrgGet,
+    mrgPut,
+    mrgModify,
+    mrgModify',
+    mrgGets,
+  )
+where
+
+import Control.Monad.Trans.State.Lazy
+  ( StateT (StateT),
+    runStateT,
+  )
+import Grisette.Core.Data.Class.Mergeable (Mergeable)
+import Grisette.Core.Data.Class.SimpleMergeable (UnionLike, merge)
+import Grisette.Lib.Control.Monad (mrgReturn)
+
+-- | 'Control.Monad.Trans.State.Lazy.state' with 'MergingStrategy' knowledge
+-- propagation.
+mrgState ::
+  (Monad m, UnionLike m, Mergeable s, Mergeable a) =>
+  (s -> (a, s)) ->
+  StateT s m a
+mrgState f = StateT (mrgReturn . f)
+{-# INLINE mrgState #-}
+
+-- | 'Control.Monad.Trans.State.Lazy.runStateT' with 'MergingStrategy' knowledge
+-- propagation.
+mrgRunStateT ::
+  (Monad m, UnionLike m, Mergeable s, Mergeable a) =>
+  StateT s m a ->
+  s ->
+  m (a, s)
+mrgRunStateT m s = runStateT m s >>= mrgReturn
+{-# INLINE mrgRunStateT #-}
+
+-- | 'Control.Monad.Trans.State.Lazy.evalStateT' with 'MergingStrategy'
+-- knowledge propagation.
+mrgEvalStateT ::
+  (Monad m, UnionLike m, Mergeable a) =>
+  StateT s m a ->
+  s ->
+  m a
+mrgEvalStateT m s = do
+  ~(a, _) <- runStateT m s
+  mrgReturn a
+{-# INLINE mrgEvalStateT #-}
+
+-- | 'Control.Monad.Trans.State.Lazy.execStateT' with 'MergingStrategy'
+-- knowledge propagation.
+mrgExecStateT ::
+  (Monad m, UnionLike m, Mergeable s) =>
+  StateT s m a ->
+  s ->
+  m s
+mrgExecStateT m s = do
+  ~(_, s') <- runStateT m s
+  mrgReturn s'
+{-# INLINE mrgExecStateT #-}
+
+-- | 'Control.Monad.Trans.State.Lazy.mapStateT' with 'MergingStrategy' knowledge
+-- propagation.
+mrgMapStateT ::
+  (UnionLike n, Mergeable b, Mergeable s) =>
+  (m (a, s) -> n (b, s)) ->
+  StateT s m a ->
+  StateT s n b
+mrgMapStateT f m = StateT $ merge . f . runStateT m
+{-# INLINE mrgMapStateT #-}
+
+-- | 'Control.Monad.Trans.State.Lazy.withStateT' with 'MergingStrategy'
+-- knowledge propagation.
+mrgWithStateT ::
+  (UnionLike m, Mergeable s, Mergeable a) =>
+  (s -> s) ->
+  StateT s m a ->
+  StateT s m a
+mrgWithStateT f m = StateT $ merge . runStateT m . f
+{-# INLINE mrgWithStateT #-}
+
+-- | 'Control.Monad.Trans.State.Lazy.get' with 'MergingStrategy' knowledge
+-- propagation.
+mrgGet :: (Monad m, UnionLike m, Mergeable s) => StateT s m s
+mrgGet = mrgState (\s -> (s, s))
+{-# INLINE mrgGet #-}
+
+-- | 'Control.Monad.Trans.State.Lazy.put' with 'MergingStrategy' knowledge
+-- propagation.
+mrgPut :: (Monad m, UnionLike m, Mergeable s) => s -> StateT s m ()
+mrgPut s = mrgState (const ((), s))
+{-# INLINE mrgPut #-}
+
+-- | 'Control.Monad.Trans.State.Lazy.modify' with 'MergingStrategy' knowledge
+-- propagation.
+mrgModify :: (Monad m, UnionLike m, Mergeable s) => (s -> s) -> StateT s m ()
+mrgModify f = mrgState (\s -> ((), f s))
+{-# INLINE mrgModify #-}
+
+-- | 'Control.Monad.Trans.State.Lazy.modify'' with 'MergingStrategy' knowledge
+-- propagation.
+mrgModify' :: (Monad m, UnionLike m, Mergeable s) => (s -> s) -> StateT s m ()
+mrgModify' f = do
+  s <- mrgGet
+  mrgPut $! f s
+{-# INLINE mrgModify' #-}
+
+-- | 'Control.Monad.Trans.State.Lazy.gets' with 'MergingStrategy' knowledge
+-- propagation.
+mrgGets ::
+  (Monad m, UnionLike m, Mergeable s, Mergeable a) =>
+  (s -> a) ->
+  StateT s m a
+mrgGets f = mrgState $ \s -> (f s, s)
+{-# INLINE mrgGets #-}
diff --git a/src/Grisette/Lib/Control/Monad/Trans/State/Strict.hs b/src/Grisette/Lib/Control/Monad/Trans/State/Strict.hs
new file mode 100644
--- /dev/null
+++ b/src/Grisette/Lib/Control/Monad/Trans/State/Strict.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE Trustworthy #-}
+
+-- |
+-- Module      :   Grisette.Lib.Control.Monad.Trans.State.Strict
+-- Copyright   :   (c) Sirui Lu 2023
+-- License     :   BSD-3-Clause (see the LICENSE file)
+--
+-- Maintainer  :   siruilu@cs.washington.edu
+-- Stability   :   Experimental
+-- Portability :   GHC only
+module Grisette.Lib.Control.Monad.Trans.State.Strict
+  ( -- * mrg* variants for operations in "Control.Monad.Trans.State.Strict"
+    mrgState,
+    mrgRunStateT,
+    mrgEvalStateT,
+    mrgExecStateT,
+    mrgMapStateT,
+    mrgWithStateT,
+    mrgGet,
+    mrgPut,
+    mrgModify,
+    mrgModify',
+    mrgGets,
+  )
+where
+
+import Control.Monad.Trans.State.Strict
+  ( StateT (StateT),
+    runStateT,
+  )
+import Grisette.Core.Data.Class.Mergeable (Mergeable)
+import Grisette.Core.Data.Class.SimpleMergeable (UnionLike, merge)
+import Grisette.Lib.Control.Monad (mrgReturn)
+
+-- | 'Control.Monad.Trans.State.Strict.state' with 'MergingStrategy' knowledge
+-- propagation.
+mrgState ::
+  (Monad m, UnionLike m, Mergeable s, Mergeable a) =>
+  (s -> (a, s)) ->
+  StateT s m a
+mrgState f = StateT (mrgReturn . f)
+{-# INLINE mrgState #-}
+
+-- | 'Control.Monad.Trans.State.Strict.runStateT' with 'MergingStrategy'
+-- knowledge propagation.
+mrgRunStateT ::
+  (Monad m, UnionLike m, Mergeable s, Mergeable a) =>
+  StateT s m a ->
+  s ->
+  m (a, s)
+mrgRunStateT m s = runStateT m s >>= mrgReturn
+{-# INLINE mrgRunStateT #-}
+
+-- | 'Control.Monad.Trans.State.Strict.evalStateT' with 'MergingStrategy'
+-- knowledge propagation.
+mrgEvalStateT ::
+  (Monad m, UnionLike m, Mergeable a) =>
+  StateT s m a ->
+  s ->
+  m a
+mrgEvalStateT m s = do
+  (a, _) <- runStateT m s
+  mrgReturn a
+{-# INLINE mrgEvalStateT #-}
+
+-- | 'Control.Monad.Trans.State.Strict.execStateT' with 'MergingStrategy'
+-- knowledge propagation.
+mrgExecStateT ::
+  (Monad m, UnionLike m, Mergeable s) =>
+  StateT s m a ->
+  s ->
+  m s
+mrgExecStateT m s = do
+  (_, s') <- runStateT m s
+  mrgReturn s'
+{-# INLINE mrgExecStateT #-}
+
+-- | 'Control.Monad.Trans.State.Strict.mapStateT' with 'MergingStrategy'
+-- knowledge propagation.
+mrgMapStateT ::
+  (UnionLike n, Mergeable b, Mergeable s) =>
+  (m (a, s) -> n (b, s)) ->
+  StateT s m a ->
+  StateT s n b
+mrgMapStateT f m = StateT $ merge . f . runStateT m
+{-# INLINE mrgMapStateT #-}
+
+-- | 'Control.Monad.Trans.State.Strict.withStateT' with 'MergingStrategy'
+-- knowledge propagation.
+mrgWithStateT ::
+  (UnionLike m, Mergeable s, Mergeable a) =>
+  (s -> s) ->
+  StateT s m a ->
+  StateT s m a
+mrgWithStateT f m = StateT $ merge . runStateT m . f
+{-# INLINE mrgWithStateT #-}
+
+-- | 'Control.Monad.Trans.State.Strict.get' with 'MergingStrategy' knowledge
+-- propagation.
+mrgGet :: (Monad m, UnionLike m, Mergeable s) => StateT s m s
+mrgGet = mrgState (\s -> (s, s))
+{-# INLINE mrgGet #-}
+
+-- | 'Control.Monad.Trans.State.Strict.put' with 'MergingStrategy' knowledge
+-- propagation.
+mrgPut :: (Monad m, UnionLike m, Mergeable s) => s -> StateT s m ()
+mrgPut s = mrgState (const ((), s))
+{-# INLINE mrgPut #-}
+
+-- | 'Control.Monad.Trans.State.Strict.modify' with 'MergingStrategy' knowledge
+-- propagation.
+mrgModify :: (Monad m, UnionLike m, Mergeable s) => (s -> s) -> StateT s m ()
+mrgModify f = mrgState (\s -> ((), f s))
+{-# INLINE mrgModify #-}
+
+-- | 'Control.Monad.Trans.State.Strict.modify'' with 'MergingStrategy' knowledge
+-- propagation.
+mrgModify' :: (Monad m, UnionLike m, Mergeable s) => (s -> s) -> StateT s m ()
+mrgModify' f = do
+  s <- mrgGet
+  mrgPut $! f s
+{-# INLINE mrgModify' #-}
+
+-- | 'Control.Monad.Trans.State.Strict.gets' with 'MergingStrategy' knowledge
+-- propagation.
+mrgGets ::
+  (Monad m, UnionLike m, Mergeable s, Mergeable a) =>
+  (s -> a) ->
+  StateT s m a
+mrgGets f = mrgState $ \s -> (f s, s)
+{-# INLINE mrgGets #-}
diff --git a/src/Grisette/Lib/Data/List.hs b/src/Grisette/Lib/Data/List.hs
--- a/src/Grisette/Lib/Data/List.hs
+++ b/src/Grisette/Lib/Data/List.hs
@@ -10,7 +10,7 @@
 -- Portability :   GHC only
 module Grisette.Lib.Data.List
   ( -- * Symbolic versions of 'Data.List' operations
-    (!!~),
+    (.!!),
     symFilter,
     symTake,
     symDrop,
@@ -20,17 +20,17 @@
 import Control.Exception (ArrayException (IndexOutOfBounds))
 import Control.Monad.Except (MonadError (throwError))
 import Grisette.Core.Control.Monad.Union (MonadUnion)
-import Grisette.Core.Data.Class.Bool (SEq ((==~)))
 import Grisette.Core.Data.Class.Error (TransformError (transformError))
 import Grisette.Core.Data.Class.Mergeable (Mergeable)
-import Grisette.Core.Data.Class.SOrd (SOrd ((<=~)))
+import Grisette.Core.Data.Class.SEq (SEq ((.==)))
+import Grisette.Core.Data.Class.SOrd (SOrd ((.<=)))
 import Grisette.Core.Data.Class.SimpleMergeable (mrgIf)
 import Grisette.IR.SymPrim.Data.SymPrim (SymBool, SymInteger)
 import Grisette.Lib.Control.Monad (mrgFmap, mrgReturn)
 
 -- | Symbolic version of 'Data.List.!!', the result would be merged and
 -- propagate the mergeable knowledge.
-(!!~) ::
+(.!!) ::
   ( MonadUnion uf,
     MonadError e uf,
     TransformError ArrayException e,
@@ -39,10 +39,10 @@
   [a] ->
   SymInteger ->
   uf a
-l !!~ p = go l p 0
+l .!! p = go l p 0
   where
     go [] _ _ = throwError $ transformError (IndexOutOfBounds "!!~")
-    go (x : xs) p1 i = mrgIf (p1 ==~ i) (mrgReturn x) (go xs p1 $ i + 1)
+    go (x : xs) p1 i = mrgIf (p1 .== i) (mrgReturn x) (go xs p1 $ i + 1)
 
 -- | Symbolic version of 'Data.List.filter', the result would be merged and
 -- propagate the mergeable knowledge.
@@ -58,10 +58,10 @@
 -- propagate the mergeable knowledge.
 symTake :: (MonadUnion u, Mergeable a) => SymInteger -> [a] -> u [a]
 symTake _ [] = mrgReturn []
-symTake x (v : vs) = mrgIf (x <=~ 0) (mrgReturn []) (mrgFmap (v :) $ symTake (x - 1) vs)
+symTake x (v : vs) = mrgIf (x .<= 0) (mrgReturn []) (mrgFmap (v :) $ symTake (x - 1) vs)
 
 -- | Symbolic version of 'Data.List.drop', the result would be merged and
 -- propagate the mergeable knowledge.
 symDrop :: (MonadUnion u, Mergeable a) => SymInteger -> [a] -> u [a]
 symDrop _ [] = mrgReturn []
-symDrop x r@(_ : vs) = mrgIf (x <=~ 0) (mrgReturn r) (symDrop (x - 1) vs)
+symDrop x r@(_ : vs) = mrgIf (x .<= 0) (mrgReturn r) (symDrop (x - 1) vs)
diff --git a/src/Grisette/Lib/Mtl.hs b/src/Grisette/Lib/Mtl.hs
deleted file mode 100644
--- a/src/Grisette/Lib/Mtl.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-{-# LANGUAGE Trustworthy #-}
-
--- |
--- Module      :   Grisette.Lib.Mtl
--- Copyright   :   (c) Sirui Lu 2021-2023
--- License     :   BSD-3-Clause (see the LICENSE file)
---
--- Maintainer  :   siruilu@cs.washington.edu
--- Stability   :   Experimental
--- Portability :   GHC only
-module Grisette.Lib.Mtl
-  ( -- * Symbolic or mrg* variants for the operations in the mtl (and transformers) package
-
-    -- ** mrg* variants for operations in "Control.Monad.Except"
-    mrgThrowError,
-    mrgCatchError,
-
-    -- ** mrg* variants for operations in "Control.Monad.Trans"
-    mrgLift,
-
-    -- ** mrg* variants for operations in "Control.Monad.Trans.Cont"
-    mrgRunContT,
-    mrgEvalContT,
-    mrgResetT,
-  )
-where
-
-import Grisette.Lib.Control.Monad.Except
-  ( mrgCatchError,
-    mrgThrowError,
-  )
-import Grisette.Lib.Control.Monad.Trans (mrgLift)
-import Grisette.Lib.Control.Monad.Trans.Cont
-  ( mrgEvalContT,
-    mrgResetT,
-    mrgRunContT,
-  )
diff --git a/test/Grisette/Backend/SBV/Data/SMT/CEGISTests.hs b/test/Grisette/Backend/SBV/Data/SMT/CEGISTests.hs
--- a/test/Grisette/Backend/SBV/Data/SMT/CEGISTests.hs
+++ b/test/Grisette/Backend/SBV/Data/SMT/CEGISTests.hs
@@ -15,33 +15,36 @@
 import Grisette.Backend.SBV (GrisetteSMTConfig, precise, z3)
 import Grisette.Core.Control.Exception
   ( VerificationConditions,
-    symAssert,
-    symAssume,
   )
 import Grisette.Core.Control.Monad.UnionM (UnionM)
 import Grisette.Core.Data.Class.BitVector
   ( SizedBV (sizedBVConcat, sizedBVSelect, sizedBVSext, sizedBVZext),
   )
-import Grisette.Core.Data.Class.Bool
-  ( ITEOp (ites),
-    LogicalOp (nots, xors, (&&~), (||~)),
-    SEq ((==~)),
-  )
 import Grisette.Core.Data.Class.CEGISSolver
-  ( CEGISSolver (cegisMultiInputs),
+  ( CEGISResult (CEGISSuccess),
     cegis,
     cegisExceptVC,
+    cegisMultiInputs,
     cegisPostCond,
   )
-import Grisette.Core.Data.Class.Evaluate (EvaluateSym (evaluateSym))
+import Grisette.Core.Data.Class.Error
+  ( symAssert,
+    symAssume,
+  )
+import Grisette.Core.Data.Class.EvaluateSym (EvaluateSym (evaluateSym))
 import Grisette.Core.Data.Class.ExtractSymbolics
   ( ExtractSymbolics,
   )
-import Grisette.Core.Data.Class.Function (Function ((#)))
-import Grisette.Core.Data.Class.SOrd (SOrd ((<~), (>=~)))
+import Grisette.Core.Data.Class.Function (Apply (apply), Function ((#)))
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.LogicalOp
+  ( LogicalOp (symNot, symXor, (.&&), (.||)),
+  )
+import Grisette.Core.Data.Class.SEq (SEq ((.==)))
+import Grisette.Core.Data.Class.SOrd (SOrd ((.<), (.>=)))
 import Grisette.Core.Data.Class.SimpleMergeable (mrgIf)
-import Grisette.Core.Data.Class.Solvable (Solvable (con, ssym))
-import Grisette.Core.Data.Class.Solver (Solver (solve))
+import Grisette.Core.Data.Class.Solvable (Solvable (con))
+import Grisette.Core.Data.Class.Solver (solve)
 import Grisette.IR.SymPrim.Data.SymPrim
   ( SymBool,
     SymIntN,
@@ -53,54 +56,77 @@
 import Test.Framework.Providers.HUnit (testCase)
 import Test.HUnit (Assertion, assertFailure, (@=?))
 
-testCegis :: (HasCallStack, ExtractSymbolics a, EvaluateSym a, Show a) => GrisetteSMTConfig i -> Bool -> a -> [SymBool] -> Assertion
-testCegis config shouldSuccess a bs = do
-  x <- cegisExceptVC config (a, ssym "internal" :: SymInteger) return (runExceptT $ buildFormula bs)
+testCegis ::
+  (HasCallStack, ExtractSymbolics a, EvaluateSym a, Show a, SEq a) =>
+  GrisetteSMTConfig i ->
+  Bool ->
+  a ->
+  (a -> [SymBool]) ->
+  Assertion
+testCegis config shouldSuccess inputs bs = do
+  x <-
+    cegisExceptVC
+      config
+      (inputs, "internal" :: SymInteger)
+      return
+      ( \(cexInputs, internal) ->
+          runExceptT $ buildFormula internal (bs cexInputs)
+      )
   case x of
-    (_, Left _) -> shouldSuccess @=? False
-    (_, Right m) -> do
+    (_, CEGISSuccess m) -> do
       shouldSuccess @=? True
-      verify bs
+      verify (bs inputs)
       where
         verify [] = return ()
         verify (v : vs) = do
-          y <- solve config (evaluateSym False m $ nots v)
+          y <- solve config (evaluateSym False m $ symNot v)
           case y of
             Left _ -> do
               verify vs
-            Right _ -> assertFailure $ "Failed to verify " ++ show v ++ " with the model " ++ show m
+            Right _ ->
+              assertFailure $
+                "Failed to verify " ++ show v ++ " with the model " ++ show m
+    _ -> shouldSuccess @=? False
   where
-    buildFormula :: [SymBool] -> ExceptT VerificationConditions UnionM ()
-    buildFormula l = do
-      symAssume ((ssym "internal" :: SymInteger) >=~ 0)
+    buildFormula internal l = do
+      symAssume (internal .>= 0)
       go l 0
       where
-        go :: [SymBool] -> SymInteger -> ExceptT VerificationConditions UnionM ()
+        go ::
+          [SymBool] -> SymInteger -> ExceptT VerificationConditions UnionM ()
         go [] _ = return ()
         go (x : xs) i =
           mrgIf
-            (ssym "internal" >=~ i &&~ ssym "internal" <~ (i + 1))
+            (internal .>= i .&& internal .< (i + 1))
             (symAssert x)
             (go xs (i + 1))
 
 cegisTests :: Test
 cegisTests =
-  let unboundedConfig = precise SBV.z3 -- {SBV.verbose=True}
+  let unboundedConfig = precise SBV.z3
    in testGroup
-        "CEGISTests"
+        "CEGIS"
         [ testGroup
             "Regression"
             [ testCase "Empty symbolic inputs makes cegis work like solve" $ do
-                (_, Right m1) <- cegisMultiInputs (precise z3) [1 :: Integer, 2] (\x -> cegisPostCond $ fromString $ "a" ++ show x)
-                Right m2 <- solve (precise z3) (ssym "a1" &&~ ssym "a2")
+                (_, CEGISSuccess m1) <-
+                  cegisMultiInputs
+                    (precise z3)
+                    [1 :: Integer, 2]
+                    (\idx -> cegisPostCond $ fromString $ "a" ++ show idx)
+                Right m2 <- solve (precise z3) ("a1" .&& "a2")
                 m1 @=? m2,
               testCase "Lowering of TabularFun" $ do
                 let s1 = "s1" :: SymInteger =~> SymInteger
                 let s2 = "s2" :: SymInteger =~> SymInteger
-                (_, Right m1) <-
-                  cegis unboundedConfig (ssym "cond" :: SymBool) $
-                    cegisPostCond $
-                      ites "cond" s1 s2 # ites "cond" 1 2 ==~ 10 &&~ ites "cond" s1 s2 # ites "cond" 3 4 ==~ 100
+                (_, CEGISSuccess m1) <-
+                  cegis unboundedConfig ("cond" :: SymBool) $
+                    \cond ->
+                      cegisPostCond $
+                        apply (symIte cond s1 s2) (symIte cond 1 2)
+                          .== 10
+                          .&& apply (symIte cond s1 s2) (symIte cond 3 4)
+                            .== 100
                 let s1e = evaluateSym False m1 s1
                 let s2e = evaluateSym False m1 s2
                 s1e # 1 @=? 10
@@ -110,10 +136,14 @@
               testCase "Lowering of GeneralFun" $ do
                 let s1 = "s1" :: SymInteger -~> SymInteger
                 let s2 = "s2" :: SymInteger -~> SymInteger
-                (_, Right m1) <-
-                  cegis unboundedConfig (ssym "cond" :: SymBool) $
-                    cegisPostCond $
-                      ites "cond" s1 s2 # ites "cond" 1 2 ==~ 10 &&~ ites "cond" s1 s2 # ites "cond" 3 4 ==~ 100
+                (_, CEGISSuccess m1) <-
+                  cegis unboundedConfig ("cond" :: SymBool) $
+                    \cond ->
+                      cegisPostCond $
+                        apply (symIte cond s1 s2) (symIte cond 1 2)
+                          .== 10
+                          .&& apply (symIte cond s1 s2) (symIte cond 3 4)
+                            .== 100
                 let s1e = evaluateSym False m1 s1
                 let s2e = evaluateSym False m1 s2
                 s1e # 1 @=? 10
@@ -124,297 +154,256 @@
           testGroup
             "Boolean"
             [ testCase "Basic" $ do
-                testCegis
-                  unboundedConfig
-                  True
-                  ()
-                  [ssym "a", ssym "b", ssym "c"]
-                testCegis
-                  unboundedConfig
-                  False
-                  ()
-                  [ssym "a", nots $ ssym "a"],
+                testCegis unboundedConfig True () $ const ["a", "b", "c"]
+                testCegis unboundedConfig False () $ const ["a", symNot "a"],
               testCase "And" $ do
-                testCegis
-                  unboundedConfig
-                  True
-                  ()
-                  [ssym "a" &&~ ssym "b", ssym "b" &&~ nots (ssym "c"), ssym "a", ssym "b", nots (ssym "c")]
-                testCegis
-                  unboundedConfig
-                  False
-                  ()
-                  [ssym "a" &&~ ssym "b", ssym "b" &&~ nots (ssym "c"), ssym "a", ssym "b", ssym "c"]
-                testCegis
-                  unboundedConfig
-                  True
-                  (ssym "a" :: SymBool)
-                  [nots $ ssym "a" &&~ ssym "b", nots $ ssym "b"]
-                testCegis
-                  unboundedConfig
-                  False
-                  (ssym "a" :: SymBool)
-                  [nots $ ssym "a" &&~ ssym "b", ssym "b"],
+                testCegis unboundedConfig True () $
+                  const ["a" .&& "b", "b" .&& symNot "c", "a", "b", symNot "c"]
+                testCegis unboundedConfig False () $
+                  const ["a" .&& "b", "b" .&& symNot "c", "a", "b", "c"]
+                testCegis unboundedConfig True ("a" :: SymBool) $
+                  \a -> [symNot $ a .&& "b", symNot "b"]
+                testCegis unboundedConfig False ("a" :: SymBool) $
+                  \a -> [symNot $ a .&& "b", "b"],
               testCase "Or" $ do
-                testCegis
-                  unboundedConfig
-                  True
-                  ()
-                  [ssym "a" ||~ ssym "b", ssym "b" ||~ nots (ssym "c"), ssym "a", ssym "b", nots (ssym "c")]
-                testCegis
-                  unboundedConfig
-                  True
-                  ()
-                  [ssym "a" ||~ ssym "b", ssym "b" ||~ nots (ssym "c"), ssym "a", ssym "b", ssym "c"]
-                testCegis
-                  unboundedConfig
-                  True
-                  (ssym "a" :: SymBool)
-                  [ssym "a" ||~ ssym "b", ssym "b"]
-                testCegis
-                  unboundedConfig
-                  False
-                  (ssym "a" :: SymBool)
-                  [ssym "a" ||~ ssym "b", nots $ ssym "b"],
+                testCegis unboundedConfig True () $
+                  const ["a" .|| "b", "b" .|| symNot "c", "a", "b", symNot "c"]
+                testCegis unboundedConfig True () $
+                  const ["a" .|| "b", "b" .|| symNot "c", "a", "b", "c"]
+                testCegis unboundedConfig True ("a" :: SymBool) $
+                  \a -> [a .|| "b", "b"]
+                testCegis unboundedConfig False ("a" :: SymBool) $
+                  \a -> [a .|| "b", symNot "b"],
               testCase "And / Or should be consistent" $ do
-                testCegis
-                  unboundedConfig
-                  True
-                  ()
-                  [ssym "a" &&~ ssym "b", ssym "a" ||~ ssym "b"]
-                testCegis
-                  unboundedConfig
-                  True
-                  ()
-                  [nots $ ssym "a" &&~ ssym "b", ssym "a" ||~ ssym "b"]
-                testCegis
-                  unboundedConfig
-                  False
-                  ()
-                  [ssym "a" &&~ ssym "b", nots $ ssym "a" ||~ ssym "b"]
-                testCegis
-                  unboundedConfig
-                  True
-                  ()
-                  [nots $ ssym "a" &&~ ssym "b", nots $ ssym "a" ||~ ssym "b"],
+                testCegis unboundedConfig True () $
+                  const ["a" .&& "b", "a" .|| "b"]
+                testCegis unboundedConfig True () $
+                  const [symNot "a" .&& "b", "a" .|| "b"]
+                testCegis unboundedConfig False () $
+                  const ["a" .&& "b", symNot $ "a" .|| "b"]
+                testCegis unboundedConfig True () $
+                  const [symNot $ "a" .&& "b", symNot $ "a" .|| "b"],
               testCase "Eqv" $ do
-                testCegis
-                  unboundedConfig
-                  True
-                  ()
-                  [(ssym "a" :: SymBool) ==~ ssym "b", ssym "a", ssym "b"]
-                testCegis
-                  unboundedConfig
-                  True
-                  ()
-                  [(ssym "a" :: SymBool) ==~ ssym "b", nots $ ssym "a", nots $ ssym "b"]
-                testCegis
-                  unboundedConfig
-                  False
-                  ()
-                  [(ssym "a" :: SymBool) ==~ ssym "b", nots $ ssym "a", ssym "b"]
-                testCegis
-                  unboundedConfig
-                  False
-                  ()
-                  [(ssym "a" :: SymBool) ==~ ssym "b", nots $ ssym "a", ssym "b"]
-                testCegis
-                  unboundedConfig
-                  True
-                  ()
-                  [(ssym "a" :: SymBool) ==~ ssym "b", nots (ssym "a") `xors` ssym "b"]
-                testCegis
-                  unboundedConfig
-                  False
-                  ()
-                  [(ssym "a" :: SymBool) ==~ ssym "b", ssym "a" `xors` ssym "b"],
-              testCase "ites" $ do
-                testCegis
-                  unboundedConfig
-                  True
-                  (ssym "c" :: SymBool)
-                  [ites (ssym "a" :: SymBool) (ssym "b") (ssym "c"), ssym "a", ssym "b"]
-                testCegis
-                  unboundedConfig
-                  False
-                  (ssym "c" :: SymBool)
-                  [ites (ssym "a" :: SymBool) (ssym "b") (ssym "c"), nots $ ssym "a"]
-                testCegis
-                  unboundedConfig
-                  True
-                  (ssym "b" :: SymBool)
-                  [ites (ssym "a" :: SymBool) (ssym "b") (ssym "c"), nots $ ssym "a", ssym "c"]
-                testCegis
-                  unboundedConfig
-                  False
-                  (ssym "b" :: SymBool)
-                  [ites (ssym "a" :: SymBool) (ssym "b") (ssym "c"), ssym "a"]
-                testCegis
-                  unboundedConfig
-                  True
-                  ()
-                  [ites (ssym "a" :: SymBool) (ssym "b") (ssym "c"), ssym "a", ssym "b", ssym "c"]
-                testCegis
-                  unboundedConfig
-                  True
-                  ()
-                  [ites (ssym "a" :: SymBool) (ssym "b") (ssym "c"), ssym "a", ssym "b", nots $ ssym "c"]
-                testCegis
-                  unboundedConfig
-                  True
-                  ()
-                  [ites (ssym "a" :: SymBool) (ssym "b") (ssym "c"), nots $ ssym "a", ssym "b", ssym "c"]
-                testCegis
-                  unboundedConfig
-                  True
-                  ()
-                  [ites (ssym "a" :: SymBool) (ssym "b") (ssym "c"), nots $ ssym "a", nots $ ssym "b", ssym "c"]
-                testCegis
-                  unboundedConfig
-                  False
-                  ()
-                  [ites (ssym "a" :: SymBool) (ssym "b") (ssym "c"), ssym "a", nots $ ssym "b", ssym "c"]
-                testCegis
-                  unboundedConfig
-                  False
-                  ()
-                  [ites (ssym "a" :: SymBool) (ssym "b") (ssym "c"), ssym "a", nots $ ssym "b", nots $ ssym "c"]
-                testCegis
-                  unboundedConfig
-                  False
-                  ()
-                  [ites (ssym "a" :: SymBool) (ssym "b") (ssym "c"), nots $ ssym "a", ssym "b", nots $ ssym "c"]
-                testCegis
-                  unboundedConfig
-                  False
-                  ()
-                  [ites (ssym "a" :: SymBool) (ssym "b") (ssym "c"), nots $ ssym "a", nots $ ssym "b", nots $ ssym "c"]
+                testCegis unboundedConfig True () $
+                  const [("a" :: SymBool) .== "b", "a", "b"]
+                testCegis unboundedConfig True () $
+                  const [("a" :: SymBool) .== "b", symNot "a", symNot "b"]
+                testCegis unboundedConfig False () $
+                  const [("a" :: SymBool) .== "b", symNot "a", "b"]
+                testCegis unboundedConfig False () $
+                  const [("a" :: SymBool) .== "b", symNot "a", "b"]
+                testCegis unboundedConfig True () $
+                  const [("a" :: SymBool) .== "b", symNot "a" `symXor` "b"]
+                testCegis unboundedConfig False () $
+                  const [("a" :: SymBool) .== "b", "a" `symXor` "b"],
+              testCase "symIte" $ do
+                testCegis unboundedConfig True ("c" :: SymBool) $
+                  \c -> [symIte "a" "b" c, "a", "b"]
+                testCegis unboundedConfig False ("c" :: SymBool) $
+                  \c -> [symIte "a" "b" c, symNot "a"]
+                testCegis unboundedConfig True ("b" :: SymBool) $
+                  \b -> [symIte "a" b "c", symNot "a", "c"]
+                testCegis unboundedConfig False ("b" :: SymBool) $
+                  \b -> [symIte "a" b "c", "a"]
+                testCegis unboundedConfig True () $
+                  const [symIte "a" "b" "c", "a", "b", "c"]
+                testCegis unboundedConfig True () $
+                  const [symIte "a" "b" "c", "a", "b", symNot "c"]
+                testCegis unboundedConfig True () $
+                  const [symIte "a" "b" "c", symNot "a", "b", "c"]
+                testCegis unboundedConfig True () $
+                  const [symIte "a" "b" "c", symNot "a", symNot "b", "c"]
+                testCegis unboundedConfig False () $
+                  const [symIte "a" "b" "c", "a", symNot "b", "c"]
+                testCegis unboundedConfig False () $
+                  const [symIte "a" "b" "c", "a", symNot "b", symNot "c"]
+                testCegis unboundedConfig False () $
+                  const [symIte "a" "b" "c", symNot "a", "b", symNot "c"]
+                testCegis unboundedConfig False () $
+                  const [symIte "a" "b" "c", symNot "a", symNot "b", symNot "c"]
             ],
-          let a = ssym "a" :: SymIntN 5
-              b = ssym "b" :: SymIntN 5
-              c = ssym "c" :: SymIntN 5
-              d = ssym "c" :: SymIntN 10
+          let a = "a" :: SymIntN 5
+              b = "b" :: SymIntN 5
+              c = "c" :: SymIntN 5
+              d = "c" :: SymIntN 10
            in testGroup
                 "Different sized BV"
                 [ testGroup
                     "Select"
                     [ testCase "sizedBVSelect" $ do
-                        testCegis
-                          unboundedConfig
-                          True
-                          ()
-                          [sizedBVSelect (Proxy @2) (Proxy @2) a ==~ (con 1 :: SymIntN 2), a ==~ con 0b10101]
-                        testCegis
-                          unboundedConfig
-                          False
-                          ()
-                          [sizedBVSelect (Proxy @2) (Proxy @2) a ==~ (con 1 :: SymIntN 2), a ==~ con 0b10001],
+                        testCegis unboundedConfig True () $
+                          const
+                            [ sizedBVSelect (Proxy @2) (Proxy @2) a
+                                .== (con 1 :: SymIntN 2),
+                              a .== con 0b10101
+                            ]
+                        testCegis unboundedConfig False () $
+                          const
+                            [ sizedBVSelect (Proxy @2) (Proxy @2) a
+                                .== (con 1 :: SymIntN 2),
+                              a .== con 0b10001
+                            ],
                       testCase "sizedBVSelect when lowered twice" $ do
-                        testCegis
-                          unboundedConfig
-                          True
-                          a
-                          [sizedBVSelect (Proxy @2) (Proxy @2) (sizedBVConcat a b) ==~ (con 1 :: SymIntN 2)]
-                        testCegis
-                          unboundedConfig
-                          True
-                          b
-                          [sizedBVSelect (Proxy @7) (Proxy @2) (sizedBVConcat a b) ==~ (con 1 :: SymIntN 2)]
+                        testCegis unboundedConfig True a $
+                          \ca ->
+                            [ sizedBVSelect
+                                (Proxy @2)
+                                (Proxy @2)
+                                (sizedBVConcat ca b)
+                                .== (con 1 :: SymIntN 2)
+                            ]
+                        testCegis unboundedConfig True b $
+                          \cb ->
+                            [ sizedBVSelect
+                                (Proxy @7)
+                                (Proxy @2)
+                                (sizedBVConcat a cb)
+                                .== (con 1 :: SymIntN 2)
+                            ]
                     ],
                   testGroup
                     "Concat"
                     [ testCase "sizedBVConcat" $ do
-                        testCegis
-                          unboundedConfig
-                          True
-                          ()
-                          [sizedBVConcat a b ==~ d, a ==~ con 1, b ==~ con 1, d ==~ con 0b100001]
-                        testCegis
-                          unboundedConfig
-                          False
-                          ()
-                          [sizedBVConcat a b ==~ d, a ==~ con 1, b ==~ con 1, d ==~ con 0b100010],
+                        testCegis unboundedConfig True () $
+                          const
+                            [ sizedBVConcat a b .== d,
+                              a .== con 1,
+                              b .== con 1,
+                              d .== con 0b100001
+                            ]
+                        testCegis unboundedConfig False () $
+                          const
+                            [ sizedBVConcat a b .== d,
+                              a .== con 1,
+                              b .== con 1,
+                              d .== con 0b100010
+                            ],
                       testCase "sizedBVConcat when lowered twice" $ do
-                        testCegis
-                          unboundedConfig
-                          True
-                          (a, c)
-                          [sizedBVConcat c (sizedBVSelect (Proxy @2) (Proxy @2) (sizedBVConcat a b) :: SymIntN 2) ==~ sizedBVConcat c (con 1 :: SymIntN 2)]
-                        testCegis
-                          unboundedConfig
-                          True
-                          (b, c)
-                          [sizedBVConcat c (sizedBVSelect (Proxy @7) (Proxy @2) (sizedBVConcat a b) :: SymIntN 2) ==~ sizedBVConcat c (con 1 :: SymIntN 2)]
+                        testCegis unboundedConfig True (a, c) $
+                          \(ca, cc) ->
+                            [ sizedBVConcat
+                                cc
+                                ( sizedBVSelect
+                                    (Proxy @2)
+                                    (Proxy @2)
+                                    (sizedBVConcat ca b) ::
+                                    SymIntN 2
+                                )
+                                .== sizedBVConcat cc (con 1 :: SymIntN 2)
+                            ]
+                        testCegis unboundedConfig True (b, c) $
+                          \(cb, cc) ->
+                            [ sizedBVConcat
+                                cc
+                                ( sizedBVSelect
+                                    (Proxy @7)
+                                    (Proxy @2)
+                                    (sizedBVConcat a cb) ::
+                                    SymIntN 2
+                                )
+                                .== sizedBVConcat cc (con 1 :: SymIntN 2)
+                            ]
                     ],
                   testGroup
                     "Zext"
                     [ testCase "sizedBVZext" $ do
-                        testCegis
-                          unboundedConfig
-                          True
-                          ()
-                          [sizedBVZext (Proxy @10) a ==~ d, a ==~ con 1, d ==~ (con 1 :: SymIntN 10)]
-                        testCegis
-                          unboundedConfig
-                          True
-                          ()
-                          [sizedBVZext (Proxy @10) a ==~ d, a ==~ con 0b11111, d ==~ (con 0b11111 :: SymIntN 10)]
-                        testCegis
-                          unboundedConfig
-                          False
-                          ()
-                          [sizedBVZext (Proxy @10) a ==~ d, d ==~ (con 0b111111 :: SymIntN 10)]
-                        testCegis
-                          unboundedConfig
-                          False
-                          ()
-                          [sizedBVZext (Proxy @10) a ==~ d, d ==~ (con 0b1111111111 :: SymIntN 10)],
+                        testCegis unboundedConfig True () $
+                          const
+                            [ sizedBVZext (Proxy @10) a .== d,
+                              a .== con 1,
+                              d .== (con 1 :: SymIntN 10)
+                            ]
+                        testCegis unboundedConfig True () $
+                          const
+                            [ sizedBVZext (Proxy @10) a .== d,
+                              a .== con 0b11111,
+                              d .== (con 0b11111 :: SymIntN 10)
+                            ]
+                        testCegis unboundedConfig False () $
+                          const
+                            [ sizedBVZext (Proxy @10) a .== d,
+                              d .== (con 0b111111 :: SymIntN 10)
+                            ]
+                        testCegis unboundedConfig False () $
+                          const
+                            [ sizedBVZext (Proxy @10) a .== d,
+                              d .== (con 0b1111111111 :: SymIntN 10)
+                            ],
                       testCase "sizedBVZext when lowered twice" $ do
-                        testCegis
-                          unboundedConfig
-                          True
-                          a
-                          [sizedBVZext (Proxy @10) (sizedBVSelect (Proxy @2) (Proxy @2) (sizedBVConcat a b) :: SymIntN 2) ==~ (con 1 :: SymIntN 10)]
-                        testCegis
-                          unboundedConfig
-                          True
-                          b
-                          [sizedBVZext (Proxy @10) (sizedBVSelect (Proxy @7) (Proxy @2) (sizedBVConcat a b) :: SymIntN 2) ==~ (con 1 :: SymIntN 10)]
+                        testCegis unboundedConfig True a $
+                          \ca ->
+                            [ sizedBVZext
+                                (Proxy @10)
+                                ( sizedBVSelect
+                                    (Proxy @2)
+                                    (Proxy @2)
+                                    (sizedBVConcat ca b) ::
+                                    SymIntN 2
+                                )
+                                .== (con 1 :: SymIntN 10)
+                            ]
+                        testCegis unboundedConfig True b $
+                          \cb ->
+                            [ sizedBVZext
+                                (Proxy @10)
+                                ( sizedBVSelect
+                                    (Proxy @7)
+                                    (Proxy @2)
+                                    (sizedBVConcat a cb) ::
+                                    SymIntN 2
+                                )
+                                .== (con 1 :: SymIntN 10)
+                            ]
                     ],
                   testGroup
                     "Sext"
                     [ testCase "sizedBVSext" $ do
-                        testCegis
-                          unboundedConfig
-                          True
-                          ()
-                          [sizedBVSext (Proxy @10) a ==~ d, a ==~ con 1, d ==~ (con 1 :: SymIntN 10)]
-                        testCegis
-                          unboundedConfig
-                          True
-                          ()
-                          [sizedBVSext (Proxy @10) a ==~ d, a ==~ con 0b11111, d ==~ (con 0b1111111111 :: SymIntN 10)]
-                        testCegis
-                          unboundedConfig
-                          False
-                          ()
-                          [sizedBVSext (Proxy @10) a ==~ d, d ==~ (con 0b111111 :: SymIntN 10)]
-                        testCegis
-                          unboundedConfig
-                          False
-                          ()
-                          [sizedBVSext (Proxy @10) a ==~ d, d ==~ (con 0b11111 :: SymIntN 10)],
+                        testCegis unboundedConfig True () $
+                          const
+                            [ sizedBVSext (Proxy @10) a .== d,
+                              a .== con 1,
+                              d .== (con 1 :: SymIntN 10)
+                            ]
+                        testCegis unboundedConfig True () $
+                          const
+                            [ sizedBVSext (Proxy @10) a .== d,
+                              a .== con 0b11111,
+                              d .== (con 0b1111111111 :: SymIntN 10)
+                            ]
+                        testCegis unboundedConfig False () $
+                          const
+                            [ sizedBVSext (Proxy @10) a .== d,
+                              d .== (con 0b111111 :: SymIntN 10)
+                            ]
+                        testCegis unboundedConfig False () $
+                          const
+                            [ sizedBVSext (Proxy @10) a .== d,
+                              d .== (con 0b11111 :: SymIntN 10)
+                            ],
                       testCase "sizedBVSext when lowered twice" $ do
-                        testCegis
-                          unboundedConfig
-                          True
-                          a
-                          [sizedBVSext (Proxy @10) (sizedBVSelect (Proxy @2) (Proxy @2) (sizedBVConcat a b) :: SymIntN 2) ==~ (con 1 :: SymIntN 10)]
-                        testCegis
-                          unboundedConfig
-                          True
-                          b
-                          [sizedBVSext (Proxy @10) (sizedBVSelect (Proxy @7) (Proxy @2) (sizedBVConcat a b) :: SymIntN 2) ==~ (con 1 :: SymIntN 10)]
+                        testCegis unboundedConfig True a $ \ca ->
+                          [ sizedBVSext
+                              (Proxy @10)
+                              ( sizedBVSelect
+                                  (Proxy @2)
+                                  (Proxy @2)
+                                  (sizedBVConcat ca b) ::
+                                  SymIntN 2
+                              )
+                              .== (con 1 :: SymIntN 10)
+                          ]
+                        testCegis unboundedConfig True b $
+                          \cb ->
+                            [ sizedBVSext
+                                (Proxy @10)
+                                ( sizedBVSelect
+                                    (Proxy @7)
+                                    (Proxy @2)
+                                    (sizedBVConcat a cb) ::
+                                    SymIntN 2
+                                )
+                                .== (con 1 :: SymIntN 10)
+                            ]
                     ]
                 ]
         ]
diff --git a/test/Grisette/Backend/SBV/Data/SMT/LoweringTests.hs b/test/Grisette/Backend/SBV/Data/SMT/LoweringTests.hs
--- a/test/Grisette/Backend/SBV/Data/SMT/LoweringTests.hs
+++ b/test/Grisette/Backend/SBV/Data/SMT/LoweringTests.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -11,13 +12,14 @@
 
 import Control.Monad.Trans (MonadTrans (lift))
 import Data.Bits
-  ( Bits (complement, rotate, shift, xor, (.&.), (.|.)),
+  ( Bits (complement, xor, (.&.), (.|.)),
   )
 import Data.Dynamic (Typeable, fromDynamic)
 import qualified Data.HashMap.Strict as M
 import Data.Proxy (Proxy (Proxy))
 import qualified Data.SBV as SBV
 import qualified Data.SBV.Control as SBV
+import qualified Data.Text as T
 import GHC.Stack (HasCallStack)
 import Grisette.Backend.SBV.Data.SMT.Lowering (lowerSinglePrim)
 import Grisette.Backend.SBV.Data.SMT.Solving
@@ -35,8 +37,6 @@
     addNumTerm,
     andBitsTerm,
     andTerm,
-    bvToSignedTerm,
-    bvToUnsignedTerm,
     bvconcatTerm,
     bvselectTerm,
     bvsignExtendTerm,
@@ -57,11 +57,15 @@
     quotIntegralTerm,
     remBoundedIntegralTerm,
     remIntegralTerm,
-    rotateBitsTerm,
-    shiftBitsTerm,
+    rotateLeftTerm,
+    rotateRightTerm,
+    shiftLeftTerm,
+    shiftRightTerm,
     signumNumTerm,
     ssymTerm,
     timesNumTerm,
+    toSignedTerm,
+    toUnsignedTerm,
     uminusNumTerm,
     xorBitsTerm,
   )
@@ -231,7 +235,7 @@
   ) =>
   GrisetteSMTConfig n ->
   (Term a -> Term b -> Term c -> Term d) ->
-  String ->
+  T.Text ->
   (TermTy n a -> TermTy n b -> TermTy n c -> TermTy n d) ->
   Assertion
 testTernaryOpLowering config f name sbvfun = do
@@ -250,7 +254,7 @@
         satres <- SBV.checkSat
         case satres of
           SBV.Sat -> return ()
-          _ -> lift $ assertFailure $ "Lowering for " ++ name ++ " generated unsolvable formula"
+          _ -> lift $ assertFailure $ T.unpack $ "Lowering for " <> name <> " generated unsolvable formula"
       _ -> lift $ assertFailure "Failed to extract the term"
   SBV.runSMTWith (sbvConfig config) $ do
     (m, lt) <- lowerSinglePrim config fabc
@@ -271,7 +275,7 @@
                 "Translation counter example found: "
                   ++ show (counterExampleA, counterExampleB, counterExampleC)
           SBV.Unsat -> return ()
-          _ -> lift $ assertFailure $ "Lowering for " ++ name ++ " generated unknown formula"
+          _ -> lift $ assertFailure $ T.unpack $ "Lowering for " <> name <> " generated unknown formula"
       _ -> lift $ assertFailure "Failed to extract the term"
 
 -- testTernaryOpLowering' ::
@@ -303,7 +307,7 @@
   let unboundedConfig = precise SBV.z3
       boundedConfig = approx (Proxy @5) SBV.z3
    in testGroup
-        "LoweringTests"
+        "Lowering"
         [ testGroup
             "Bool Lowering"
             [ testCase "Not" $ do
@@ -575,42 +579,32 @@
                 testBinaryOpLowering @(IntN 5) @(IntN 5) unboundedConfig xorBitsTerm "xor" xor,
               testCase "ComplementBits" $ do
                 testUnaryOpLowering @(IntN 5) unboundedConfig complementBitsTerm "complement" complement,
-              testCase "ShiftBits" $ do
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`shiftBitsTerm` 0) "shift" id
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`shiftBitsTerm` 1) "shift" (`shift` 1)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`shiftBitsTerm` 2) "shift" (`shift` 2)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`shiftBitsTerm` 3) "shift" (`shift` 3)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`shiftBitsTerm` 4) "shift" (`shift` 4)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`shiftBitsTerm` 5) "shift" (`shift` 5)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`shiftBitsTerm` 5) "shift" (const 0)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`shiftBitsTerm` (-1)) "shift" (`shift` (-1))
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`shiftBitsTerm` (-2)) "shift" (`shift` (-2))
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`shiftBitsTerm` (-3)) "shift" (`shift` (-3))
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`shiftBitsTerm` (-4)) "shift" (`shift` (-4))
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`shiftBitsTerm` (-5)) "shift" (`shift` (-5))
-                testUnaryOpLowering @(IntN 5)
+              testCase "ShiftLeft" $ do
+                testBinaryOpLowering @(IntN 5) unboundedConfig shiftLeftTerm "shiftLeft" SBV.sShiftLeft,
+              testCase "ShiftRight" $ do
+                testBinaryOpLowering @(IntN 5) unboundedConfig shiftRightTerm "shiftRight" SBV.sShiftRight,
+              testCase "RotateLeft" $ do
+                testBinaryOpLowering @(IntN 5)
                   unboundedConfig
-                  (`shiftBitsTerm` (-5))
-                  "shift"
-                  (\x -> SBV.ite (x SBV..>= 0) 0 (-1)),
-              testCase "RotateBits" $ do
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` 0) "rotate" id
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` 1) "rotate" (`rotate` 1)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` 2) "rotate" (`rotate` 2)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` 3) "rotate" (`rotate` 3)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` 4) "rotate" (`rotate` 4)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` 5) "rotate" (`rotate` 5)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` 5) "rotate" id
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` (-1)) "rotate" (`rotate` (-1))
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` (-1)) "rotate" (`rotate` 4)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` (-2)) "rotate" (`rotate` (-2))
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` (-2)) "rotate" (`rotate` 3)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` (-3)) "rotate" (`rotate` (-3))
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` (-3)) "rotate" (`rotate` 2)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` (-4)) "rotate" (`rotate` (-4))
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` (-4)) "rotate" (`rotate` 1)
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` (-5)) "rotate" (`rotate` (-5))
-                testUnaryOpLowering @(IntN 5) unboundedConfig (`rotateBitsTerm` (-5)) "rotate" id,
+                  rotateLeftTerm
+                  "rotateLeft"
+                  ( \a b ->
+                      SBV.sFromIntegral $
+                        SBV.sRotateLeft
+                          (SBV.sFromIntegral a :: SBV.SWord 5)
+                          (SBV.sFromIntegral b :: SBV.SWord 5)
+                  ),
+              testCase "RotateRight" $ do
+                testBinaryOpLowering @(IntN 5)
+                  unboundedConfig
+                  rotateRightTerm
+                  "rotateRight"
+                  ( \a b ->
+                      SBV.sFromIntegral $
+                        SBV.sRotateRight
+                          (SBV.sFromIntegral a :: SBV.SWord 5)
+                          (SBV.sFromIntegral b :: SBV.SWord 5)
+                  ),
               testCase "Div - bounded" $ do
                 testBinaryOpLowering @(IntN 5) @(IntN 5) @(IntN 5) unboundedConfig divBoundedIntegralTerm "div" SBV.sDiv
                 testBinaryOpLowering @(IntN 5) @(IntN 5) @(IntN 5) boundedConfig divBoundedIntegralTerm "div" SBV.sDiv,
@@ -624,8 +618,8 @@
                 testBinaryOpLowering @(IntN 5) @(IntN 5) @(IntN 5) unboundedConfig remBoundedIntegralTerm "rem" SBV.sRem
                 testBinaryOpLowering @(IntN 5) @(IntN 5) @(IntN 5) boundedConfig remBoundedIntegralTerm "rem" SBV.sRem,
               testCase "ToUnsigned" $ do
-                testUnaryOpLowering @(IntN 5) @(WordN 5) unboundedConfig bvToUnsignedTerm "toUnsigned" SBV.sFromIntegral
-                testUnaryOpLowering @(IntN 5) @(WordN 5) boundedConfig bvToUnsignedTerm "toUnsigned" SBV.sFromIntegral
+                testUnaryOpLowering @(IntN 5) @(WordN 5) unboundedConfig toUnsignedTerm "toUnsigned" SBV.sFromIntegral
+                testUnaryOpLowering @(IntN 5) @(WordN 5) boundedConfig toUnsignedTerm "toUnsigned" SBV.sFromIntegral
             ],
           testGroup
             "WordN"
@@ -779,42 +773,14 @@
                 testBinaryOpLowering @(WordN 5) @(WordN 5) unboundedConfig xorBitsTerm "xor" xor,
               testCase "ComplementBits" $ do
                 testUnaryOpLowering @(WordN 5) unboundedConfig complementBitsTerm "complement" complement,
-              testCase "ShiftBits" $ do
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`shiftBitsTerm` 0) "shift" id
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`shiftBitsTerm` 1) "shift" (`shift` 1)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`shiftBitsTerm` 2) "shift" (`shift` 2)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`shiftBitsTerm` 3) "shift" (`shift` 3)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`shiftBitsTerm` 4) "shift" (`shift` 4)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`shiftBitsTerm` 5) "shift" (`shift` 5)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`shiftBitsTerm` 5) "shift" (const 0)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`shiftBitsTerm` (-1)) "shift" (`shift` (-1))
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`shiftBitsTerm` (-2)) "shift" (`shift` (-2))
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`shiftBitsTerm` (-3)) "shift" (`shift` (-3))
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`shiftBitsTerm` (-4)) "shift" (`shift` (-4))
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`shiftBitsTerm` (-5)) "shift" (`shift` (-5))
-                testUnaryOpLowering @(WordN 5)
-                  unboundedConfig
-                  (`shiftBitsTerm` (-5))
-                  "shift"
-                  (\x -> SBV.ite (x SBV..>= 0) 0 (-1)),
-              testCase "RotateBits" $ do
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` 0) "rotate" id
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` 1) "rotate" (`rotate` 1)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` 2) "rotate" (`rotate` 2)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` 3) "rotate" (`rotate` 3)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` 4) "rotate" (`rotate` 4)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` 5) "rotate" (`rotate` 5)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` 5) "rotate" id
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` (-1)) "rotate" (`rotate` (-1))
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` (-1)) "rotate" (`rotate` 4)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` (-2)) "rotate" (`rotate` (-2))
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` (-2)) "rotate" (`rotate` 3)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` (-3)) "rotate" (`rotate` (-3))
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` (-3)) "rotate" (`rotate` 2)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` (-4)) "rotate" (`rotate` (-4))
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` (-4)) "rotate" (`rotate` 1)
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` (-5)) "rotate" (`rotate` (-5))
-                testUnaryOpLowering @(WordN 5) unboundedConfig (`rotateBitsTerm` (-5)) "rotate" id,
+              testCase "ShiftLeft" $ do
+                testBinaryOpLowering @(WordN 5) unboundedConfig shiftLeftTerm "shiftLeft" SBV.sShiftLeft,
+              testCase "ShiftRight" $ do
+                testBinaryOpLowering @(WordN 5) unboundedConfig shiftRightTerm "shiftRight" SBV.sShiftRight,
+              testCase "RotateLeft" $ do
+                testBinaryOpLowering @(WordN 5) unboundedConfig rotateLeftTerm "rotateLeft" SBV.sRotateLeft,
+              testCase "RotateRight" $ do
+                testBinaryOpLowering @(WordN 5) unboundedConfig rotateRightTerm "rotateRight" SBV.sRotateRight,
               testCase "Div" $ do
                 testBinaryOpLowering @(WordN 5) @(WordN 5) @(WordN 5) unboundedConfig divIntegralTerm "div" SBV.sDiv
                 testBinaryOpLowering @(WordN 5) @(WordN 5) @(WordN 5) boundedConfig divIntegralTerm "div" SBV.sDiv,
@@ -828,7 +794,7 @@
                 testBinaryOpLowering @(WordN 5) @(WordN 5) @(WordN 5) unboundedConfig remIntegralTerm "rem" SBV.sRem
                 testBinaryOpLowering @(WordN 5) @(WordN 5) @(WordN 5) boundedConfig remIntegralTerm "rem" SBV.sRem,
               testCase "ToSigned" $ do
-                testUnaryOpLowering @(WordN 5) @(IntN 5) unboundedConfig bvToSignedTerm "toSigned" SBV.sFromIntegral
-                testUnaryOpLowering @(WordN 5) @(IntN 5) boundedConfig bvToSignedTerm "toSigned" SBV.sFromIntegral
+                testUnaryOpLowering @(WordN 5) @(IntN 5) unboundedConfig toSignedTerm "toSigned" SBV.sFromIntegral
+                testUnaryOpLowering @(WordN 5) @(IntN 5) boundedConfig toSignedTerm "toSigned" SBV.sFromIntegral
             ]
         ]
diff --git a/test/Grisette/Backend/SBV/Data/SMT/TermRewritingGen.hs b/test/Grisette/Backend/SBV/Data/SMT/TermRewritingGen.hs
--- a/test/Grisette/Backend/SBV/Data/SMT/TermRewritingGen.hs
+++ b/test/Grisette/Backend/SBV/Data/SMT/TermRewritingGen.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BinaryLiterals #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -5,6 +6,7 @@
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -34,19 +36,28 @@
     uminusNumSpec,
     timesNumSpec,
     addNumSpec,
+    absNumSpec,
     iteSpec,
     eqvSpec,
     notSpec,
     andSpec,
     orSpec,
+    shiftLeftSpec,
+    shiftRightSpec,
+    rotateLeftSpec,
+    rotateRightSpec,
+    xorBitsSpec,
   )
 where
 
-import Data.Bits (Bits)
+import Data.Bits (Bits, FiniteBits)
 import Data.Data (Proxy (Proxy), Typeable)
 import Data.Kind (Type)
+import qualified Data.Text as T
 import GHC.TypeLits (KnownNat, Nat, type (+), type (<=))
 import Grisette.Core.Data.Class.BitVector (SizedBV)
+import Grisette.Core.Data.Class.SymRotate (SymRotate)
+import Grisette.Core.Data.Class.SymShift (SymShift)
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.InternedCtors
   ( absNumTerm,
     addNumTerm,
@@ -75,8 +86,10 @@
     quotIntegralTerm,
     remBoundedIntegralTerm,
     remIntegralTerm,
-    rotateBitsTerm,
-    shiftBitsTerm,
+    rotateLeftTerm,
+    rotateRightTerm,
+    shiftLeftTerm,
+    shiftRightTerm,
     signumNumTerm,
     ssymTerm,
     timesNumTerm,
@@ -102,8 +115,10 @@
   ( pevalAndBitsTerm,
     pevalComplementBitsTerm,
     pevalOrBitsTerm,
-    pevalRotateBitsTerm,
-    pevalShiftBitsTerm,
+    pevalRotateLeftTerm,
+    pevalRotateRightTerm,
+    pevalShiftLeftTerm,
+    pevalShiftRightTerm,
     pevalXorBitsTerm,
   )
 import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bool
@@ -141,7 +156,7 @@
   same :: a -> Term Bool
   counterExample :: a -> Term Bool
   counterExample = notTerm . same
-  symSpec :: String -> a
+  symSpec :: T.Text -> a
   symSpec s = wrap (ssymTerm s) (ssymTerm s)
   conSpec :: b -> a
   conSpec v = wrap (conTerm v) (conTerm v)
@@ -282,12 +297,18 @@
 complementBitsSpec :: (TermRewritingSpec a av, Bits av) => a -> a
 complementBitsSpec = constructUnarySpec complementBitsTerm pevalComplementBitsTerm
 
-shiftBitsSpec :: (TermRewritingSpec a av, Bits av) => a -> Int -> a
-shiftBitsSpec a n = constructUnarySpec (`shiftBitsTerm` n) (`pevalShiftBitsTerm` n) a
+shiftLeftSpec :: (TermRewritingSpec a av, Integral av, FiniteBits av, SymShift av) => a -> a -> a
+shiftLeftSpec = constructBinarySpec shiftLeftTerm pevalShiftLeftTerm
 
-rotateBitsSpec :: (TermRewritingSpec a av, Bits av) => a -> Int -> a
-rotateBitsSpec a n = constructUnarySpec (`rotateBitsTerm` n) (`pevalRotateBitsTerm` n) a
+shiftRightSpec :: (TermRewritingSpec a av, Integral av, FiniteBits av, SymShift av) => a -> a -> a
+shiftRightSpec = constructBinarySpec shiftRightTerm pevalShiftRightTerm
 
+rotateLeftSpec :: (TermRewritingSpec a av, Integral av, FiniteBits av, SymRotate av) => a -> a -> a
+rotateLeftSpec = constructBinarySpec rotateLeftTerm pevalRotateLeftTerm
+
+rotateRightSpec :: (TermRewritingSpec a av, Integral av, FiniteBits av, SymRotate av) => a -> a -> a
+rotateRightSpec = constructBinarySpec rotateRightTerm pevalRotateRightTerm
+
 bvconcatSpec ::
   ( TermRewritingSpec a (bv an),
     TermRewritingSpec b (bv bn),
@@ -384,7 +405,7 @@
 boolonly 0 =
   let s =
         oneof $
-          return . symSpec . (++ "bool")
+          return . symSpec . (<> "bool")
             <$> ["a", "b", "c", "d", "e", "f", "g"]
       r = oneof $ return . conSpec <$> [True, False]
    in oneof [r, s]
@@ -431,7 +452,7 @@
 boolWithLIA 0 =
   let s =
         oneof $
-          return . symSpec . (++ "bool")
+          return . symSpec . (<> "bool")
             <$> ["a", "b", "c", "d", "e", "f", "g"]
       r = oneof $ return . conSpec <$> [True, False]
    in oneof [r, s]
@@ -457,7 +478,7 @@
 liaWithBool 0 =
   let s =
         oneof $
-          return . symSpec . (++ "int")
+          return . symSpec . (<> "int")
             <$> ["a", "b", "c", "d", "e", "f", "g"]
       r = conSpec <$> arbitrary
    in oneof [r, s]
@@ -480,43 +501,49 @@
 instance Arbitrary LIAWithBoolSpec where
   arbitrary = sized liaWithBool
 
-data FixedSizedBVWithBoolSpec bv = FixedSizedBVWithBoolSpec (Term (bv 4)) (Term (bv 4))
+data FixedSizedBVWithBoolSpec (bv :: Nat -> Type) (n :: Nat) = FixedSizedBVWithBoolSpec (Term (bv n)) (Term (bv n))
 
-instance (SupportedPrim (bv 4)) => Show (FixedSizedBVWithBoolSpec bv) where
+instance (SupportedPrim (bv n)) => Show (FixedSizedBVWithBoolSpec bv n) where
   show (FixedSizedBVWithBoolSpec n r) = "FixedSizedBVWithBoolSpec { no: " ++ pformat n ++ ", re: " ++ pformat r ++ " }"
 
-instance (SupportedPrim (bv 4)) => TermRewritingSpec (FixedSizedBVWithBoolSpec bv) (bv 4) where
+instance (SupportedPrim (bv n)) => TermRewritingSpec (FixedSizedBVWithBoolSpec bv n) (bv n) where
   norewriteVer (FixedSizedBVWithBoolSpec n _) = n
   rewriteVer (FixedSizedBVWithBoolSpec _ r) = r
   wrap = FixedSizedBVWithBoolSpec
   same s = eqvTerm (norewriteVer s) (rewriteVer s)
 
-data BoolWithFixedSizedBVSpec (bv :: Nat -> Type) = BoolWithFixedSizedBVSpec (Term Bool) (Term Bool)
+data BoolWithFixedSizedBVSpec (bv :: Nat -> Type) (n :: Nat) = BoolWithFixedSizedBVSpec (Term Bool) (Term Bool)
 
-instance Show (BoolWithFixedSizedBVSpec bv) where
+instance Show (BoolWithFixedSizedBVSpec bv n) where
   show (BoolWithFixedSizedBVSpec n r) =
     "BoolWithFixedSizedBVSpec { no: " ++ pformat n ++ ", re: " ++ pformat r ++ " }"
 
-instance TermRewritingSpec (BoolWithFixedSizedBVSpec bv) Bool where
+instance TermRewritingSpec (BoolWithFixedSizedBVSpec bv n) Bool where
   norewriteVer (BoolWithFixedSizedBVSpec n _) = n
   rewriteVer (BoolWithFixedSizedBVSpec _ r) = r
   wrap = BoolWithFixedSizedBVSpec
   same s = eqvTerm (norewriteVer s) (rewriteVer s)
 
-boolWithFSBV :: forall proxy bv. (SupportedPrim (bv 4), Ord (bv 4), Num (bv 4), Bits (bv 4)) => proxy bv -> Int -> Gen (BoolWithFixedSizedBVSpec bv)
-boolWithFSBV _ 0 =
+boolWithFSBV ::
+  forall p1 p2 bv n.
+  (SupportedBV bv n) =>
+  p1 bv ->
+  p2 n ->
+  Int ->
+  Gen (BoolWithFixedSizedBVSpec bv n)
+boolWithFSBV _ _ 0 =
   let s =
         oneof $
-          return . symSpec . (++ "bool")
+          return . symSpec . (<> "bool")
             <$> ["a", "b", "c", "d", "e", "f", "g"]
       r = oneof $ return . conSpec <$> [True, False]
    in oneof [r, s]
-boolWithFSBV p n | n > 0 = do
-  v1 <- boolWithFSBV p (n - 1)
-  v2 <- boolWithFSBV p (n - 1)
-  v3 <- boolWithFSBV p (n - 1)
-  v1i <- fsbvWithBool p (n - 1)
-  v2i <- fsbvWithBool p (n - 1)
+boolWithFSBV pbv pn n | n > 0 = do
+  v1 <- boolWithFSBV pbv pn (n - 1)
+  v2 <- boolWithFSBV pbv pn (n - 1)
+  v3 <- boolWithFSBV pbv pn (n - 1)
+  v1i <- fsbvWithBool pbv pn (n - 1)
+  v2i <- fsbvWithBool pbv pn (n - 1)
   frequency
     [ (1, return $ notSpec v1),
       (1, return $ andSpec v1 v2),
@@ -527,26 +554,32 @@
       (5, return $ leNumSpec v1i v2i),
       (1, return $ iteSpec v1 v2 v3)
     ]
-boolWithFSBV _ _ = error "Should never be called"
+boolWithFSBV _ _ _ = error "Should never be called"
 
 fsbvWithBool ::
-  forall proxy bv.
-  (SupportedPrim (bv 4), Ord (bv 4), Num (bv 4), Bits (bv 4)) =>
-  proxy bv ->
+  forall p1 p2 bv n.
+  (SupportedBV bv n) =>
+  p1 bv ->
+  p2 n ->
   Int ->
-  Gen (FixedSizedBVWithBoolSpec bv)
-fsbvWithBool _ 0 =
+  Gen (FixedSizedBVWithBoolSpec bv n)
+fsbvWithBool _ _ 0 =
   let s =
         oneof $
-          return . symSpec . (++ "int")
+          return . symSpec . (<> "int")
             <$> ["a", "b", "c", "d", "e", "f", "g"]
-      r = conSpec . fromInteger <$> arbitrary
+      r =
+        conSpec
+          <$> oneof
+            [ return minBound,
+              return maxBound,
+              fromInteger <$> arbitrary
+            ]
    in oneof [r, s]
-fsbvWithBool p n | n > 0 = do
-  v1b <- boolWithFSBV p (n - 1)
-  v1i <- fsbvWithBool p (n - 1)
-  v2i <- fsbvWithBool p (n - 1)
-  i <- arbitrary
+fsbvWithBool pbv pn n | n > 0 = do
+  v1b <- boolWithFSBV pbv pn (n - 1)
+  v1i <- fsbvWithBool pbv pn (n - 1)
+  v2i <- fsbvWithBool pbv pn (n - 1)
   oneof
     [ return $ uminusNumSpec v1i,
       return $ absNumSpec v1i,
@@ -557,17 +590,19 @@
       return $ orBitsSpec v1i v2i,
       return $ xorBitsSpec v1i v2i,
       return $ complementBitsSpec v1i,
-      return $ shiftBitsSpec v1i i,
-      return $ rotateBitsSpec v1i i,
+      return $ shiftLeftSpec v1i v2i,
+      return $ rotateLeftSpec v1i v2i,
+      return $ shiftRightSpec v1i v2i,
+      return $ rotateRightSpec v1i v2i,
       return $ iteSpec v1b v1i v2i
     ]
-fsbvWithBool _ _ = error "Should never be called"
+fsbvWithBool _ _ _ = error "Should never be called"
 
-instance (SupportedPrim (bv 4), Ord (bv 4), Num (bv 4), Bits (bv 4)) => Arbitrary (BoolWithFixedSizedBVSpec bv) where
-  arbitrary = sized (boolWithFSBV (Proxy @bv))
+instance (SupportedBV bv n) => Arbitrary (BoolWithFixedSizedBVSpec bv n) where
+  arbitrary = sized (boolWithFSBV (Proxy @bv) (Proxy @n))
 
-instance (SupportedPrim (bv 4), Ord (bv 4), Num (bv 4), Bits (bv 4)) => Arbitrary (FixedSizedBVWithBoolSpec bv) where
-  arbitrary = sized (fsbvWithBool Proxy)
+instance (SupportedBV bv n) => Arbitrary (FixedSizedBVWithBoolSpec bv n) where
+  arbitrary = sized (fsbvWithBool Proxy Proxy)
 
 data DifferentSizeBVSpec bv (n :: Nat) = DifferentSizeBVSpec (Term (bv n)) (Term (bv n))
 
@@ -581,7 +616,15 @@
   same s = eqvTerm (norewriteVer s) (rewriteVer s)
 
 type SupportedBV bv (n :: Nat) =
-  (SupportedPrim (bv n), Ord (bv n), Num (bv n), Bits (bv n))
+  ( SupportedPrim (bv n),
+    Ord (bv n),
+    Num (bv n),
+    FiniteBits (bv n),
+    Integral (bv n),
+    Bounded (bv n),
+    SymShift (bv n),
+    SymRotate (bv n)
+  )
 
 dsbv1 ::
   forall proxy bv.
@@ -599,7 +642,7 @@
 dsbv1 _ 0 =
   let s =
         oneof $
-          return . symSpec . (++ "bv1")
+          return . symSpec . (<> "bv1")
             <$> ["a", "b", "c", "d", "e", "f", "g"]
       r = conSpec . fromInteger <$> arbitrary
    in oneof [r, s]
@@ -609,7 +652,6 @@
   v2 <- dsbv2 p (depth - 1)
   v3 <- dsbv3 p (depth - 1)
   v4 <- dsbv4 p (depth - 1)
-  i <- arbitrary
   oneof
     [ return $ uminusNumSpec v1,
       return $ absNumSpec v1,
@@ -620,8 +662,10 @@
       return $ orBitsSpec v1 v1',
       return $ xorBitsSpec v1 v1',
       return $ complementBitsSpec v1,
-      return $ shiftBitsSpec v1 i,
-      return $ rotateBitsSpec v1 i,
+      return $ shiftLeftSpec v1 v1',
+      return $ rotateLeftSpec v1 v1',
+      return $ shiftRightSpec v1 v1',
+      return $ rotateRightSpec v1 v1',
       return $ bvselectSpec (Proxy @0) (Proxy @1) v4,
       return $ bvselectSpec (Proxy @1) (Proxy @1) v4,
       return $ bvselectSpec (Proxy @2) (Proxy @1) v4,
@@ -651,7 +695,7 @@
 dsbv2 _ 0 =
   let s =
         oneof $
-          return . symSpec . (++ "bv2")
+          return . symSpec . (<> "bv2")
             <$> ["a", "b", "c", "d", "e", "f", "g"]
       r = conSpec . fromInteger <$> arbitrary
    in oneof [r, s]
@@ -662,7 +706,6 @@
   v2' <- dsbv2 p (depth - 1)
   v3 <- dsbv3 p (depth - 1)
   v4 <- dsbv4 p (depth - 1)
-  i <- arbitrary
   oneof
     [ return $ uminusNumSpec v2,
       return $ absNumSpec v2,
@@ -673,8 +716,10 @@
       return $ orBitsSpec v2 v2',
       return $ xorBitsSpec v2 v2',
       return $ complementBitsSpec v2,
-      return $ shiftBitsSpec v2 i,
-      return $ rotateBitsSpec v2 i,
+      return $ shiftLeftSpec v2 v2',
+      return $ rotateLeftSpec v2 v2',
+      return $ shiftRightSpec v2 v2',
+      return $ rotateRightSpec v2 v2',
       return $ bvselectSpec (Proxy @0) (Proxy @2) v4,
       return $ bvselectSpec (Proxy @1) (Proxy @2) v4,
       return $ bvselectSpec (Proxy @2) (Proxy @2) v4,
@@ -703,7 +748,7 @@
 dsbv3 _ 0 =
   let s =
         oneof $
-          return . symSpec . (++ "bv3")
+          return . symSpec . (<> "bv3")
             <$> ["a", "b", "c", "d", "e", "f", "g"]
       r = conSpec . fromInteger <$> arbitrary
    in oneof [r, s]
@@ -713,7 +758,6 @@
   v3 <- dsbv3 p (depth - 1)
   v3' <- dsbv3 p (depth - 1)
   v4 <- dsbv4 p (depth - 1)
-  i <- arbitrary
   oneof
     [ return $ uminusNumSpec v3,
       return $ absNumSpec v3,
@@ -724,8 +768,10 @@
       return $ orBitsSpec v3 v3',
       return $ xorBitsSpec v3 v3',
       return $ complementBitsSpec v3,
-      return $ shiftBitsSpec v3 i,
-      return $ rotateBitsSpec v3 i,
+      return $ shiftLeftSpec v3 v3',
+      return $ rotateLeftSpec v3 v3',
+      return $ shiftRightSpec v3 v3',
+      return $ rotateRightSpec v3 v3',
       return $ bvselectSpec (Proxy @0) (Proxy @3) v4,
       return $ bvselectSpec (Proxy @1) (Proxy @3) v4,
       return $ bvselectSpec (Proxy @0) (Proxy @3) v3,
@@ -754,7 +800,7 @@
 dsbv4 _ 0 =
   let s =
         oneof $
-          return . symSpec . (++ "bv4")
+          return . symSpec . (<> "bv4")
             <$> ["a", "b", "c", "d", "e", "f", "g"]
       r = conSpec . fromInteger <$> arbitrary
    in oneof [r, s]
@@ -765,7 +811,6 @@
   v3 <- dsbv3 p (depth - 1)
   v4 <- dsbv4 p (depth - 1)
   v4' <- dsbv4 p (depth - 1)
-  i <- arbitrary
   oneof
     [ return $ uminusNumSpec v4,
       return $ absNumSpec v4,
@@ -776,8 +821,10 @@
       return $ orBitsSpec v4 v4',
       return $ xorBitsSpec v4 v4',
       return $ complementBitsSpec v4,
-      return $ shiftBitsSpec v4 i,
-      return $ rotateBitsSpec v4 i,
+      return $ shiftLeftSpec v4 v4',
+      return $ rotateLeftSpec v4 v4',
+      return $ shiftRightSpec v4 v4',
+      return $ rotateRightSpec v4 v4',
       return $ bvselectSpec (Proxy @0) (Proxy @4) v4,
       return $ bvconcatSpec v1 v3,
       return $ bvconcatSpec v2 v2',
diff --git a/test/Grisette/Backend/SBV/Data/SMT/TermRewritingTests.hs b/test/Grisette/Backend/SBV/Data/SMT/TermRewritingTests.hs
--- a/test/Grisette/Backend/SBV/Data/SMT/TermRewritingTests.hs
+++ b/test/Grisette/Backend/SBV/Data/SMT/TermRewritingTests.hs
@@ -1,11 +1,13 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Grisette.Backend.SBV.Data.SMT.TermRewritingTests
   ( termRewritingTests,
+    validateSpec,
   )
 where
 
@@ -30,6 +32,7 @@
         same,
         symSpec
       ),
+    absNumSpec,
     addNumSpec,
     andSpec,
     divBoundedIntegralSpec,
@@ -44,11 +47,12 @@
     quotIntegralSpec,
     remBoundedIntegralSpec,
     remIntegralSpec,
+    shiftRightSpec,
     timesNumSpec,
     uminusNumSpec,
   )
 import Grisette.Core.Data.BV (IntN, WordN)
-import Grisette.Core.Data.Class.Solver (Solver (solve))
+import Grisette.Core.Data.Class.Solver (solve)
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term
   ( SupportedPrim,
   )
@@ -60,7 +64,7 @@
 import Test.Framework.Providers.HUnit (testCase)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Test.HUnit (Assertion, assertFailure)
-import Test.QuickCheck (ioProperty, mapSize)
+import Test.QuickCheck (ioProperty, mapSize, withMaxSuccess)
 
 validateSpec :: (TermRewritingSpec a av, Show a, SupportedPrim av) => GrisetteSMTConfig n -> a -> Assertion
 validateSpec config a = do
@@ -103,7 +107,7 @@
 termRewritingTests :: Test
 termRewritingTests =
   testGroup
-    "TermRewritingTests"
+    "TermRewriting"
     [ testGroup
         "Bool only"
         [ testProperty "Bool only random test" $
@@ -156,18 +160,98 @@
               )
         ],
       testGroup
-        "Different sized SignedBV"
-        [ testProperty "Fixed Sized SignedBV random test" $
-            mapSize (`min` 10) $
+        "Different sized signed BV"
+        [ testProperty "Random test" $
+            withMaxSuccess 1000 . mapSize (`min` 5) $
               ioProperty . \(x :: (DifferentSizeBVSpec IntN 4)) -> do
                 validateSpec unboundedConfig x
         ],
       testGroup
-        "Fixed sized SignedBV"
-        [ testProperty "Fixed Sized SignedBV random test" $
-            mapSize (`min` 10) $
-              ioProperty . \(x :: (FixedSizedBVWithBoolSpec IntN)) -> do
+        "Fixed sized signed BV"
+        [ testProperty "Random test on IntN 1" $
+            withMaxSuccess 200 . mapSize (`min` 5) $
+              ioProperty . \(x :: (FixedSizedBVWithBoolSpec IntN 1)) -> do
+                validateSpec unboundedConfig x,
+          testProperty "Random test on IntN 2" $
+            withMaxSuccess 200 . mapSize (`min` 5) $
+              ioProperty . \(x :: (FixedSizedBVWithBoolSpec IntN 2)) -> do
+                validateSpec unboundedConfig x,
+          testProperty "Random test on IntN 4" $
+            withMaxSuccess 200 . mapSize (`min` 5) $
+              ioProperty . \(x :: (FixedSizedBVWithBoolSpec IntN 4)) -> do
+                validateSpec unboundedConfig x,
+          testProperty "Random test on IntN 63" $
+            withMaxSuccess 200 . mapSize (`min` 1) $
+              ioProperty . \(x :: (FixedSizedBVWithBoolSpec IntN 63)) -> do
+                validateSpec unboundedConfig x,
+          testProperty "Random test on IntN 64" $
+            withMaxSuccess 200 . mapSize (`min` 1) $
+              ioProperty . \(x :: (FixedSizedBVWithBoolSpec IntN 64)) -> do
+                validateSpec unboundedConfig x,
+          testProperty "Random test on IntN 65" $
+            withMaxSuccess 200 . mapSize (`min` 1) $
+              ioProperty . \(x :: (FixedSizedBVWithBoolSpec IntN 65)) -> do
+                validateSpec unboundedConfig x,
+          testProperty "Random test on IntN 128" $
+            withMaxSuccess 200 . mapSize (`min` 1) $
+              ioProperty . \(x :: (FixedSizedBVWithBoolSpec IntN 128)) -> do
                 validateSpec unboundedConfig x
+        ],
+      testGroup
+        "Different sized unsigned BV"
+        [ testProperty "random test" $
+            withMaxSuccess 1000 . mapSize (`min` 5) $
+              ioProperty . \(x :: (DifferentSizeBVSpec WordN 4)) -> do
+                validateSpec unboundedConfig x
+        ],
+      testGroup
+        "Fixed sized unsigned BV"
+        [ testProperty "Random test on WordN 1" $
+            withMaxSuccess 200 . mapSize (`min` 5) $
+              ioProperty . \(x :: (FixedSizedBVWithBoolSpec WordN 1)) -> do
+                validateSpec unboundedConfig x,
+          testProperty "Random test on WordN 2" $
+            withMaxSuccess 200 . mapSize (`min` 5) $
+              ioProperty . \(x :: (FixedSizedBVWithBoolSpec WordN 2)) -> do
+                validateSpec unboundedConfig x,
+          testProperty "Random test on WordN 4" $
+            withMaxSuccess 200 . mapSize (`min` 5) $
+              ioProperty . \(x :: (FixedSizedBVWithBoolSpec WordN 4)) -> do
+                validateSpec unboundedConfig x,
+          testProperty "Random test on WordN 63" $
+            withMaxSuccess 200 . mapSize (`min` 1) $
+              ioProperty . \(x :: (FixedSizedBVWithBoolSpec WordN 63)) -> do
+                validateSpec unboundedConfig x,
+          testProperty "Random test on WordN 64" $
+            withMaxSuccess 200 . mapSize (`min` 1) $
+              ioProperty . \(x :: (FixedSizedBVWithBoolSpec WordN 64)) -> do
+                validateSpec unboundedConfig x,
+          testProperty "Random test on WordN 65" $
+            withMaxSuccess 200 . mapSize (`min` 1) $
+              ioProperty . \(x :: (FixedSizedBVWithBoolSpec WordN 65)) -> do
+                validateSpec unboundedConfig x,
+          testProperty "Random test on WordN 128" $
+            withMaxSuccess 200 . mapSize (`min` 1) $
+              ioProperty . \(x :: (FixedSizedBVWithBoolSpec WordN 128)) -> do
+                validateSpec unboundedConfig x
+        ],
+      testCase "Regression: shift twice and the sum of shift amount overflows" $ do
+        validateSpec @(FixedSizedBVWithBoolSpec IntN 4)
+          unboundedConfig
+          ( shiftRightSpec
+              (shiftRightSpec (symSpec "fint") (conSpec 0x5))
+              (conSpec 0x5)
+          ),
+      testGroup
+        "Regression for abs on unsigned BV"
+        [ testCase "abs on negate" $
+            validateSpec @(FixedSizedBVWithBoolSpec WordN 4)
+              unboundedConfig
+              (absNumSpec (uminusNumSpec (symSpec "a"))),
+          testCase "abs on times negate" $
+            validateSpec @(FixedSizedBVWithBoolSpec WordN 4)
+              unboundedConfig
+              (absNumSpec (timesNumSpec (symSpec "a") (uminusNumSpec (symSpec "b"))))
         ],
       testGroup
         "timesNumSpec on integer"
diff --git a/test/Grisette/Core/Control/ExceptionTests.hs b/test/Grisette/Core/Control/ExceptionTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Control/ExceptionTests.hs
@@ -0,0 +1,168 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+module Grisette.Core.Control.ExceptionTests (exceptionTests) where
+
+import Control.Exception
+  ( ArrayException (IndexOutOfBounds, UndefinedElement),
+  )
+import Control.Monad.Except (ExceptT (ExceptT))
+import Grisette.Core.Control.Exception
+  ( AssertionError (AssertionError),
+    VerificationConditions (AssertionViolation, AssumptionViolation),
+  )
+import Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Data.Class.Error
+  ( TransformError (transformError),
+    symAssert,
+  )
+import Grisette.Core.Data.Class.EvaluateSym
+  ( EvaluateSym (evaluateSym),
+  )
+import Grisette.Core.Data.Class.ExtractSymbolics
+  ( ExtractSymbolics (extractSymbolics),
+  )
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot))
+import Grisette.Core.Data.Class.Mergeable
+  ( Mergeable (rootStrategy),
+    MergingStrategy (SimpleStrategy),
+  )
+import Grisette.Core.Data.Class.ModelOps
+  ( ModelOps (emptyModel),
+    SymbolSetOps (emptySet),
+  )
+import Grisette.Core.Data.Class.SEq (SEq ((.==)))
+import Grisette.Core.Data.Class.SOrd
+  ( SOrd (symCompare, (.<), (.<=), (.>), (.>=)),
+  )
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( SimpleMergeable (mrgIte),
+    mrgIf,
+    mrgSingle,
+  )
+import Grisette.Core.Data.Class.Solvable (Solvable (con))
+import Grisette.Core.Data.Class.ToCon (ToCon (toCon))
+import Grisette.Core.Data.Class.ToSym (ToSym (toSym))
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit ((@?=))
+
+exceptionTests :: Test
+exceptionTests =
+  testGroup
+    "Exception"
+    [ testGroup
+        "AssertionError"
+        [ testCase "ToCon" $ do
+            toCon AssertionError @?= Just AssertionError,
+          testCase "ToSym" $ do
+            toSym AssertionError @?= AssertionError,
+          testCase "SEq" $ do
+            AssertionError .== AssertionError @?= con True,
+          testCase "SOrd" $ do
+            AssertionError .<= AssertionError @?= con True
+            AssertionError .< AssertionError @?= con False
+            AssertionError .>= AssertionError @?= con True
+            AssertionError .> AssertionError @?= con False
+            AssertionError
+              `symCompare` AssertionError
+              @?= (mrgSingle EQ :: UnionM Ordering),
+          testCase "GEvaluateSym" $ do
+            evaluateSym False emptyModel AssertionError @?= AssertionError,
+          testCase "GExtractSymbolics" $ do
+            extractSymbolics AssertionError @?= emptySet,
+          testCase "SimpleMergeable" $ do
+            mrgIte "a" AssertionError AssertionError @?= AssertionError,
+          testCase "Mergeable" $ do
+            let SimpleStrategy s =
+                  rootStrategy ::
+                    MergingStrategy AssertionError
+            s "a" AssertionError AssertionError @?= AssertionError,
+          testCase "Transform AssertionError to VerificationConditions" $ do
+            transformError AssertionError @?= AssertionViolation,
+          testCase "Transform AssertionError to AssertionError" $ do
+            transformError AssertionError @?= AssertionError,
+          testCase "Transform ArrayException to AssertionError" $ do
+            transformError (IndexOutOfBounds "") @?= AssertionError,
+          testCase "Transform ArrayException to AssertionError" $ do
+            transformError (UndefinedElement "") @?= AssertionError
+        ],
+      testGroup
+        "VerificationConditions"
+        [ testCase "ToCon" $ do
+            toCon AssertionViolation @?= Just AssertionViolation
+            toCon AssumptionViolation @?= Just AssumptionViolation,
+          testCase "ToSym" $ do
+            toSym AssertionViolation @?= AssertionViolation
+            toSym AssumptionViolation @?= AssumptionViolation,
+          testCase "SEq" $ do
+            AssertionViolation .== AssertionViolation @?= con True
+            AssertionViolation .== AssumptionViolation @?= con False
+            AssumptionViolation .== AssertionViolation @?= con False
+            AssumptionViolation .== AssumptionViolation @?= con True,
+          testCase "SOrd" $ do
+            AssertionViolation .<= AssertionViolation @?= con True
+            AssertionViolation .< AssertionViolation @?= con False
+            AssertionViolation .>= AssertionViolation @?= con True
+            AssertionViolation .> AssertionViolation @?= con False
+            AssertionViolation
+              `symCompare` AssertionViolation
+              @?= (mrgSingle EQ :: UnionM Ordering)
+
+            AssertionViolation .<= AssumptionViolation @?= con True
+            AssertionViolation .< AssumptionViolation @?= con True
+            AssertionViolation .>= AssumptionViolation @?= con False
+            AssertionViolation .> AssumptionViolation @?= con False
+            AssertionViolation
+              `symCompare` AssumptionViolation
+              @?= (mrgSingle LT :: UnionM Ordering)
+
+            AssumptionViolation .<= AssertionViolation @?= con False
+            AssumptionViolation .< AssertionViolation @?= con False
+            AssumptionViolation .>= AssertionViolation @?= con True
+            AssumptionViolation .> AssertionViolation @?= con True
+            AssumptionViolation
+              `symCompare` AssertionViolation
+              @?= (mrgSingle GT :: UnionM Ordering)
+
+            AssumptionViolation .<= AssumptionViolation @?= con True
+            AssumptionViolation .< AssumptionViolation @?= con False
+            AssumptionViolation .>= AssumptionViolation @?= con True
+            AssumptionViolation .> AssumptionViolation @?= con False
+            AssumptionViolation
+              `symCompare` AssumptionViolation
+              @?= (mrgSingle EQ :: UnionM Ordering),
+          testCase "GEvaluateSym" $ do
+            evaluateSym False emptyModel AssertionViolation
+              @?= AssertionViolation
+            evaluateSym False emptyModel AssumptionViolation
+              @?= AssumptionViolation,
+          testCase "GExtractSymbolics" $ do
+            extractSymbolics AssertionViolation @?= emptySet
+            extractSymbolics AssumptionViolation @?= emptySet,
+          testCase "Mergeable" $ do
+            mrgIf
+              "a"
+              (mrgSingle AssumptionViolation)
+              (mrgSingle AssertionViolation)
+              @?= ( mrgIf
+                      (symNot "a")
+                      (mrgSingle AssertionViolation)
+                      (mrgSingle AssumptionViolation) ::
+                      UnionM VerificationConditions
+                  ),
+          testCase
+            "Transform VerificationConditions to VerificationConditions"
+            $ do
+              transformError AssertionViolation @?= AssertionViolation
+              transformError AssumptionViolation @?= AssumptionViolation
+        ],
+      testCase "symAssert" $ do
+        (symAssert "a" :: ExceptT VerificationConditions UnionM ())
+          @?= ExceptT
+            ( mrgIf
+                (symNot "a")
+                (mrgSingle $ Left AssertionViolation)
+                (mrgSingle $ Right ())
+            )
+    ]
diff --git a/test/Grisette/Core/Control/Monad/UnionMTests.hs b/test/Grisette/Core/Control/Monad/UnionMTests.hs
--- a/test/Grisette/Core/Control/Monad/UnionMTests.hs
+++ b/test/Grisette/Core/Control/Monad/UnionMTests.hs
@@ -1,24 +1,832 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Grisette.Core.Control.Monad.UnionMTests (unionMTests) where
 
-import Grisette.Core.Control.Monad.UnionM (UnionM, unionSize)
-import Grisette.Core.Data.Class.GenSym (choose)
+import qualified Data.ByteString as B
+import qualified Data.HashMap.Lazy as ML
+import Grisette.Core.BuiltinUnionWrappers (mrgLeft, mrgRight)
+import Grisette.Core.Control.Monad.UnionM
+  ( UnionM,
+    isMerged,
+    underlyingUnion,
+    unionSize,
+  )
+import Grisette.Core.Data.Class.EvaluateSym
+  ( EvaluateSym (evaluateSym),
+  )
+import Grisette.Core.Data.Class.ExtractSymbolics
+  ( ExtractSymbolics (extractSymbolics),
+  )
+import Grisette.Core.Data.Class.Function (Function ((#)))
+import Grisette.Core.Data.Class.GenSym
+  ( ListSpec (ListSpec),
+    choose,
+    genSym,
+    genSymSimple,
+  )
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.LogicalOp
+  ( LogicalOp (symImplies, symNot, symXor, (.&&), (.||)),
+  )
+import Grisette.Core.Data.Class.ModelOps
+  ( ModelOps (emptyModel),
+    ModelRep (buildModel),
+    SymbolSetRep (buildSymbolSet),
+  )
+import Grisette.Core.Data.Class.SEq (SEq ((.==)))
+import Grisette.Core.Data.Class.SOrd
+  ( SOrd (symCompare, (.<), (.<=), (.>), (.>=)),
+  )
 import Grisette.Core.Data.Class.SimpleMergeable
-  ( UnionLike (single),
+  ( SimpleMergeable (mrgIte),
+    UnionLike (single, unionIf),
+    UnionPrjOp (ifView, leftMost, singleView, toGuardedList),
+    merge,
     mrgIf,
+    mrgIte1,
+    mrgSingle,
+    (.#),
+    pattern If,
+    pattern Single,
   )
-import Grisette.Core.Data.Class.Solvable (Solvable (ssym))
+import Grisette.Core.Data.Class.Solvable (Solvable (con, conView, isym, ssym))
+import Grisette.Core.Data.Class.SubstituteSym (SubstituteSym (substituteSym))
+import Grisette.Core.Data.Class.ToCon (ToCon (toCon))
+import Grisette.Core.Data.Class.ToSym (ToSym (toSym))
+import Grisette.Core.Data.Union (Union (UnionIf, UnionSingle))
+import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term (TypedSymbol)
+import Grisette.IR.SymPrim.Data.Prim.Model
+  ( ModelValuePair ((::=)),
+  )
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Grisette.TestUtil.SymbolicAssertion ((@?=~))
 import Test.Framework (Test, testGroup)
 import Test.Framework.Providers.HUnit (testCase)
-import Test.HUnit ((@=?))
+import Test.HUnit (assertFailure, (@?=))
 
 unionMTests :: Test
 unionMTests =
   testGroup
-    "UnionMTests"
-    [ testCase "unionSize" $ do
-        unionSize (single 1 :: UnionM Integer) @=? 1
-        unionSize (mrgIf (ssym "a") (single 1) (single 2) :: UnionM Integer) @=? 2
-        unionSize (choose [1, 2, 3, 4, 5, 6, 7] "a" :: UnionM Integer) @=? 7
+    "UnionM"
+    [ testCase "Mergeable" $
+        do
+          let r =
+                ( mrgIf
+                    "a"
+                    ( mrgSingle
+                        ( mrgIf
+                            "b"
+                            (mrgSingle $ Left "c")
+                            (mrgSingle $ Right "d")
+                        )
+                    )
+                    ( mrgSingle
+                        ( mrgIf
+                            "e"
+                            (mrgSingle $ Left "f")
+                            (mrgSingle $ Right "g")
+                        )
+                    ) ::
+                    UnionM (UnionM (Either SymBool SymBool))
+                )
+          isMerged r @?= True
+          underlyingUnion (underlyingUnion <$> r)
+            @?= UnionSingle
+              ( UnionIf
+                  (Left $ symIte "a" "c" "f")
+                  True
+                  (symIte "a" "b" "e")
+                  (UnionSingle $ Left $ symIte "a" "c" "f")
+                  (UnionSingle $ Right $ symIte "a" "d" "g")
+              ),
+      testCase "SimpleMergeable" $ do
+        let l :: UnionM (Either SymBool SymBool) =
+              mrgIf "b" (mrgSingle $ Left "c") (mrgSingle $ Right "d")
+        let r = mrgIf "e" (mrgSingle $ Left "f") (mrgSingle $ Right "g")
+        let res = mrgIte "a" l r
+        let ref =
+              UnionIf
+                (Left $ symIte "a" "c" "f")
+                True
+                (symIte "a" "b" "e")
+                (UnionSingle $ Left $ symIte "a" "c" "f")
+                (UnionSingle $ Right $ symIte "a" "d" "g")
+        isMerged res @?= True
+        underlyingUnion res @?= ref,
+      testCase "SimpleMergeable1" $ do
+        let l :: UnionM SymBool = mrgIf "b" (mrgSingle "c") (mrgSingle "d")
+        let r :: UnionM SymBool = mrgIf "e" (mrgSingle "f") (mrgSingle "g")
+        let res = mrgIte1 "a" l r
+        isMerged res @?= True
+        underlyingUnion res
+          @?= UnionSingle
+            ( symIte
+                "a"
+                (symIte "b" "c" "d")
+                (symIte "e" "f" "g")
+            ),
+      testGroup
+        "Functor"
+        [ testCase "fmap should work but would strip mergeable knowledge" $ do
+            let x :: UnionM Integer =
+                  (+ 1) <$> mrgIf "a" (mrgSingle 1) (mrgSingle 2)
+            x @?= unionIf "a" (return 2) (return 3)
+        ],
+      testGroup
+        "Applicative"
+        [ testCase "pure should work but won't give us mergeable knowledge" $
+            (pure 1 :: UnionM Integer) @?= single 1,
+          testCase "<*> should work but won't give us mergeable knowledge" $ do
+            let f :: UnionM (Integer -> Integer) =
+                  mrgIf "a" (mrgSingle id) (mrgSingle (+ 1))
+            let v :: UnionM Integer = mrgIf "b" (mrgSingle 1) (mrgSingle 3)
+            f
+              <*> v
+              @?= unionIf
+                "a"
+                (unionIf "b" (single 1) (single 3))
+                (unionIf "b" (single 2) (single 4))
+        ],
+      testGroup
+        "Monad"
+        [ testCase "return should work but won't give us mergeable knowledge" $
+            (pure 1 :: UnionM Integer) @?= single 1,
+          testCase ">>= should work and keeps mergeable knowledge" $ do
+            let v :: UnionM Integer = mrgIf "a" (mrgSingle 0) (mrgSingle 1)
+            let f :: Integer -> UnionM Integer = \i ->
+                  mrgIf "b" (mrgSingle $ i + 1) (mrgSingle $ i + 3)
+            (v >>= f)
+              @?= mrgIf
+                "a"
+                (mrgIf "b" (mrgSingle 1) (mrgSingle 3))
+                (mrgIf "b" (mrgSingle 2) (mrgSingle 4))
+        ],
+      testGroup
+        "UnionOp"
+        [ testCase "single" $ do
+            let r1 :: UnionM SymBool = single "a"
+            isMerged r1 @?= False
+            underlyingUnion r1 @?= UnionSingle "a",
+          testGroup
+            "unionIf"
+            [ testCase "unionIf should work when no merged" $ do
+                let r1 :: UnionM SymBool = unionIf "a" (single "b") (single "c")
+                isMerged r1 @?= False
+                underlyingUnion r1
+                  @?= UnionIf "b" False "a" (UnionSingle "b") (UnionSingle "c"),
+              testCase
+                "unionIf should propagate and merge the results when some branch merged"
+                $ do
+                  let r1 :: UnionM SymBool =
+                        unionIf "a" (mrgSingle "b") (single "c")
+                  isMerged r1 @?= True
+                  underlyingUnion r1 @?= UnionSingle (symIte "a" "b" "c")
+                  let r2 :: UnionM SymBool =
+                        unionIf "a" (single "b") (mrgSingle "c")
+                  isMerged r2 @?= True
+                  underlyingUnion r2 @?= UnionSingle (symIte "a" "b" "c")
+                  let r3 :: UnionM SymBool =
+                        unionIf "a" (mrgSingle "b") (mrgSingle "c")
+                  isMerged r3 @?= True
+                  underlyingUnion r3 @?= UnionSingle (symIte "a" "b" "c")
+            ],
+          testCase "singleView should work" $ do
+            singleView (single "a" :: UnionM SymBool) @?= Just "a"
+            singleView (mrgSingle "a" :: UnionM SymBool) @?= Just "a"
+            singleView
+              ( unionIf "a" (single $ Left "b") (single $ Right "c") ::
+                  UnionM (Either SymBool SymBool)
+              )
+              @?= Nothing
+            case (single "a" :: UnionM SymBool) of
+              Single r -> r @?= "a"
+              _ -> assertFailure "Single match failed"
+            case (mrgSingle "a" :: UnionM SymBool) of
+              Single r -> r @?= "a"
+              _ -> assertFailure "Single match failed"
+            case ( unionIf "a" (single $ Left "b") (single $ Right "c") ::
+                     UnionM (Either SymBool SymBool)
+                 ) of
+              Single _ -> assertFailure "Single match failed"
+              _ -> return (),
+          testCase "ifView should work" $ do
+            let r1 :: UnionM (Either SymBool SymBool) =
+                  unionIf "a" (single $ Left "b") (single $ Right "c")
+            let r2 :: UnionM (Either SymBool SymBool) =
+                  mrgIf "a" (mrgSingle $ Left "b") (mrgSingle $ Right "c")
+            ifView r1 @?= Just ("a", single $ Left "b", single $ Right "c")
+            ifView r2
+              @?= Just ("a", mrgSingle $ Left "b", mrgSingle $ Right "c")
+            ifView (single "a" :: UnionM SymBool) @?= Nothing
+            case r1 of
+              If c l r -> do
+                c @?= "a"
+                l @?= single (Left "b")
+                r @?= single (Right "c")
+              _ -> assertFailure "Single match failed"
+            case r2 of
+              If c l r -> do
+                c @?= "a"
+                l @?= mrgSingle (Left "b")
+                r @?= mrgSingle (Right "c")
+              _ -> assertFailure "Single match failed"
+            case single "a" :: UnionM SymBool of
+              If {} -> assertFailure "Single match failed"
+              _ -> return (),
+          testCase "leftMost should work" $ do
+            leftMost (single "a" :: UnionM SymBool) @?= "a"
+            leftMost (mrgSingle "a" :: UnionM SymBool) @?= "a"
+            let r1 :: UnionM (Either SymBool SymBool) =
+                  unionIf "a" (single $ Left "b") (single $ Right "c")
+            let r2 :: UnionM (Either SymBool SymBool) =
+                  mrgIf "a" (mrgSingle $ Left "b") (mrgSingle $ Right "c")
+            leftMost r1 @?= Left "b"
+            leftMost r2 @?= Left "b",
+          testCase "toGuardedList should work" $ do
+            let actual =
+                  toGuardedList
+                    ( mrgIf "a" (single 1) (mrgIf "b" (single 2) (single 3)) ::
+                        UnionM Integer
+                    )
+            let expected =
+                  [ ("a", 1),
+                    (symNot "a" .&& "b", 2),
+                    (symNot "a" .&& symNot "b", 3)
+                  ]
+            actual @?=~ expected
+        ],
+      testGroup
+        "MonadUnion"
+        [ testCase "merge should work" $ do
+            let r1 :: UnionM SymBool =
+                  merge (unionIf "a" (single "b") (single "c"))
+            isMerged r1 @?= True
+            underlyingUnion r1 @?= UnionSingle (symIte "a" "b" "c"),
+          testCase "mrgSingle should work" $ do
+            let r1 :: UnionM SymBool = mrgSingle "a"
+            isMerged r1 @?= True
+            underlyingUnion r1 @?= UnionSingle "a",
+          testGroup
+            "mrgIf should work"
+            [ testCase "mrgIf should perform lazy evaluation" $ do
+                (mrgIf (con True) (mrgSingle "a") undefined :: UnionM SymBool)
+                  @?= mrgSingle "a"
+                (mrgIf (con False) undefined (mrgSingle "a") :: UnionM SymBool)
+                  @?= mrgSingle "a",
+              testCase "mrgIf should work" $
+                (mrgIf "a" (single "b") (single "c") :: UnionM SymBool)
+                  @?= merge (unionIf "a" (single "b") (single "c"))
+            ]
+        ],
+      let a :: SymBool = "a"
+          b :: SymBool = "b"
+          c :: SymBool = "c"
+          d :: SymBool = "d"
+          e :: SymBool = "e"
+          f :: SymBool = "f"
+          g1 :: UnionM (Either SymBool SymBool) =
+            mrgIf a (mrgSingle $ Left b) (mrgSingle $ Right c)
+          g2 :: UnionM (Either SymBool SymBool) =
+            mrgIf d (mrgSingle $ Left e) (mrgSingle $ Right f)
+       in testGroup
+            "SEq"
+            [ testCase "Single/Single" $
+                (mrgSingle a :: UnionM SymBool)
+                  .== mrgSingle b
+                  @?= (a .== b),
+              testCase "If/Single" $ do
+                g1
+                  .== mrgSingle (Left d)
+                  @?= symIte a (b .== d) (con False)
+                g1
+                  .== mrgSingle (Right d)
+                  @?= symIte a (con False) (c .== d),
+              testCase "Single/If" $ do
+                mrgSingle (Left d)
+                  .== g1
+                  @?= symIte a (d .== b) (con False)
+                mrgSingle (Right d)
+                  .== g1
+                  @?= symIte a (con False) (d .== c),
+              testCase "If/If" $
+                g1
+                  .== g2
+                  @?= symIte
+                    a
+                    (symIte d (b .== e) (con False))
+                    (symIte d (con False) (c .== f))
+            ],
+      let a :: SymBool = "a"
+          b :: SymBool = "b"
+          c :: SymBool = "c"
+          d :: SymBool = "d"
+          e :: SymBool = "e"
+          f :: SymBool = "f"
+
+          g1 :: UnionM (Either SymBool SymBool) =
+            mrgIf a (mrgSingle $ Left b) (mrgSingle $ Right c)
+          g2 :: UnionM (Either SymBool SymBool) =
+            mrgIf d (mrgSingle $ Left e) (mrgSingle $ Right f)
+       in testGroup
+            "SOrd"
+            [ testCase "Single/Single" $ do
+                (mrgSingle a :: UnionM SymBool)
+                  .<= mrgSingle b
+                  @?= (a .<= b :: SymBool)
+                (mrgSingle a :: UnionM SymBool)
+                  .< mrgSingle b
+                  @?= (a .< b :: SymBool)
+                (mrgSingle a :: UnionM SymBool)
+                  .>= mrgSingle b
+                  @?= (a .>= b :: SymBool)
+                (mrgSingle a :: UnionM SymBool)
+                  .> mrgSingle b
+                  @?= (a .> b :: SymBool)
+                (mrgSingle a :: UnionM SymBool)
+                  `symCompare` mrgSingle b
+                  @?= (a `symCompare` b :: UnionM Ordering),
+              testCase "If/Single" $ do
+                g1
+                  .<= mrgSingle (Left d)
+                  @?= symIte a (b .<= d) (con False)
+                g1
+                  .< mrgSingle (Left d)
+                  @?= symIte a (b .< d) (con False)
+                g1
+                  .>= mrgSingle (Left d)
+                  @?= symIte a (b .>= d) (con True)
+                g1
+                  .> mrgSingle (Left d)
+                  @?= symIte a (b .> d) (con True)
+
+                g1
+                  `symCompare` mrgSingle (Left d)
+                  @?= ( mrgIf a (b `symCompare` d) (mrgSingle GT) ::
+                          UnionM Ordering
+                      )
+
+                g1
+                  .<= mrgSingle (Right d)
+                  @?= symIte a (con True) (c .<= d)
+                g1
+                  .< mrgSingle (Right d)
+                  @?= symIte a (con True) (c .< d)
+                g1
+                  .>= mrgSingle (Right d)
+                  @?= symIte a (con False) (c .>= d)
+                g1
+                  .> mrgSingle (Right d)
+                  @?= symIte a (con False) (c .> d)
+
+                g1
+                  `symCompare` mrgSingle (Right d)
+                  @?= ( mrgIf a (mrgSingle LT) (c `symCompare` d) ::
+                          UnionM Ordering
+                      ),
+              testCase "Single/If" $ do
+                mrgSingle (Left d)
+                  .<= g1
+                  @?= symIte a (d .<= b) (con True)
+                mrgSingle (Left d)
+                  .< g1
+                  @?= symIte a (d .< b) (con True)
+                mrgSingle (Left d)
+                  .>= g1
+                  @?= symIte a (d .>= b) (con False)
+                mrgSingle (Left d)
+                  .> g1
+                  @?= symIte a (d .> b) (con False)
+
+                mrgSingle (Left d)
+                  `symCompare` g1
+                  @?= ( mrgIf a (d `symCompare` b) (mrgSingle LT) ::
+                          UnionM Ordering
+                      )
+
+                mrgSingle (Right d)
+                  .<= g1
+                  @?= symIte a (con False) (d .<= c)
+                mrgSingle (Right d)
+                  .< g1
+                  @?= symIte a (con False) (d .< c)
+                mrgSingle (Right d)
+                  .>= g1
+                  @?= symIte a (con True) (d .>= c)
+                mrgSingle (Right d)
+                  .> g1
+                  @?= symIte a (con True) (d .> c)
+
+                mrgSingle (Right d)
+                  `symCompare` g1
+                  @?= ( mrgIf a (mrgSingle GT) (d `symCompare` c) ::
+                          UnionM Ordering
+                      ),
+              testCase "If/If" $ do
+                g1
+                  .<= g2
+                  @?= symIte
+                    a
+                    (symIte d (b .<= e) (con True))
+                    (symIte d (con False) (c .<= f))
+                g1
+                  .< g2
+                  @?= symIte
+                    a
+                    (symIte d (b .< e) (con True))
+                    (symIte d (con False) (c .< f))
+                g1
+                  .>= g2
+                  @?= symIte
+                    a
+                    (symIte d (b .>= e) (con False))
+                    (symIte d (con True) (c .>= f))
+                g1
+                  .> g2
+                  @?= symIte
+                    a
+                    (symIte d (b .> e) (con False))
+                    (symIte d (con True) (c .> f))
+                g1
+                  `symCompare` g2
+                  @?= ( mrgIf
+                          a
+                          (mrgIf d (b `symCompare` e) (mrgSingle LT))
+                          (mrgIf d (mrgSingle GT) (c `symCompare` f)) ::
+                          UnionM Ordering
+                      )
+            ],
+      testGroup
+        "ToSym"
+        [ testCase "From single" $
+            (toSym True :: UnionM SymBool) @?= mrgSingle (con True),
+          testCase "From UnionMBase" $
+            (toSym (mrgSingle True :: UnionM Bool) :: UnionM SymBool)
+              @?= mrgSingle (con True)
+        ],
+      testGroup
+        "ToCon"
+        [ testCase "To single" $ do
+            (toCon (mrgSingle (con True) :: UnionM SymBool) :: Maybe Bool)
+              @?= Just True
+            (toCon (mrgSingle "a" :: UnionM SymBool) :: Maybe Bool) @?= Nothing
+            ( toCon
+                ( mrgIf "a" (mrgLeft $ con False) (mrgRight $ con True) ::
+                    UnionM (Either SymBool SymBool)
+                ) ::
+                Maybe (Either Bool Bool)
+              )
+              @?= Nothing,
+          testCase "To UnionMBase" $ do
+            ( toCon (mrgSingle (con True) :: UnionM SymBool) ::
+                Maybe (UnionM Bool)
+              )
+              @?= Just (mrgSingle True)
+            (toCon (mrgSingle "a" :: UnionM SymBool) :: Maybe (UnionM Bool))
+              @?= Nothing
+            ( toCon
+                ( mrgIf "a" (mrgLeft $ con False) (mrgRight $ con True) ::
+                    UnionM (Either SymBool SymBool)
+                ) ::
+                Maybe (UnionM (Either Bool Bool))
+              )
+              @?= Just (mrgIf "a" (mrgLeft False) (mrgRight True))
+            ( toCon
+                ( mrgIf "a" (mrgLeft "b") (mrgRight $ con True) ::
+                    UnionM (Either SymBool SymBool)
+                ) ::
+                Maybe (UnionM (Either Bool Bool))
+              )
+              @?= Nothing
+        ],
+      testCase "Evaluate" $ do
+        let model = emptyModel
+        let model1 = buildModel ("a" ::= True, "b" ::= False, "c" ::= True)
+        evaluateSym False model (mrgSingle "a")
+          @?= (mrgSingle "a" :: UnionM SymBool)
+        evaluateSym True model (mrgSingle "a")
+          @?= (mrgSingle $ con False :: UnionM SymBool)
+        evaluateSym False model1 (mrgSingle "a")
+          @?= (mrgSingle $ con True :: UnionM SymBool)
+        evaluateSym True model1 (mrgSingle "a")
+          @?= (mrgSingle $ con True :: UnionM SymBool)
+        evaluateSym
+          False
+          model1
+          ( mrgIf
+              "a"
+              (mrgSingle $ Left "d")
+              (mrgSingle $ Right "e")
+          )
+          @?= (mrgSingle $ Left "d" :: UnionM (Either SymBool SymBool))
+        evaluateSym
+          True
+          model1
+          ( mrgIf
+              "a"
+              (mrgSingle $ Left "d")
+              (mrgSingle $ Right "e")
+          )
+          @?= (mrgSingle $ Left $ con False :: UnionM (Either SymBool SymBool))
+        evaluateSym
+          False
+          model1
+          ( mrgIf
+              "d"
+              (mrgSingle $ Left "a")
+              (mrgSingle $ Right "b")
+          )
+          @?= ( mrgIf
+                  "d"
+                  (mrgSingle $ Left $ con True)
+                  (mrgSingle $ Right $ con False) ::
+                  UnionM (Either SymBool SymBool)
+              )
+        evaluateSym
+          True
+          model1
+          ( mrgIf
+              "d"
+              (mrgSingle $ Left "a")
+              (mrgSingle $ Right "b")
+          )
+          @?= (mrgSingle $ Right $ con False :: UnionM (Either SymBool SymBool))
+        evaluateSym
+          False
+          model1
+          ( mrgIf
+              "a"
+              (mrgSingle $ Left "b")
+              (mrgSingle $ Right "c")
+          )
+          @?= ( mrgSingle $ Left $ con False ::
+                  UnionM
+                    (Either SymBool SymBool)
+              ),
+      testCase "SubstituteSym" $ do
+        let asym = "a" :: TypedSymbol Bool
+        let a = "a"
+        let b = "b"
+        let c = "c"
+        substituteSym
+          asym
+          b
+          (mrgSingle $ Left a :: UnionM (Either SymBool SymBool))
+          @?= mrgSingle (Left b)
+        substituteSym
+          asym
+          b
+          (mrgSingle $ Left c :: UnionM (Either SymBool SymBool))
+          @?= mrgSingle (Left c)
+        substituteSym
+          asym
+          b
+          (mrgSingle $ Right a :: UnionM (Either SymBool SymBool))
+          @?= mrgSingle (Right b)
+        substituteSym
+          asym
+          b
+          (mrgSingle $ Right c :: UnionM (Either SymBool SymBool))
+          @?= mrgSingle (Right c)
+        substituteSym
+          asym
+          b
+          ( mrgIf a (mrgSingle $ Left a) (mrgSingle $ Right c) ::
+              UnionM (Either SymBool SymBool)
+          )
+          @?= mrgIf b (mrgSingle $ Left b) (mrgSingle $ Right c)
+        substituteSym
+          asym
+          b
+          ( mrgIf c (mrgSingle $ Left c) (mrgSingle $ Right a) ::
+              UnionM (Either SymBool SymBool)
+          )
+          @?= mrgIf c (mrgSingle $ Left c) (mrgSingle $ Right b),
+      testCase "ExtractSymbolic" $ do
+        extractSymbolics (mrgSingle "a" :: UnionM SymBool)
+          @?= buildSymbolSet ("a" :: TypedSymbol Bool)
+        extractSymbolics
+          ( mrgIf "a" (mrgSingle $ Left "b") (mrgSingle $ Right "c") ::
+              UnionM (Either SymBool SymBool)
+          )
+          @?= buildSymbolSet
+            ( "a" :: TypedSymbol Bool,
+              "b" :: TypedSymbol Bool,
+              "c" :: TypedSymbol Bool
+            ),
+      testGroup
+        "Num"
+        [ testCase "fromInteger" $ (1 :: UnionM Integer) @?= mrgSingle 1,
+          testCase "negate" $
+            negate (mrgIf "a" (mrgSingle 1) (mrgSingle 2) :: UnionM Integer)
+              @?= mrgIf "a" (mrgSingle $ -1) (mrgSingle $ -2),
+          testCase "plus" $
+            (mrgIf "a" (mrgSingle 0) (mrgSingle 1) :: UnionM Integer)
+              + mrgIf "b" (mrgSingle 1) (mrgSingle 3)
+              @?= mrgIf
+                "a"
+                (mrgIf "b" (mrgSingle 1) (mrgSingle 3))
+                (mrgIf "b" (mrgSingle 2) (mrgSingle 4)),
+          testCase "minus" $
+            (mrgIf "a" (mrgSingle 0) (mrgSingle 1) :: UnionM Integer)
+              - mrgIf "b" (mrgSingle $ -3) (mrgSingle $ -1)
+              @?= mrgIf
+                "a"
+                (mrgIf (symNot "b") (mrgSingle 1) (mrgSingle 3))
+                (mrgIf (symNot "b") (mrgSingle 2) (mrgSingle 4)),
+          testCase "times" $
+            (mrgIf "a" (mrgSingle 1) (mrgSingle 2) :: UnionM Integer)
+              * mrgIf "b" (mrgSingle 3) (mrgSingle 4)
+              @?= mrgIf
+                "a"
+                (mrgIf "b" (mrgSingle 3) (mrgSingle 4))
+                (mrgIf "b" (mrgSingle 6) (mrgSingle 8)),
+          testCase "abs" $
+            abs (mrgIf "a" (mrgSingle $ -1) (mrgSingle 2) :: UnionM Integer)
+              @?= mrgIf "a" (mrgSingle 1) (mrgSingle 2),
+          testCase "signum" $
+            signum (mrgIf "a" (mrgSingle $ -1) (mrgSingle 2) :: UnionM Integer)
+              @?= mrgIf "a" (mrgSingle $ -1) (mrgSingle 1)
+        ],
+      testGroup
+        "symIteOp"
+        [ testCase "symIte" $
+            symIte "a" (mrgSingle "b") (mrgSingle "c")
+              @?= (mrgSingle (symIte "a" "b" "c") :: UnionM SymBool)
+        ],
+      let l = mrgIf "a" (mrgSingle False) (mrgSingle True)
+          r = mrgIf "b" (mrgSingle False) (mrgSingle True)
+       in testGroup
+            "LogicalOp"
+            [ testCase ".||" $
+                l
+                  .|| r
+                  @?= ( mrgIf
+                          ("a" .&& "b")
+                          (mrgSingle False)
+                          (mrgSingle True) ::
+                          UnionM Bool
+                      ),
+              testCase ".&&" $
+                l
+                  .&& r
+                  @?= ( mrgIf
+                          ("a" .|| "b")
+                          (mrgSingle False)
+                          (mrgSingle True) ::
+                          UnionM Bool
+                      ),
+              testCase "symNot" $
+                symNot l
+                  @?= mrgIf (symNot "a") (mrgSingle False) (mrgSingle True),
+              testCase "symXor" $
+                l
+                  `symXor` r
+                  @?= ( mrgIf
+                          (symIte "a" "b" (symNot "b"))
+                          (mrgSingle False)
+                          (mrgSingle True) ::
+                          UnionM Bool
+                      ),
+              testCase "symImplies" $
+                l
+                  `symImplies` r
+                  @?= ( mrgIf
+                          (symNot "a" .&& "b")
+                          (mrgSingle False)
+                          (mrgSingle True) ::
+                          UnionM Bool
+                      )
+            ],
+      testCase "PrimWrapper" $ do
+        con True @?= (mrgSingle $ con True :: UnionM SymBool)
+        ssym "a" @?= (mrgSingle "a" :: UnionM SymBool)
+        isym "a" 0 @?= (mrgSingle $ isym "a" 0 :: UnionM SymBool)
+        conView (mrgSingle $ con True :: UnionM SymBool) @?= Just True
+        conView (mrgSingle "a" :: UnionM SymBool) @?= Nothing
+        conView
+          ( mrgIf
+              "a"
+              (mrgSingle $ con False)
+              (mrgSingle $ con True) ::
+              UnionM SymBool
+          )
+          @?= Nothing,
+      testGroup
+        "Function class"
+        [ testCase "Applying function in UnionMBase" $ do
+            let func =
+                  mrgIf "a" (mrgSingle (+ 1)) (mrgSingle (+ 2)) ::
+                    UnionM (Integer -> Integer)
+            func # (1 :: Integer) @?= mrgIf "a" (mrgSingle 2) (mrgSingle 3),
+          testCase "Helper for applying on UnionMBase" $ do
+            let func (x :: Integer) =
+                  mrgIf "a" (mrgSingle $ x + 1) (mrgSingle $ x + 3)
+            (func .# (mrgIf "b" (mrgSingle 0) (mrgSingle 1) :: UnionM Integer))
+              @?= ( mrgIf
+                      "b"
+                      (mrgIf "a" (mrgSingle 1) (mrgSingle 3))
+                      (mrgIf "a" (mrgSingle 2) (mrgSingle 4)) ::
+                      UnionM Integer
+                  )
+        ],
+      testCase "IsString" $ ("x" :: UnionM B.ByteString) @?= mrgSingle "x",
+      testGroup
+        "GenSym"
+        [ testCase "GenSym with spec" $ do
+            (genSym (ListSpec 1 3 ()) "a" :: UnionM (UnionM [SymBool]))
+              @?= mrgSingle
+                ( mrgIf
+                    (isym "a" 3)
+                    (mrgSingle [isym "a" 2])
+                    ( mrgIf
+                        (isym "a" 4)
+                        (mrgSingle [isym "a" 1, isym "a" 2])
+                        (mrgSingle [isym "a" 0, isym "a" 1, isym "a" 2])
+                    )
+                )
+            (genSymSimple (ListSpec 1 3 ()) "a" :: UnionM [SymBool])
+              @?= mrgIf
+                (isym "a" 3)
+                (mrgSingle [isym "a" 2])
+                ( mrgIf
+                    (isym "a" 4)
+                    (mrgSingle [isym "a" 1, isym "a" 2])
+                    (mrgSingle [isym "a" 0, isym "a" 1, isym "a" 2])
+                ),
+          testCase "GenSym with same shape" $
+            ( genSym
+                ( mrgIf
+                    "a"
+                    (mrgSingle ["x"])
+                    (mrgSingle ["y", "z"]) ::
+                    UnionM [SymBool]
+                )
+                "a" ::
+                UnionM [SymBool]
+            )
+              @?= mrgIf
+                (isym "a" 0)
+                (mrgSingle [isym "a" 1])
+                (mrgSingle [isym "a" 2, isym "a" 3])
+        ],
+      testGroup
+        "Concrete Key HashMaps"
+        [ testCase "Concrete Key HashMap should work" $ do
+            mrgIte
+              "a"
+              ( ML.fromList
+                  [ (1, mrgSingle $ Just 1),
+                    (2, mrgSingle $ Just 2)
+                  ] ::
+                  ML.HashMap Integer (UnionM (Maybe Integer))
+              )
+              (ML.fromList [(1, mrgSingle $ Just 2), (3, mrgSingle $ Just 3)])
+              @?= ML.fromList
+                [ (1, mrgIf "a" (mrgSingle $ Just 1) (mrgSingle $ Just 2)),
+                  ( 2,
+                    mrgIf
+                      (symNot "a")
+                      (mrgSingle Nothing)
+                      (mrgSingle $ Just 2)
+                  ),
+                  (3, mrgIf "a" (mrgSingle Nothing) (mrgSingle $ Just 3))
+                ]
+            mrgIf
+              "a"
+              ( mrgSingle $
+                  ML.fromList
+                    [ (1, mrgSingle $ Just 1),
+                      (2, mrgSingle $ Just 2)
+                    ] ::
+                  UnionM (ML.HashMap Integer (UnionM (Maybe Integer)))
+              )
+              ( mrgSingle
+                  ( ML.fromList
+                      [ (1, mrgSingle $ Just 2),
+                        (3, mrgSingle $ Just 3)
+                      ]
+                  )
+              )
+              @?= mrgSingle
+                ( ML.fromList
+                    [ (1, mrgIf "a" (mrgSingle $ Just 1) (mrgSingle $ Just 2)),
+                      ( 2,
+                        mrgIf
+                          (symNot "a")
+                          (mrgSingle Nothing)
+                          (mrgSingle $ Just 2)
+                      ),
+                      (3, mrgIf "a" (mrgSingle Nothing) (mrgSingle $ Just 3))
+                    ]
+                )
+        ],
+      testCase
+        "unionSize"
+        $ do
+          unionSize (single 1 :: UnionM Integer) @?= 1
+          unionSize (mrgIf (ssym "a") (single 1) (single 2) :: UnionM Integer)
+            @?= 2
+          unionSize (choose [1, 2, 3, 4, 5, 6, 7] "a" :: UnionM Integer) @?= 7
     ]
diff --git a/test/Grisette/Core/Control/Monad/UnionTests.hs b/test/Grisette/Core/Control/Monad/UnionTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Control/Monad/UnionTests.hs
@@ -0,0 +1,839 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+module Grisette.Core.Control.Monad.UnionTests (unionTests) where
+
+import GHC.Generics (Generic)
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&), (.||)))
+import Grisette.Core.Data.Class.Mergeable
+  ( Mergeable (rootStrategy),
+    MergingStrategy (SortedStrategy),
+    wrapStrategy,
+  )
+import Grisette.Core.Data.Class.Solvable (Solvable (con))
+import Grisette.Core.Data.Union
+  ( Union (UnionIf, UnionSingle),
+    fullReconstruct,
+    ifWithLeftMost,
+    ifWithStrategy,
+  )
+import Grisette.IR.SymPrim.Data.SymPrim (SymInteger)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit ((@?=))
+
+data TripleSum a b c = TS1 a | TS2 b | TS3 c deriving (Show, Eq, Generic)
+
+instance
+  (Mergeable a, Mergeable b, Mergeable c) =>
+  Mergeable (TripleSum a b c)
+  where
+  rootStrategy =
+    SortedStrategy
+      (\case TS1 _ -> (0 :: Int); TS2 _ -> (1 :: Int); TS3 _ -> (2 :: Int))
+      ( \case
+          0 -> wrapStrategy rootStrategy TS1 (\(TS1 x) -> x)
+          1 -> wrapStrategy rootStrategy TS2 (\(TS2 x) -> x)
+          2 -> wrapStrategy rootStrategy TS3 (\(TS3 x) -> x)
+          _ -> error "Bad"
+      )
+
+unionTests :: Test
+unionTests =
+  testGroup
+    "Union"
+    [ testGroup
+        "ifWithLeftMost"
+        [ testCase
+            "ifWithLeftMost should maintain left most info on Singles"
+            $ do
+              ifWithLeftMost
+                False
+                "a"
+                (UnionSingle (1 :: Integer))
+                (UnionSingle 2)
+                @?= UnionIf 1 False "a" (UnionSingle 1) (UnionSingle 2),
+          testCase "ifWithLeftMost should maintain left most info on Ifs" $ do
+            ifWithLeftMost
+              True
+              "a"
+              (UnionIf 1 True "b" (UnionSingle (1 :: Integer)) (UnionSingle 2))
+              (UnionIf 3 True "c" (UnionSingle 3) (UnionSingle 4))
+              @?= UnionIf
+                1
+                True
+                "a"
+                ( UnionIf
+                    1
+                    True
+                    "b"
+                    (UnionSingle (1 :: Integer))
+                    (UnionSingle 2)
+                )
+                (UnionIf 3 True "c" (UnionSingle 3) (UnionSingle 4))
+        ],
+      testGroup
+        "ifWithStrategy"
+        [ testGroup
+            "ifWithStrategy with concrete condition"
+            [ testCase "true" $ do
+                ifWithStrategy
+                  rootStrategy
+                  (con True)
+                  (UnionSingle (1 :: Integer))
+                  (UnionSingle 2)
+                  @?= UnionSingle 1,
+              testCase "false" $ do
+                ifWithStrategy
+                  rootStrategy
+                  (con False)
+                  (UnionSingle (1 :: Integer))
+                  (UnionSingle 2)
+                  @?= UnionSingle 2
+            ],
+          let a =
+                ifWithStrategy
+                  rootStrategy
+                  "a"
+                  (UnionSingle (1 :: Integer))
+                  (UnionSingle 2)
+           in testGroup
+                "ifWithStrategy with condition equal to sub conditions"
+                [ testCase "ifTrue" $ do
+                    ifWithStrategy rootStrategy "a" a (UnionSingle 3)
+                      @?= UnionIf 1 True "a" (UnionSingle 1) (UnionSingle 3),
+                  testCase "ifFalse" $ do
+                    ifWithStrategy rootStrategy "a" (UnionSingle 0) a
+                      @?= UnionIf 0 True "a" (UnionSingle 0) (UnionSingle 2)
+                ],
+          testCase "ifWithStrategy with simple mergeables" $ do
+            ifWithStrategy
+              rootStrategy
+              "a"
+              (UnionSingle ("b" :: SymInteger))
+              (UnionSingle "c")
+              @?= UnionSingle (symIte "a" "b" "c"),
+          testGroup
+            "ifWithStrategy with ordered mergeables"
+            [ testGroup
+                "ifWithStrategy on Single/Single"
+                [ testGroup
+                    "idxt < idxf"
+                    [ testCase "Integer" $
+                        ifWithStrategy
+                          rootStrategy
+                          "a"
+                          (UnionSingle (1 :: Integer))
+                          (UnionSingle 2)
+                          @?= UnionIf
+                            1
+                            True
+                            "a"
+                            (UnionSingle 1)
+                            (UnionSingle 2),
+                      testCase "Maybe Integer" $
+                        ifWithStrategy
+                          rootStrategy
+                          "a"
+                          (UnionSingle Nothing)
+                          (UnionSingle (Just (2 :: Integer)))
+                          @?= UnionIf
+                            Nothing
+                            True
+                            "a"
+                            (UnionSingle Nothing)
+                            (UnionSingle (Just 2))
+                    ],
+                  testGroup
+                    "idxt == idxf"
+                    [ testGroup
+                        "idxt == idxf as terminal"
+                        [ testCase "Integer" $
+                            ifWithStrategy
+                              rootStrategy
+                              "a"
+                              (UnionSingle (1 :: Integer))
+                              (UnionSingle 1)
+                              @?= UnionSingle 1,
+                          testCase "Maybe Integer" $
+                            ifWithStrategy
+                              rootStrategy
+                              "a"
+                              (UnionSingle (Just ("b" :: SymInteger)))
+                              (UnionSingle (Just "c"))
+                              @?= UnionSingle (Just (symIte "a" "b" "c"))
+                        ],
+                      testGroup
+                        "idxt == idxf but not terminal"
+                        [ testCase "Maybe Integer" $
+                            ifWithStrategy
+                              rootStrategy
+                              "a"
+                              (UnionSingle (Just (1 :: Integer)))
+                              (UnionSingle (Just (2 :: Integer)))
+                              @?= UnionIf
+                                (Just 1)
+                                True
+                                "a"
+                                (UnionSingle $ Just 1)
+                                (UnionSingle (Just 2)),
+                          testCase "Maybe (Maybe Integer)" $
+                            ifWithStrategy
+                              rootStrategy
+                              "a"
+                              (UnionSingle $ Just $ Just ("b" :: SymInteger))
+                              (UnionSingle $ Just $ Just "c")
+                              @?= UnionSingle (Just (Just (symIte "a" "b" "c")))
+                        ]
+                    ],
+                  testGroup
+                    "idxt > idxf"
+                    [ testCase "Integer" $
+                        ifWithStrategy
+                          rootStrategy
+                          "a"
+                          (UnionSingle (2 :: Integer))
+                          (UnionSingle 1)
+                          @?= UnionIf
+                            1
+                            True
+                            (symNot "a")
+                            (UnionSingle 1)
+                            (UnionSingle 2),
+                      testCase "Maybe Integer" $
+                        ifWithStrategy
+                          rootStrategy
+                          "a"
+                          (UnionSingle (Just (2 :: Integer)))
+                          (UnionSingle Nothing)
+                          @?= UnionIf
+                            Nothing
+                            True
+                            (symNot "a")
+                            (UnionSingle Nothing)
+                            (UnionSingle (Just 2))
+                    ]
+                ],
+              testGroup
+                "ifWithStrategy on Single/If"
+                [ testGroup
+                    "Degenerate to Single/Single when idxft == idxff"
+                    [ testCase "Degenerated case with idxt < idxf" $ do
+                        let x =
+                              ifWithStrategy
+                                rootStrategy
+                                "a"
+                                (UnionSingle (Just (1 :: Integer)))
+                                (UnionSingle (Just (2 :: Integer)))
+                        ifWithStrategy rootStrategy "b" (UnionSingle Nothing) x
+                          @?= UnionIf
+                            Nothing
+                            True
+                            "b"
+                            (UnionSingle Nothing)
+                            ( UnionIf
+                                (Just 1)
+                                True
+                                "a"
+                                (UnionSingle $ Just 1)
+                                (UnionSingle (Just 2))
+                            ),
+                      let x =
+                            ifWithStrategy
+                              rootStrategy
+                              "a"
+                              (UnionSingle (Just (1 :: Integer)))
+                              (UnionSingle (Just (3 :: Integer)))
+                       in testGroup
+                            "Degenerated case with idxt == idxf"
+                            [ testCase "sub-idxt < sub-idxft" $
+                                ifWithStrategy
+                                  rootStrategy
+                                  "b"
+                                  (UnionSingle $ Just 0)
+                                  x
+                                  @?= UnionIf
+                                    (Just 0)
+                                    True
+                                    "b"
+                                    (UnionSingle $ Just 0)
+                                    ( UnionIf
+                                        (Just 1)
+                                        True
+                                        "a"
+                                        (UnionSingle $ Just 1)
+                                        (UnionSingle (Just 3))
+                                    ),
+                              testCase "sub-idxt == sub-idxft" $
+                                ifWithStrategy
+                                  rootStrategy
+                                  "b"
+                                  (UnionSingle $ Just 1)
+                                  x
+                                  @?= UnionIf
+                                    (Just 1)
+                                    True
+                                    ("b" .|| "a")
+                                    (UnionSingle $ Just 1)
+                                    (UnionSingle (Just 3)),
+                              testCase "subidxft < sub-idxt < sub-idxff" $
+                                ifWithStrategy
+                                  rootStrategy
+                                  "b"
+                                  (UnionSingle $ Just 2)
+                                  x
+                                  @?= UnionIf
+                                    (Just 1)
+                                    True
+                                    ((symNot "b") .&& "a")
+                                    (UnionSingle $ Just 1)
+                                    ( UnionIf
+                                        (Just 2)
+                                        True
+                                        "b"
+                                        (UnionSingle $ Just 2)
+                                        (UnionSingle $ Just 3)
+                                    ),
+                              testCase "sub-idxt == sub-idxff" $
+                                ifWithStrategy
+                                  rootStrategy
+                                  "b"
+                                  (UnionSingle $ Just 3)
+                                  x
+                                  @?= UnionIf
+                                    (Just 1)
+                                    True
+                                    ((symNot "b") .&& "a")
+                                    (UnionSingle $ Just 1)
+                                    (UnionSingle (Just 3)),
+                              testCase "sub-idxff < sub-idxt" $
+                                ifWithStrategy
+                                  rootStrategy
+                                  "b"
+                                  (UnionSingle $ Just 4)
+                                  x
+                                  @?= UnionIf
+                                    (Just 1)
+                                    True
+                                    ((symNot "b") .&& "a")
+                                    (UnionSingle $ Just 1)
+                                    ( UnionIf
+                                        (Just 3)
+                                        True
+                                        (symNot "b")
+                                        (UnionSingle $ Just 3)
+                                        (UnionSingle $ Just 4)
+                                    )
+                            ],
+                      testCase "Degenerated case with idxt > idxf" $ do
+                        let x =
+                              ifWithStrategy
+                                rootStrategy
+                                "a"
+                                (UnionSingle (Left (1 :: Integer)))
+                                (UnionSingle (Left (2 :: Integer)))
+                        ifWithStrategy
+                          rootStrategy
+                          "b"
+                          (UnionSingle $ Right (1 :: Integer))
+                          x
+                          @?= UnionIf
+                            (Left 1)
+                            True
+                            (symNot "b")
+                            ( UnionIf
+                                (Left 1)
+                                True
+                                "a"
+                                (UnionSingle $ Left 1)
+                                (UnionSingle (Left 2))
+                            )
+                            (UnionSingle $ Right 1)
+                    ],
+                  testCase "idxt < idxft" $ do
+                    let x =
+                          ifWithStrategy
+                            rootStrategy
+                            "a"
+                            (UnionSingle (1 :: Integer))
+                            (UnionSingle (3 :: Integer))
+                    ifWithStrategy rootStrategy "b" (UnionSingle 0) x
+                      @?= UnionIf
+                        0
+                        True
+                        "b"
+                        (UnionSingle 0)
+                        ( UnionIf
+                            1
+                            True
+                            "a"
+                            (UnionSingle 1)
+                            (UnionSingle 3)
+                        ),
+                  testCase "idxt == idxft" $ do
+                    let x =
+                          ifWithStrategy
+                            rootStrategy
+                            "a"
+                            (UnionSingle $ Left (1 :: Integer))
+                            (UnionSingle $ Right (3 :: Integer))
+                    ifWithStrategy rootStrategy "b" (UnionSingle $ Left 0) x
+                      @?= UnionIf
+                        (Left 0)
+                        True
+                        ("b" .|| "a")
+                        ( UnionIf
+                            (Left 0)
+                            True
+                            "b"
+                            (UnionSingle $ Left 0)
+                            (UnionSingle $ Left 1)
+                        )
+                        (UnionSingle $ Right 3),
+                  testCase "idxt > idxft" $ do
+                    let x =
+                          ifWithStrategy
+                            rootStrategy
+                            "a"
+                            (UnionSingle $ Left (1 :: Integer))
+                            (UnionSingle $ Right (3 :: Integer))
+                    ifWithStrategy rootStrategy "b" (UnionSingle $ Right 0) x
+                      @?= UnionIf
+                        (Left 1)
+                        True
+                        ((symNot "b") .&& "a")
+                        (UnionSingle $ Left 1)
+                        ( UnionIf
+                            (Right 0)
+                            True
+                            "b"
+                            (UnionSingle $ Right 0)
+                            (UnionSingle $ Right 3)
+                        )
+                ],
+              testGroup
+                "ifWithStrategy on If/Single"
+                [ testGroup
+                    "Degenerate to Single/Single when idxtt == idxtf"
+                    [ testCase "Degenerated case with idxt < idxf" $ do
+                        let x =
+                              ifWithStrategy
+                                rootStrategy
+                                "a"
+                                (UnionSingle (Left (1 :: Integer)))
+                                (UnionSingle (Left (2 :: Integer)))
+                        ifWithStrategy
+                          rootStrategy
+                          "b"
+                          x
+                          (UnionSingle $ Right (2 :: Integer))
+                          @?= UnionIf
+                            (Left 1)
+                            True
+                            "b"
+                            ( UnionIf
+                                (Left 1)
+                                True
+                                "a"
+                                (UnionSingle $ Left 1)
+                                (UnionSingle (Left 2))
+                            )
+                            (UnionSingle $ Right 2),
+                      let x =
+                            ifWithStrategy
+                              rootStrategy
+                              "a"
+                              (UnionSingle (Just (1 :: Integer)))
+                              (UnionSingle (Just (3 :: Integer)))
+                       in testGroup
+                            "Degenerated case with idxt == idxf"
+                            [ testCase "sub-idxf < sub-idxtt" $
+                                ifWithStrategy
+                                  rootStrategy
+                                  "b"
+                                  x
+                                  (UnionSingle $ Just 0)
+                                  @?= UnionIf
+                                    (Just 0)
+                                    True
+                                    (symNot "b")
+                                    (UnionSingle $ Just 0)
+                                    ( UnionIf
+                                        (Just 1)
+                                        True
+                                        "a"
+                                        (UnionSingle $ Just 1)
+                                        (UnionSingle (Just 3))
+                                    ),
+                              testCase "sub-idxf == sub-idxtt" $
+                                ifWithStrategy
+                                  rootStrategy
+                                  "b"
+                                  x
+                                  (UnionSingle $ Just 1)
+                                  @?= UnionIf
+                                    (Just 1)
+                                    True
+                                    ((symNot "b") .|| "a")
+                                    (UnionSingle $ Just 1)
+                                    (UnionSingle (Just 3)),
+                              testCase "sub-idxtt < sub-idxf < sub-idxtf" $
+                                ifWithStrategy
+                                  rootStrategy
+                                  "b"
+                                  x
+                                  (UnionSingle $ Just 2)
+                                  @?= UnionIf
+                                    (Just 1)
+                                    True
+                                    ("b" .&& "a")
+                                    (UnionSingle $ Just 1)
+                                    ( UnionIf
+                                        (Just 2)
+                                        True
+                                        (symNot "b")
+                                        (UnionSingle $ Just 2)
+                                        (UnionSingle $ Just 3)
+                                    ),
+                              testCase "sub-idxf == sub-idxtf" $
+                                ifWithStrategy
+                                  rootStrategy
+                                  "b"
+                                  x
+                                  (UnionSingle $ Just 3)
+                                  @?= UnionIf
+                                    (Just 1)
+                                    True
+                                    ("b" .&& "a")
+                                    (UnionSingle $ Just 1)
+                                    (UnionSingle (Just 3)),
+                              testCase "sub-idxtf < sub-idxf" $
+                                ifWithStrategy
+                                  rootStrategy
+                                  "b"
+                                  x
+                                  (UnionSingle $ Just 4)
+                                  @?= UnionIf
+                                    (Just 1)
+                                    True
+                                    ("b" .&& "a")
+                                    (UnionSingle $ Just 1)
+                                    ( UnionIf
+                                        (Just 3)
+                                        True
+                                        "b"
+                                        (UnionSingle $ Just 3)
+                                        (UnionSingle $ Just 4)
+                                    )
+                            ],
+                      testCase "Degenerated case with idxt > idxf" $ do
+                        let x =
+                              ifWithStrategy
+                                rootStrategy
+                                "a"
+                                (UnionSingle (Right (1 :: Integer)))
+                                (UnionSingle (Right (2 :: Integer)))
+                        ifWithStrategy
+                          rootStrategy
+                          "b"
+                          x
+                          (UnionSingle $ Left (1 :: Integer))
+                          @?= UnionIf
+                            (Left 1)
+                            True
+                            (symNot "b")
+                            (UnionSingle $ Left 1)
+                            ( UnionIf
+                                (Right 1)
+                                True
+                                "a"
+                                (UnionSingle $ Right 1)
+                                (UnionSingle (Right 2))
+                            )
+                    ],
+                  testCase "idxtt < idxf" $ do
+                    let x =
+                          ifWithStrategy
+                            rootStrategy
+                            "a"
+                            (UnionSingle $ Left (1 :: Integer))
+                            (UnionSingle $ Right (3 :: Integer))
+                    ifWithStrategy rootStrategy "b" x (UnionSingle $ Right 0)
+                      @?= UnionIf
+                        (Left 1)
+                        True
+                        ("b" .&& "a")
+                        (UnionSingle $ Left 1)
+                        ( UnionIf
+                            (Right 0)
+                            True
+                            (symNot "b")
+                            (UnionSingle $ Right 0)
+                            (UnionSingle $ Right 3)
+                        ),
+                  testCase "idxtt == idxf" $ do
+                    let x =
+                          ifWithStrategy
+                            rootStrategy
+                            "a"
+                            (UnionSingle $ Left (1 :: Integer))
+                            (UnionSingle $ Right (3 :: Integer))
+                    ifWithStrategy rootStrategy "b" x (UnionSingle $ Left 0)
+                      @?= UnionIf
+                        (Left 0)
+                        True
+                        ((symNot "b") .|| "a")
+                        ( UnionIf
+                            (Left 0)
+                            True
+                            (symNot "b")
+                            (UnionSingle $ Left 0)
+                            (UnionSingle $ Left 1)
+                        )
+                        (UnionSingle $ Right 3),
+                  testCase "idxtt > idxf" $ do
+                    let x =
+                          ifWithStrategy
+                            rootStrategy
+                            "a"
+                            (UnionSingle (1 :: Integer))
+                            (UnionSingle (3 :: Integer))
+                    ifWithStrategy rootStrategy "b" x (UnionSingle 0)
+                      @?= UnionIf
+                        0
+                        True
+                        (symNot "b")
+                        (UnionSingle 0)
+                        (UnionIf 1 True "a" (UnionSingle 1) (UnionSingle 3))
+                ],
+              testGroup
+                "ifWithStrategy on If/If"
+                [ testCase "Degenerate to Single/If when idxtt == idxtf" $ do
+                    let x =
+                          ifWithStrategy
+                            rootStrategy
+                            "a"
+                            (UnionSingle $ Left (1 :: Integer))
+                            (UnionSingle $ Left (2 :: Integer))
+                    let y =
+                          ifWithStrategy
+                            rootStrategy
+                            "b"
+                            (UnionSingle $ Left (1 :: Integer))
+                            (UnionSingle $ Right (2 :: Integer))
+                    ifWithStrategy rootStrategy "c" x y
+                      @?= UnionIf
+                        (Left 1)
+                        True
+                        ("c" .|| "b")
+                        ( UnionIf
+                            (Left 1)
+                            True
+                            ((symNot "c") .|| "a")
+                            (UnionSingle $ Left 1)
+                            (UnionSingle $ Left 2)
+                        )
+                        (UnionSingle $ Right 2),
+                  testCase "Degenerate to Single/If when idxff == idxft" $ do
+                    let x =
+                          ifWithStrategy
+                            rootStrategy
+                            "a"
+                            (UnionSingle $ Left (1 :: Integer))
+                            (UnionSingle $ Left (2 :: Integer))
+                    let y =
+                          ifWithStrategy
+                            rootStrategy
+                            "b"
+                            (UnionSingle $ Left (1 :: Integer))
+                            (UnionSingle $ Right (2 :: Integer))
+                    ifWithStrategy rootStrategy "c" y x
+                      @?= UnionIf
+                        (Left 1)
+                        True
+                        ((symNot "c") .|| "b")
+                        ( UnionIf
+                            (Left 1)
+                            True
+                            ("c" .|| "a")
+                            (UnionSingle $ Left 1)
+                            (UnionSingle $ Left 2)
+                        )
+                        (UnionSingle $ Right 2),
+                  testCase "Non-degenerated case when idxtt < idxft" $ do
+                    let x =
+                          ifWithStrategy
+                            rootStrategy
+                            "a"
+                            (UnionSingle $ TS1 (1 :: Integer))
+                            (UnionSingle $ TS2 (2 :: Integer))
+                    let y =
+                          ifWithStrategy
+                            rootStrategy
+                            "b"
+                            (UnionSingle $ TS2 (1 :: Integer))
+                            (UnionSingle $ TS3 (2 :: Integer))
+                    ifWithStrategy rootStrategy "c" x y
+                      @?= UnionIf
+                        (TS1 1)
+                        True
+                        ("c" .&& "a")
+                        (UnionSingle $ TS1 1)
+                        ( UnionIf
+                            (TS2 1)
+                            True
+                            ("c" .|| "b")
+                            ( UnionIf
+                                (TS2 1)
+                                True
+                                (symNot "c")
+                                (UnionSingle $ TS2 1)
+                                (UnionSingle $ TS2 2)
+                            )
+                            (UnionSingle $ TS3 2)
+                        ),
+                  testCase "Non-degenerated case when idxtt == idxft" $ do
+                    let x =
+                          ifWithStrategy
+                            rootStrategy
+                            "a"
+                            (UnionSingle $ TS1 (1 :: Integer))
+                            (UnionSingle $ TS2 (2 :: Integer))
+                    let y =
+                          ifWithStrategy
+                            rootStrategy
+                            "b"
+                            (UnionSingle $ TS1 (2 :: Integer))
+                            (UnionSingle $ TS3 (2 :: Integer))
+                    ifWithStrategy rootStrategy "c" x y
+                      @?= UnionIf
+                        (TS1 1)
+                        True
+                        (symIte "c" "a" "b")
+                        ( UnionIf
+                            (TS1 1)
+                            True
+                            "c"
+                            (UnionSingle $ TS1 1)
+                            (UnionSingle $ TS1 2)
+                        )
+                        ( UnionIf
+                            (TS2 2)
+                            True
+                            "c"
+                            (UnionSingle $ TS2 2)
+                            (UnionSingle $ TS3 2)
+                        ),
+                  testCase "Non-degenerated case when idxtt > idxft" $ do
+                    let x =
+                          ifWithStrategy
+                            rootStrategy
+                            "a"
+                            (UnionSingle $ TS2 (1 :: Integer))
+                            (UnionSingle $ TS3 (2 :: Integer))
+                    let y =
+                          ifWithStrategy
+                            rootStrategy
+                            "b"
+                            (UnionSingle $ TS1 (1 :: Integer))
+                            (UnionSingle $ TS2 (2 :: Integer))
+                    ifWithStrategy rootStrategy "c" x y
+                      @?= UnionIf
+                        (TS1 1)
+                        True
+                        ((symNot "c") .&& "b")
+                        (UnionSingle $ TS1 1)
+                        ( UnionIf
+                            (TS2 1)
+                            True
+                            ((symNot "c") .|| "a")
+                            ( UnionIf
+                                (TS2 1)
+                                True
+                                "c"
+                                (UnionSingle $ TS2 1)
+                                (UnionSingle $ TS2 2)
+                            )
+                            (UnionSingle $ TS3 2)
+                        )
+                ],
+              testCase "ifWithStrategy should tolerate non-merged Ifs" $ do
+                let x =
+                      UnionIf
+                        (Right 2)
+                        False
+                        "a"
+                        (UnionSingle $ Right (2 :: Integer))
+                        (UnionSingle $ Left (2 :: Integer))
+                let y =
+                      UnionIf
+                        (Right 3)
+                        False
+                        "b"
+                        (UnionSingle $ Right 3)
+                        (UnionSingle $ Left 1)
+                ifWithStrategy rootStrategy "c" x y
+                  @?= UnionIf
+                    (Left 1)
+                    True
+                    (symIte "c" (symNot "a") (symNot "b"))
+                    ( UnionIf
+                        (Left 1)
+                        True
+                        (symNot "c")
+                        (UnionSingle $ Left 1)
+                        (UnionSingle $ Left 2)
+                    )
+                    ( UnionIf
+                        (Right 2)
+                        True
+                        "c"
+                        (UnionSingle $ Right 2)
+                        (UnionSingle $ Right 3)
+                    )
+            ]
+        ],
+      testGroup
+        "fullReconstruct"
+        [ testCase "fullReconstruct should work" $ do
+            let x =
+                  UnionIf
+                    (Right 2)
+                    False
+                    "a"
+                    (UnionSingle $ Right (2 :: Integer))
+                    (UnionSingle $ Left (2 :: Integer))
+            let y =
+                  UnionIf
+                    (Right 3)
+                    False
+                    "b"
+                    (UnionSingle $ Right 3)
+                    (UnionSingle $ Left 1)
+            let z = UnionIf (Right 2) False "c" x y
+            fullReconstruct rootStrategy z
+              @?= UnionIf
+                (Left 1)
+                True
+                (symIte "c" (symNot "a") (symNot "b"))
+                ( UnionIf
+                    (Left 1)
+                    True
+                    (symNot "c")
+                    (UnionSingle $ Left 1)
+                    (UnionSingle $ Left 2)
+                )
+                ( UnionIf
+                    (Right 2)
+                    True
+                    "c"
+                    (UnionSingle $ Right 2)
+                    (UnionSingle $ Right 3)
+                )
+        ]
+    ]
diff --git a/test/Grisette/Core/Data/BVTests.hs b/test/Grisette/Core/Data/BVTests.hs
--- a/test/Grisette/Core/Data/BVTests.hs
+++ b/test/Grisette/Core/Data/BVTests.hs
@@ -329,7 +329,7 @@
 bvTests :: Test
 bvTests =
   testGroup
-    "BVTests"
+    "BV"
     [ testGroup
         "WordN 8 conform to Word8 for Bits instances"
         [ testProperty "(.&.)" $ \x y -> ioProperty $ wordBinConform (.&.) (.&.) x y,
@@ -471,6 +471,13 @@
             shouldThrow "divMod" $ divMod (minBound :: IntN 8) (-1 :: IntN 8)
             shouldThrow "div" $ div (minBound :: IntN 8) (-1 :: IntN 8)
             shouldThrow "quotRem" $ quotRem (minBound :: IntN 8) (-1 :: IntN 8)
-            shouldThrow "quot" $ quot (minBound :: IntN 8) (-1 :: IntN 8)
+            shouldThrow "quot" $ quot (minBound :: IntN 8) (-1 :: IntN 8),
+          testCase "toInteger for IntN 1" $ do
+            toInteger (0 :: IntN 1) @=? 0
+            toInteger (1 :: IntN 1) @=? (-1),
+          testProperty "WordN shiftL by large amount" $ \(x :: WordN 128) ->
+            ioProperty $ shiftL x maxBound @=? 0,
+          testProperty "IntN shiftL by large amount" $ \(x :: IntN 128) ->
+            ioProperty $ shiftL x maxBound @=? 0
         ]
     ]
diff --git a/test/Grisette/Core/Data/Class/BoolTests.hs b/test/Grisette/Core/Data/Class/BoolTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/BoolTests.hs
@@ -0,0 +1,77 @@
+module Grisette.Core.Data.Class.BoolTests (boolTests) where
+
+import Grisette.Core.Data.Class.LogicalOp
+  ( LogicalOp (symImplies, symNot, symXor, (.&&), (.||)),
+  )
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit ((@?=))
+
+data CustomAndBool
+  = CASBool String
+  | CAAnd CustomAndBool CustomAndBool
+  | CANot CustomAndBool
+  deriving (Show, Eq)
+
+instance LogicalOp CustomAndBool where
+  symNot (CANot x) = x
+  symNot x = CANot x
+  (.&&) = CAAnd
+
+data CustomOrBool
+  = COSBool String
+  | COOr CustomOrBool CustomOrBool
+  | CONot CustomOrBool
+  deriving (Show, Eq)
+
+instance LogicalOp CustomOrBool where
+  symNot (CONot x) = x
+  symNot x = CONot x
+  (.||) = COOr
+
+boolTests :: Test
+boolTests =
+  testGroup
+    "Bool"
+    [ testGroup
+        "LogicalOp"
+        [ testGroup
+            "Use and"
+            [ testCase "symNot" $
+                symNot (CASBool "a") @?= CANot (CASBool "a"),
+              testCase ".&&" $
+                CASBool "a"
+                  .&& CASBool "b"
+                  @?= CAAnd (CASBool "a") (CASBool "b"),
+              testCase ".||" $
+                CASBool "a"
+                  .|| CASBool "b"
+                  @?= CANot (CAAnd (CANot $ CASBool "a") (CANot $ CASBool "b"))
+            ],
+          testGroup
+            "Use or"
+            [ testCase "symNot" $
+                symNot (COSBool "a") @?= CONot (COSBool "a"),
+              testCase ".&&" $
+                COSBool "a"
+                  .&& COSBool "b"
+                  @?= CONot (COOr (CONot $ COSBool "a") (CONot $ COSBool "b")),
+              testCase ".||" $
+                COSBool "a"
+                  .|| COSBool "b"
+                  @?= COOr (COSBool "a") (COSBool "b"),
+              testCase "symXor" $
+                COSBool "a"
+                  `symXor` COSBool "b"
+                  @?= COOr
+                    (CONot (COOr (CONot (COSBool "a")) (COSBool "b")))
+                    (CONot (COOr (COSBool "a") (CONot (COSBool "b")))),
+              testCase "symImplies" $
+                COSBool "a"
+                  `symImplies` COSBool "b"
+                  @?= COOr
+                    (CONot (COSBool "a"))
+                    (COSBool "b")
+            ]
+        ]
+    ]
diff --git a/test/Grisette/Core/Data/Class/EvaluateSymTests.hs b/test/Grisette/Core/Data/Class/EvaluateSymTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/EvaluateSymTests.hs
@@ -0,0 +1,929 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Grisette.Core.Data.Class.EvaluateSymTests (evaluateSymTests) where
+
+import Control.Monad.Except (ExceptT (ExceptT))
+import Control.Monad.Identity
+  ( Identity (Identity),
+    IdentityT (IdentityT),
+  )
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import qualified Control.Monad.Writer.Lazy as WriterLazy
+import qualified Control.Monad.Writer.Strict as WriterStrict
+import qualified Data.ByteString as B
+import Data.Functor.Sum (Sum (InL, InR))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.Stack (HasCallStack)
+import Grisette (TypedSymbol (IndexedSymbol))
+import Grisette.Core.Data.Class.EvaluateSym (EvaluateSym (evaluateSym))
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&), (.||)))
+import Grisette.Core.Data.Class.ModelOps
+  ( ModelOps (emptyModel),
+    ModelRep (buildModel),
+  )
+import Grisette.Core.Data.Class.SEq (SEq ((.==)))
+import Grisette.Core.Data.Class.Solvable (Solvable (con, isym, ssym))
+import Grisette.IR.SymPrim.Data.Prim.Model
+  ( ModelValuePair ((::=)),
+  )
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit (Assertion, (@?=))
+import Test.QuickCheck (ioProperty)
+
+concreteEvaluateSymOkProp ::
+  (HasCallStack, EvaluateSym a, Show a, Eq a) => a -> Assertion
+concreteEvaluateSymOkProp x = evaluateSym True emptyModel x @?= x
+
+evaluateSymTests :: Test
+evaluateSymTests =
+  testGroup
+    "EvaluateSym"
+    [ testGroup
+        "EvaluateSym for common types"
+        [ testGroup
+            "SymBool"
+            [ let model = emptyModel
+                  eval :: SymBool -> SymBool
+                  eval = evaluateSym False model
+               in testGroup
+                    "Empty model / no fill default"
+                    [ testCase "con" $
+                        eval (con True) @?= con True,
+                      testCase "ssym" $
+                        eval (ssym "a") @?= ssym "a",
+                      testCase "isym" $
+                        eval (isym "a" 1) @?= isym "a" 1,
+                      testCase ".||" $
+                        eval (ssym "a" .|| ssym "b")
+                          @?= ssym "a"
+                            .|| ssym "b",
+                      testCase ".&&" $
+                        eval (ssym "a" .&& ssym "b")
+                          @?= ssym "a"
+                            .&& ssym "b",
+                      testCase ".==" $
+                        eval ((ssym "a" :: SymBool) .== ssym "b")
+                          @?= (ssym "a" :: SymBool)
+                            .== ssym "b",
+                      testCase "symNot" $
+                        eval (symNot (ssym "a"))
+                          @?= symNot (ssym "a"),
+                      testCase "symIte" $
+                        eval (symIte (ssym "a") (ssym "b") (ssym "c"))
+                          @?= symIte (ssym "a") (ssym "b") (ssym "c")
+                    ],
+              let model = emptyModel
+                  eval :: SymBool -> SymBool
+                  eval = evaluateSym True model
+               in testGroup
+                    "Empty model / with fill default"
+                    [ testCase "con" $
+                        eval (con True) @?= con True,
+                      testCase "ssym" $
+                        eval (ssym "a") @?= con False,
+                      testCase "isym" $
+                        eval (isym "a" 1) @?= con False,
+                      testCase ".||" $
+                        eval (ssym "a" .|| ssym "b") @?= con False,
+                      testCase ".&&" $
+                        eval (ssym "a" .&& ssym "b") @?= con False,
+                      testCase ".==" $
+                        eval ((ssym "a" :: SymBool) .== ssym "b") @?= con True,
+                      testCase "symNot" $
+                        eval (symNot (ssym "a")) @?= con True,
+                      testCase "symIte" $
+                        eval (symIte (ssym "a") (ssym "b") (ssym "c"))
+                          @?= con False
+                    ],
+              let model =
+                    buildModel
+                      ( "a" ::= True,
+                        IndexedSymbol "a" 1 ::= False,
+                        "b" ::= False,
+                        "c" ::= True
+                      )
+                  eval :: SymBool -> SymBool
+                  eval = evaluateSym True model
+               in testGroup
+                    "Some model"
+                    [ testCase "con" $
+                        eval (con True) @?= con True,
+                      testCase "ssym" $
+                        eval (ssym "a") @?= con True,
+                      testCase "isym" $
+                        eval (isym "a" 1) @?= con False,
+                      testCase ".||" $
+                        eval (ssym "a" .|| ssym "b") @?= con True,
+                      testCase ".&&" $
+                        eval (ssym "a" .&& ssym "b") @?= con False,
+                      testCase ".==" $
+                        eval ((ssym "a" :: SymBool) .== ssym "b") @?= con False,
+                      testCase "symNot" $
+                        eval (symNot (ssym "a")) @?= con False,
+                      testCase "symIte" $
+                        eval (symIte (ssym "a") (ssym "b") (ssym "c"))
+                          @?= con False
+                    ]
+            ],
+          testProperty "Bool" $ ioProperty . concreteEvaluateSymOkProp @Bool,
+          testProperty "Integer" $
+            ioProperty . concreteEvaluateSymOkProp @Integer,
+          testProperty "Char" $ ioProperty . concreteEvaluateSymOkProp @Char,
+          testProperty "Int" $ ioProperty . concreteEvaluateSymOkProp @Int,
+          testProperty "Int8" $ ioProperty . concreteEvaluateSymOkProp @Int8,
+          testProperty "Int16" $ ioProperty . concreteEvaluateSymOkProp @Int16,
+          testProperty "Int32" $ ioProperty . concreteEvaluateSymOkProp @Int32,
+          testProperty "Int64" $ ioProperty . concreteEvaluateSymOkProp @Int64,
+          testProperty "Word" $ ioProperty . concreteEvaluateSymOkProp @Word,
+          testProperty "Word8" $ ioProperty . concreteEvaluateSymOkProp @Word8,
+          testProperty "Word16" $
+            ioProperty . concreteEvaluateSymOkProp @Word16,
+          testProperty "Word32" $
+            ioProperty . concreteEvaluateSymOkProp @Word32,
+          testProperty "Word64" $
+            ioProperty . concreteEvaluateSymOkProp @Word64,
+          testGroup
+            "List"
+            [ testProperty "[Integer]" $
+                ioProperty . concreteEvaluateSymOkProp @[Integer],
+              let model =
+                    buildModel ("a" ::= True, "b" ::= False)
+                  eval :: Bool -> [SymBool] -> [SymBool]
+                  eval = flip evaluateSym model
+               in testGroup
+                    "[SymBool]"
+                    [ testGroup
+                        "No fill default"
+                        [ testCase "Empty list" $
+                            eval False [] @?= [],
+                          testCase "Non-empty list" $
+                            eval False [ssym "a", ssym "b", ssym "c"]
+                              @?= [con True, con False, ssym "c"]
+                        ],
+                      testGroup
+                        "Fill default"
+                        [ testCase "Empty list" $
+                            eval True [] @?= [],
+                          testCase "Non-empty list" $
+                            eval True [ssym "a", ssym "b", ssym "c"]
+                              @?= [con True, con False, con False]
+                        ]
+                    ]
+            ],
+          testGroup
+            "Maybe"
+            [ testProperty "Maybe Integer" $
+                ioProperty . concreteEvaluateSymOkProp @(Maybe Integer),
+              let model = buildModel ("a" ::= True)
+                  eval :: Bool -> Maybe SymBool -> Maybe SymBool
+                  eval = flip evaluateSym model
+               in testGroup
+                    "Maybe SymBool"
+                    [ testGroup
+                        "No fill default"
+                        [ testCase "Nothing" $
+                            eval False Nothing @?= Nothing,
+                          testCase "Just v: v in model" $
+                            eval False (Just (ssym "a")) @?= Just (con True),
+                          testCase "Just v: v not in model" $
+                            eval False (Just (ssym "b")) @?= Just (ssym "b")
+                        ],
+                      testGroup
+                        "Fill default"
+                        [ testCase "Nothing" $
+                            eval True (Nothing) @?= Nothing,
+                          testCase "Just v: v in model" $
+                            eval True (Just (ssym "a")) @?= Just (con True),
+                          testCase "Just v: v not in model" $
+                            eval True (Just (ssym "b")) @?= Just (con False)
+                        ]
+                    ]
+            ],
+          testGroup
+            "Either"
+            [ testProperty "Either Integer Integer" $
+                ioProperty
+                  . concreteEvaluateSymOkProp @(Either Integer Integer),
+              let model = buildModel ("a" ::= True)
+                  eval ::
+                    Bool ->
+                    Either SymBool SymBool ->
+                    Either SymBool SymBool
+                  eval = flip evaluateSym model
+               in testGroup
+                    "Either SymBool SymBool"
+                    [ testGroup
+                        "No fill default"
+                        [ testCase "Left v: v in model" $
+                            eval False (Left (ssym "a")) @?= Left (con True),
+                          testCase "Left v: v not in model" $
+                            eval False (Left (ssym "b")) @?= Left (ssym "b"),
+                          testCase "Right v: v in model" $
+                            eval False (Right (ssym "a")) @?= Right (con True),
+                          testCase "Right v: v not in model" $
+                            eval False (Right (ssym "b")) @?= Right (ssym "b")
+                        ],
+                      testGroup
+                        "Fill default"
+                        [ testCase "Left v: v in model" $
+                            eval True (Left (ssym "a")) @?= Left (con True),
+                          testCase "Left v: v not in model" $
+                            eval True (Left (ssym "b")) @?= Left (con False),
+                          testCase "Right v: v in model" $
+                            eval True (Right (ssym "a")) @?= Right (con True),
+                          testCase "Right v: v not in model" $
+                            eval True (Right (ssym "b")) @?= Right (con False)
+                        ]
+                    ]
+            ],
+          testGroup
+            "MaybeT"
+            [ testProperty "MaybeT Maybe Integer" $
+                ioProperty
+                  . concreteEvaluateSymOkProp @(MaybeT Maybe Integer)
+                  . MaybeT,
+              let model = buildModel ("a" ::= True)
+                  eval ::
+                    Bool ->
+                    MaybeT Maybe SymBool ->
+                    MaybeT Maybe SymBool
+                  eval = flip evaluateSym model
+               in testGroup
+                    "MaybeT should work"
+                    [ testGroup
+                        "No fill default"
+                        [ testCase "MaybeT Nothing" $
+                            eval False (MaybeT Nothing) @?= MaybeT Nothing,
+                          testCase "MaybeT (Just Nothing)" $
+                            eval False (MaybeT $ Just Nothing)
+                              @?= MaybeT (Just Nothing),
+                          testCase "MaybeT (Just v): v in model" $
+                            eval False (MaybeT $ Just $ Just (ssym "a"))
+                              @?= MaybeT (Just (Just (con True))),
+                          testCase "MaybeT (Just v): v not in model" $
+                            eval False (MaybeT $ Just $ Just (ssym "b"))
+                              @?= MaybeT (Just (Just (ssym "b")))
+                        ],
+                      testGroup
+                        "Fill default"
+                        [ testCase "MaybeT Nothing" $
+                            eval True (MaybeT Nothing) @?= MaybeT Nothing,
+                          testCase "MaybeT (Just Nothing)" $
+                            eval True (MaybeT $ Just Nothing)
+                              @?= MaybeT (Just Nothing),
+                          testCase "MaybeT (Just v): v in model" $
+                            eval True (MaybeT $ Just $ Just (ssym "a"))
+                              @?= MaybeT (Just (Just (con True))),
+                          testCase "MaybeT (Just v): v not in model" $
+                            eval True (MaybeT $ Just $ Just (ssym "b"))
+                              @?= MaybeT (Just (Just (con False)))
+                        ]
+                    ]
+            ],
+          testGroup
+            "ExceptT"
+            [ testProperty "ExceptT Integer Maybe Integer" $
+                ioProperty
+                  . concreteEvaluateSymOkProp @(ExceptT Integer Maybe Integer)
+                  . ExceptT,
+              let model = buildModel ("a" ::= True)
+                  eval ::
+                    Bool ->
+                    ExceptT SymBool Maybe SymBool ->
+                    ExceptT SymBool Maybe SymBool
+                  eval = flip evaluateSym model
+               in testGroup
+                    "ExceptT SymBool Maybe SymBool"
+                    [ testGroup
+                        "No fill default"
+                        [ testCase "ExceptT Nothing" $
+                            eval False (ExceptT Nothing) @?= ExceptT Nothing,
+                          testCase "ExceptT (Just (Left v)): v in model" $
+                            eval False (ExceptT $ Just $ Left $ ssym "a")
+                              @?= ExceptT (Just $ Left $ con True),
+                          testCase "ExceptT (Just (Left v)): v not in model" $
+                            eval False (ExceptT $ Just $ Left $ ssym "b")
+                              @?= ExceptT (Just $ Left $ ssym "b"),
+                          testCase "ExceptT (Just (Right v)): v in model" $
+                            eval False (ExceptT $ Just $ Right $ ssym "a")
+                              @?= ExceptT (Just $ Right $ con True),
+                          testCase "ExceptT (Just (Right v)): v not in model" $
+                            eval False (ExceptT $ Just $ Right $ ssym "b")
+                              @?= ExceptT (Just $ Right $ ssym "b")
+                        ],
+                      testGroup
+                        "Fill default"
+                        [ testCase "ExceptT Nothing" $
+                            eval True (ExceptT Nothing) @?= ExceptT Nothing,
+                          testCase "ExceptT (Just (Left v)): v in model" $
+                            eval True (ExceptT $ Just $ Left $ ssym "a")
+                              @?= ExceptT (Just $ Left $ con True),
+                          testCase "ExceptT (Just (Left v)): v not in model" $
+                            eval True (ExceptT $ Just $ Left $ ssym "b")
+                              @?= ExceptT (Just $ Left $ con False),
+                          testCase "ExceptT (Just (Right v)): v in model" $
+                            eval True (ExceptT $ Just $ Right $ ssym "a")
+                              @?= ExceptT (Just $ Right $ con True),
+                          testCase "ExceptT (Just (Right v)): v not in model" $
+                            eval True (ExceptT $ Just $ Right $ ssym "b")
+                              @?= ExceptT (Just $ Right $ con False)
+                        ]
+                    ]
+            ],
+          testProperty "()" (ioProperty . concreteEvaluateSymOkProp @()),
+          testGroup
+            "(,)"
+            [ testProperty "(Integer, Integer)" $
+                ioProperty . concreteEvaluateSymOkProp @(Integer, Integer),
+              let model = buildModel ("a" ::= True)
+                  eval ::
+                    Bool ->
+                    (SymBool, SymBool) ->
+                    (SymBool, SymBool)
+                  eval = flip evaluateSym model
+               in testGroup
+                    "(SymBool, SymBool)"
+                    [ testCase "No fill default" $
+                        eval False (ssym "a", ssym "b")
+                          @?= (con True, ssym "b"),
+                      testCase "Fill default" $
+                        eval True (ssym "a", ssym "b")
+                          @?= (con True, con False)
+                    ]
+            ],
+          testGroup
+            "(,,)"
+            [ testProperty "(Integer, Integer, Integer)" $
+                ioProperty
+                  . concreteEvaluateSymOkProp @(Integer, Integer, Integer),
+              let model = buildModel ("a" ::= True)
+                  eval ::
+                    Bool ->
+                    (SymBool, SymBool, SymBool) ->
+                    (SymBool, SymBool, SymBool)
+                  eval = flip evaluateSym model
+               in testGroup
+                    "(SymBool, SymBool, SymBool)"
+                    [ testCase "No fill default" $
+                        eval False (ssym "a", ssym "b", ssym "c")
+                          @?= (con True, ssym "b", ssym "c"),
+                      testCase "Fill default" $
+                        eval True (ssym "a", ssym "b", ssym "c")
+                          @?= (con True, con False, con False)
+                    ]
+            ],
+          testGroup
+            "(,,,)"
+            [ testProperty "(Integer, Integer, Integer, Integer)" $
+                ioProperty
+                  . concreteEvaluateSymOkProp
+                    @(Integer, Integer, Integer, Integer),
+              let model = buildModel ("a" ::= True)
+                  eval ::
+                    Bool ->
+                    (SymBool, SymBool, SymBool, SymBool) ->
+                    (SymBool, SymBool, SymBool, SymBool)
+                  eval = flip evaluateSym model
+               in testGroup
+                    "(SymBool, SymBool, SymBool, SymBool)"
+                    [ testCase "No fill default" $
+                        eval False (ssym "a", ssym "b", ssym "c", ssym "d")
+                          @?= (con True, ssym "b", ssym "c", ssym "d"),
+                      testCase "Fill default" $
+                        eval True (ssym "a", ssym "b", ssym "c", ssym "d")
+                          @?= (con True, con False, con False, con False)
+                    ]
+            ],
+          testGroup
+            "(,,,,)"
+            [ testProperty "(Integer, Integer, Integer, Integer, Integer)" $
+                ioProperty
+                  . concreteEvaluateSymOkProp
+                    @(Integer, Integer, Integer, Integer, Integer),
+              let model = buildModel ("a" ::= True)
+                  eval ::
+                    Bool ->
+                    (SymBool, SymBool, SymBool, SymBool, SymBool) ->
+                    (SymBool, SymBool, SymBool, SymBool, SymBool)
+                  eval = flip evaluateSym model
+               in testGroup
+                    "(SymBool, SymBool, SymBool, SymBool, SymBool)"
+                    [ testCase "No fill default" $
+                        eval
+                          False
+                          (ssym "a", ssym "b", ssym "c", ssym "d", ssym "e")
+                          @?= ( con True,
+                                ssym "b",
+                                ssym "c",
+                                ssym "d",
+                                ssym "e"
+                              ),
+                      testCase "Fill default" $
+                        eval
+                          True
+                          (ssym "a", ssym "b", ssym "c", ssym "d", ssym "e")
+                          @?= ( con True,
+                                con False,
+                                con False,
+                                con False,
+                                con False
+                              )
+                    ]
+            ],
+          testGroup
+            "(,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteEvaluateSymOkProp
+                    @(Integer, Integer, Integer, Integer, Integer, Integer),
+              let model = buildModel ("a" ::= True)
+                  eval ::
+                    Bool ->
+                    (SymBool, SymBool, SymBool, SymBool, SymBool, SymBool) ->
+                    (SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)
+                  eval = flip evaluateSym model
+               in testGroup
+                    "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                    [ testCase "No fill default" $
+                        eval
+                          False
+                          ( ssym "a",
+                            ssym "b",
+                            ssym "c",
+                            ssym "d",
+                            ssym "e",
+                            ssym "f"
+                          )
+                          @?= ( con True,
+                                ssym "b",
+                                ssym "c",
+                                ssym "d",
+                                ssym "e",
+                                ssym "f"
+                              ),
+                      testCase "Fill default" $
+                        eval
+                          True
+                          ( ssym "a",
+                            ssym "b",
+                            ssym "c",
+                            ssym "d",
+                            ssym "e",
+                            ssym "f"
+                          )
+                          @?= ( con True,
+                                con False,
+                                con False,
+                                con False,
+                                con False,
+                                con False
+                              )
+                    ]
+            ],
+          testGroup
+            "(,,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteEvaluateSymOkProp
+                    @( Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer
+                     ),
+              let model = buildModel ("a" ::= True)
+                  eval ::
+                    Bool ->
+                    ( SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool
+                    ) ->
+                    ( SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool
+                    )
+                  eval = flip evaluateSym model
+               in testGroup
+                    "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                    [ testCase "No fill default" $
+                        eval
+                          False
+                          ( ssym "a",
+                            ssym "b",
+                            ssym "c",
+                            ssym "d",
+                            ssym "e",
+                            ssym "f",
+                            ssym "g"
+                          )
+                          @?= ( con True,
+                                ssym "b",
+                                ssym "c",
+                                ssym "d",
+                                ssym "e",
+                                ssym "f",
+                                ssym "g"
+                              ),
+                      testCase "Fill default" $
+                        eval
+                          True
+                          ( ssym "a",
+                            ssym "b",
+                            ssym "c",
+                            ssym "d",
+                            ssym "e",
+                            ssym "f",
+                            ssym "h"
+                          )
+                          @?= ( con True,
+                                con False,
+                                con False,
+                                con False,
+                                con False,
+                                con False,
+                                con False
+                              )
+                    ]
+            ],
+          testGroup
+            "(,,,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteEvaluateSymOkProp
+                    @( Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer
+                     ),
+              let model = buildModel ("a" ::= True)
+                  eval ::
+                    Bool ->
+                    ( SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool
+                    ) ->
+                    ( SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool,
+                      SymBool
+                    )
+                  eval = flip evaluateSym model
+               in testGroup
+                    "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                    [ testCase "No fill default" $
+                        eval
+                          False
+                          ( ssym "a",
+                            ssym "b",
+                            ssym "c",
+                            ssym "d",
+                            ssym "e",
+                            ssym "f",
+                            ssym "g",
+                            ssym "h"
+                          )
+                          @?= ( con True,
+                                ssym "b",
+                                ssym "c",
+                                ssym "d",
+                                ssym "e",
+                                ssym "f",
+                                ssym "g",
+                                ssym "h"
+                              ),
+                      testCase "Fill default" $
+                        eval
+                          True
+                          ( ssym "a",
+                            ssym "b",
+                            ssym "c",
+                            ssym "d",
+                            ssym "e",
+                            ssym "f",
+                            ssym "h",
+                            ssym "h"
+                          )
+                          @?= ( con True,
+                                con False,
+                                con False,
+                                con False,
+                                con False,
+                                con False,
+                                con False,
+                                con False
+                              )
+                    ]
+            ],
+          let model = buildModel ("a" ::= True)
+              eval :: Bool -> B.ByteString -> B.ByteString
+              eval = flip evaluateSym model
+           in testGroup
+                "ByteString should work"
+                [ testGroup
+                    "No fill default"
+                    [ testCase "\"\"" $
+                        eval False ("" :: B.ByteString) @?= "",
+                      testCase "\"a\"" $
+                        eval False ("a" :: B.ByteString) @?= "a"
+                    ],
+                  testGroup
+                    "Fill default"
+                    [ testCase "\"\"" $
+                        eval True ("" :: B.ByteString) @?= "",
+                      testCase "\"a\"" $
+                        eval True ("a" :: B.ByteString) @?= "a"
+                    ]
+                ],
+          testGroup
+            "Sum"
+            [ testProperty
+                "Sum Maybe Maybe Integer"
+                ( ioProperty . \(x :: Either (Maybe Integer) (Maybe Integer)) ->
+                    case x of
+                      Left val ->
+                        concreteEvaluateSymOkProp
+                          @(Sum Maybe Maybe Integer)
+                          $ InL val
+                      Right val ->
+                        concreteEvaluateSymOkProp
+                          @(Sum Maybe Maybe Integer)
+                          $ InR val
+                ),
+              let model = buildModel ("a" ::= True)
+                  eval ::
+                    Bool ->
+                    Sum Maybe Maybe SymBool ->
+                    Sum Maybe Maybe SymBool
+                  eval = flip evaluateSym model
+               in testGroup
+                    "Sum Maybe Maybe SymBool"
+                    [ testGroup
+                        "No fill default"
+                        [ testCase "InL Nothing" $
+                            eval False (InL Nothing) @?= InL Nothing,
+                          testCase "InR Nothing" $
+                            eval False (InR Nothing) @?= InR Nothing,
+                          testCase "InL (Just v): v in model" $
+                            eval False (InL (Just $ ssym "a"))
+                              @?= InL (Just $ con True),
+                          testCase "InL (Just v): v not in model" $
+                            eval False (InL (Just $ ssym "b"))
+                              @?= InL (Just $ ssym "b"),
+                          testCase "InR (Just v): v in model" $
+                            eval False (InR (Just $ ssym "a"))
+                              @?= InR (Just $ con True),
+                          testCase "InR (Just v): v not in model" $
+                            eval False (InR (Just $ ssym "b"))
+                              @?= InR (Just $ ssym "b")
+                        ],
+                      testGroup
+                        "Fill default"
+                        [ testCase "InL Nothing" $
+                            eval True (InL Nothing) @?= InL Nothing,
+                          testCase "InR Nothing" $
+                            eval True (InR Nothing) @?= InR Nothing,
+                          testCase "InL (Just v): v in model" $
+                            eval True (InL (Just $ ssym "a"))
+                              @?= InL (Just $ con True),
+                          testCase "InL (Just v): v not in model" $
+                            eval True (InL (Just $ ssym "b"))
+                              @?= InL (Just $ con False),
+                          testCase "InR (Just v): v in model" $
+                            eval True (InR (Just $ ssym "a"))
+                              @?= InR (Just $ con True),
+                          testCase "InR (Just v): v not in model" $
+                            eval True (InR (Just $ ssym "b"))
+                              @?= InR (Just $ con False)
+                        ]
+                    ]
+            ],
+          testGroup
+            "WriterT"
+            [ testGroup
+                "Lazy"
+                [ testProperty
+                    "WriterT Integer (Either Integer) Integer"
+                    $ ioProperty . \(x :: Either Integer (Integer, Integer)) ->
+                      concreteEvaluateSymOkProp (WriterLazy.WriterT x),
+                  let model = buildModel ("a" ::= True)
+                      eval ::
+                        Bool ->
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool ->
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      eval = flip evaluateSym model
+                   in testGroup
+                        "WriterT SymBool (Either SymBool) SymBool"
+                        [ testGroup
+                            "No fill default"
+                            [ testCase "WriterT (Left v): v in model" $
+                                eval
+                                  False
+                                  (WriterLazy.WriterT $ Left $ ssym "a")
+                                  @?= WriterLazy.WriterT (Left $ con True),
+                              testCase "WriterT (Left v): v not in model" $
+                                eval
+                                  False
+                                  (WriterLazy.WriterT $ Left $ ssym "b")
+                                  @?= WriterLazy.WriterT (Left $ ssym "b"),
+                              testCase "WriterT (Right (v1, v2))" $
+                                eval
+                                  False
+                                  ( WriterLazy.WriterT $
+                                      Right (ssym "a", ssym "b")
+                                  )
+                                  @?= WriterLazy.WriterT
+                                    (Right (con True, ssym "b"))
+                            ],
+                          testGroup
+                            "Fill default"
+                            [ testCase "WriterT (Left v): v in model" $
+                                eval True (WriterLazy.WriterT $ Left $ ssym "a")
+                                  @?= WriterLazy.WriterT (Left $ con True),
+                              testCase "WriterT (Left v): v not in model" $
+                                eval True (WriterLazy.WriterT $ Left $ ssym "b")
+                                  @?= WriterLazy.WriterT (Left $ con False),
+                              testCase "WriterT (Right (v1, v2))" $
+                                eval
+                                  True
+                                  ( WriterLazy.WriterT $
+                                      Right (ssym "a", ssym "b")
+                                  )
+                                  @?= WriterLazy.WriterT
+                                    (Right (con True, con False))
+                            ]
+                        ]
+                ],
+              testGroup
+                "Strict"
+                [ testProperty
+                    "WriterT Integer (Either Integer) Integer"
+                    $ ioProperty
+                      . \(x :: Either Integer (Integer, Integer)) ->
+                        concreteEvaluateSymOkProp (WriterStrict.WriterT x),
+                  let model = buildModel ("a" ::= True)
+                      eval ::
+                        Bool ->
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool ->
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      eval = flip evaluateSym model
+                   in testGroup
+                        "WriterT SymBool (Either SymBool) SymBool"
+                        [ testGroup
+                            "No fill default"
+                            [ testCase "WriterT (Left v): v in model" $
+                                eval
+                                  False
+                                  (WriterStrict.WriterT $ Left $ ssym "a")
+                                  @?= WriterStrict.WriterT (Left $ con True),
+                              testCase "WriterT (Left v): v not in model" $
+                                eval
+                                  False
+                                  (WriterStrict.WriterT $ Left $ ssym "b")
+                                  @?= WriterStrict.WriterT (Left $ ssym "b"),
+                              testCase "WriterT (Right (v1, v2))" $
+                                eval
+                                  False
+                                  ( WriterStrict.WriterT $
+                                      Right (ssym "a", ssym "b")
+                                  )
+                                  @?= WriterStrict.WriterT
+                                    (Right (con True, ssym "b"))
+                            ],
+                          testGroup
+                            "Fill default"
+                            [ testCase "WriterT (Left v): v in model" $
+                                eval
+                                  True
+                                  (WriterStrict.WriterT $ Left $ ssym "a")
+                                  @?= WriterStrict.WriterT (Left $ con True),
+                              testCase "WriterT (Left v): v not in model" $
+                                eval
+                                  True
+                                  (WriterStrict.WriterT $ Left $ ssym "b")
+                                  @?= WriterStrict.WriterT (Left $ con False),
+                              testCase "WriterT (Right (v1, v2))" $
+                                eval
+                                  True
+                                  ( WriterStrict.WriterT $
+                                      Right (ssym "a", ssym "b")
+                                  )
+                                  @?= WriterStrict.WriterT
+                                    (Right (con True, con False))
+                            ]
+                        ]
+                ]
+            ],
+          testGroup
+            "Identity"
+            [ testProperty
+                "Identity Integer"
+                $ ioProperty
+                  . \(x :: Integer) -> concreteEvaluateSymOkProp $ Identity x,
+              let model = buildModel ("a" ::= True)
+                  eval :: Bool -> Identity SymBool -> Identity SymBool
+                  eval = flip evaluateSym model
+               in testGroup
+                    "Identity SymBool"
+                    [ testGroup
+                        "No fill default"
+                        [ testCase "Identity v: v in model" $
+                            eval False (Identity $ ssym "a")
+                              @?= Identity (con True),
+                          testCase "Identity v: v not in model" $
+                            eval False (Identity $ ssym "b")
+                              @?= Identity (ssym "b")
+                        ],
+                      testGroup
+                        "Fill default"
+                        [ testCase "Identity v: v in model" $
+                            eval True (Identity $ ssym "a")
+                              @?= Identity (con True),
+                          testCase "Identity v: v not in model" $
+                            eval True (Identity $ ssym "b")
+                              @?= Identity (con False)
+                        ]
+                    ]
+            ],
+          testGroup
+            "IdentityT"
+            [ testProperty
+                "IdentityT (Either Integer) Integer"
+                $ ioProperty
+                  . \(x :: Either Integer Integer) ->
+                    concreteEvaluateSymOkProp $ IdentityT x,
+              let model = buildModel ("a" ::= True)
+                  eval ::
+                    Bool ->
+                    IdentityT (Either SymBool) SymBool ->
+                    IdentityT (Either SymBool) SymBool
+                  eval = flip evaluateSym model
+               in testGroup
+                    "IdentityT (Either SymBool) SymBool"
+                    [ testGroup
+                        "No fill default"
+                        [ testCase "IdentityT (Left v): v in model" $
+                            eval False (IdentityT $ Left $ ssym "a")
+                              @?= IdentityT (Left $ con True),
+                          testCase "IdentityT (Left v): v not in model" $
+                            eval False (IdentityT $ Left $ ssym "b")
+                              @?= IdentityT (Left $ ssym "b"),
+                          testCase "IdentityT (Right v): v in model" $
+                            eval False (IdentityT $ Right $ ssym "a")
+                              @?= IdentityT (Right $ con True),
+                          testCase "IdentityT (Right v): v not in model" $
+                            eval False (IdentityT $ Right $ ssym "b")
+                              @?= IdentityT (Right $ ssym "b")
+                        ],
+                      testGroup
+                        "Fill default"
+                        [ testCase "IdentityT (Left v): v in model" $
+                            eval True (IdentityT $ Left $ ssym "a")
+                              @?= IdentityT (Left $ con True),
+                          testCase "IdentityT (Left v): v not in model" $
+                            eval True (IdentityT $ Left $ ssym "b")
+                              @?= IdentityT (Left $ con False),
+                          testCase "IdentityT (Right v): v in model" $
+                            eval True (IdentityT $ Right $ ssym "a")
+                              @?= IdentityT (Right $ con True),
+                          testCase "IdentityT (Right v): v not in model" $
+                            eval True (IdentityT $ Right $ ssym "b")
+                              @?= IdentityT (Right $ con False)
+                        ]
+                    ]
+            ]
+        ]
+    ]
diff --git a/test/Grisette/Core/Data/Class/ExtractSymbolicsTests.hs b/test/Grisette/Core/Data/Class/ExtractSymbolicsTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/ExtractSymbolicsTests.hs
@@ -0,0 +1,264 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Grisette.Core.Data.Class.ExtractSymbolicsTests
+  ( extractSymbolicsTests,
+  )
+where
+
+import Control.Monad.Except (ExceptT (ExceptT))
+import Control.Monad.Identity
+  ( Identity (Identity),
+    IdentityT (IdentityT),
+  )
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import qualified Control.Monad.Writer.Lazy as WriterLazy
+import qualified Control.Monad.Writer.Strict as WriterStrict
+import qualified Data.ByteString as B
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.Generics (Generic)
+import GHC.Stack (HasCallStack)
+import Generics.Deriving (Default (Default))
+import Grisette.Core.Data.Class.ExtractSymbolics
+  ( ExtractSymbolics (extractSymbolics),
+  )
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&), (.||)))
+import Grisette.Core.Data.Class.ModelOps
+  ( SymbolSetOps (emptySet),
+    SymbolSetRep (buildSymbolSet),
+  )
+import Grisette.Core.Data.Class.SEq (SEq ((.==)))
+import Grisette.Core.Data.Class.TestValues
+  ( isymBool,
+    isymbolBool,
+    ssymBool,
+    ssymbolBool,
+    symTrue,
+  )
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit (Assertion, (@?=))
+import Test.QuickCheck (ioProperty)
+
+data A = A1 | A2 SymBool | A3 SymBool SymBool
+  deriving (Generic, Show, Eq)
+  deriving (ExtractSymbolics) via (Default A)
+
+concreteExtractSymbolicsOkProp ::
+  (HasCallStack, ExtractSymbolics a) => (a, a) -> Assertion
+concreteExtractSymbolicsOkProp x = extractSymbolics x @?= emptySet
+
+extractSymbolicsTests :: Test
+extractSymbolicsTests =
+  testGroup
+    "ExtractSymbolics"
+    [ testGroup
+        "Common types"
+        [ testGroup
+            "SymBool"
+            [ testCase "con" $
+                extractSymbolics symTrue @?= emptySet,
+              testCase "ssym" $
+                extractSymbolics (ssymBool "a")
+                  @?= buildSymbolSet (ssymbolBool "a"),
+              testCase "isym" $
+                extractSymbolics (isymBool "a" 1)
+                  @?= buildSymbolSet (isymbolBool "a" 1),
+              testCase "And" $
+                extractSymbolics (ssymBool "a" .&& isymBool "b" 1)
+                  @?= buildSymbolSet (ssymbolBool "a", isymbolBool "b" 1),
+              testCase "Or" $
+                extractSymbolics (ssymBool "a" .|| isymBool "b" 1)
+                  @?= buildSymbolSet (ssymbolBool "a", isymbolBool "b" 1),
+              testCase "Equal" $
+                extractSymbolics (ssymBool "a" .== isymBool "b" 1)
+                  @?= buildSymbolSet (ssymbolBool "a", isymbolBool "b" 1),
+              testCase "ITE" $
+                extractSymbolics
+                  (symIte (ssymBool "a") (isymBool "b" 1) (ssymBool "c"))
+                  @?= buildSymbolSet
+                    ( ssymbolBool "a",
+                      isymbolBool "b" 1,
+                      ssymbolBool "c"
+                    ),
+              testCase "Not" $
+                extractSymbolics (symNot $ isymBool "a" 1)
+                  @?= buildSymbolSet (isymbolBool "a" 1)
+            ],
+          testProperty "Bool" $
+            ioProperty . concreteExtractSymbolicsOkProp @Bool,
+          testProperty "Integer" $
+            ioProperty . concreteExtractSymbolicsOkProp @Integer,
+          testProperty "Char" $
+            ioProperty . concreteExtractSymbolicsOkProp @Char,
+          testProperty "Int" $ ioProperty . concreteExtractSymbolicsOkProp @Int,
+          testProperty "Int8" $
+            ioProperty . concreteExtractSymbolicsOkProp @Int8,
+          testProperty "Int16" $
+            ioProperty . concreteExtractSymbolicsOkProp @Int16,
+          testProperty "Int32" $
+            ioProperty . concreteExtractSymbolicsOkProp @Int32,
+          testProperty "Int64" $
+            ioProperty . concreteExtractSymbolicsOkProp @Int64,
+          testProperty "Word" $
+            ioProperty . concreteExtractSymbolicsOkProp @Word,
+          testProperty "Word8" $
+            ioProperty . concreteExtractSymbolicsOkProp @Word8,
+          testProperty "Word16" $
+            ioProperty . concreteExtractSymbolicsOkProp @Word16,
+          testProperty "Word32" $
+            ioProperty . concreteExtractSymbolicsOkProp @Word32,
+          testProperty "Word64" $
+            ioProperty . concreteExtractSymbolicsOkProp @Word64,
+          testGroup
+            "[SymBool]"
+            [ testCase "[]" $
+                extractSymbolics ([] :: [SymBool]) @?= emptySet,
+              testCase "[v]" $
+                extractSymbolics [ssymBool "a"]
+                  @?= buildSymbolSet (ssymbolBool "a"),
+              testCase "[v1, v2]" $
+                extractSymbolics [ssymBool "a", ssymBool "b"]
+                  @?= buildSymbolSet (ssymbolBool "a", ssymbolBool "b")
+            ],
+          testGroup
+            "Maybe SymBool"
+            [ testCase "Nothing" $
+                extractSymbolics (Nothing :: Maybe SymBool) @?= emptySet,
+              testCase "Just v" $
+                extractSymbolics (Just (ssymBool "a"))
+                  @?= buildSymbolSet (ssymbolBool "a")
+            ],
+          testGroup
+            "Either SymBool SymBool"
+            [ testCase "Left v" $
+                extractSymbolics
+                  (Left (ssymBool "a") :: Either SymBool SymBool)
+                  @?= buildSymbolSet (ssymbolBool "a"),
+              testCase "Right v" $
+                extractSymbolics
+                  (Right (ssymBool "a") :: Either SymBool SymBool)
+                  @?= buildSymbolSet (ssymbolBool "a")
+            ],
+          testGroup
+            "MaybeT Maybe SymBool"
+            [ testCase "MaybeT Nothing" $
+                extractSymbolics (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  @?= emptySet,
+              testCase "MaybeT (Just Nothing)" $
+                extractSymbolics (MaybeT (Just Nothing) :: MaybeT Maybe SymBool)
+                  @?= emptySet,
+              testCase "MaybeT (Just (Just v))" $
+                extractSymbolics (MaybeT (Just (Just (ssymBool "a"))))
+                  @?= buildSymbolSet (ssymbolBool "a")
+            ],
+          testGroup
+            "ExceptT SymBool Maybe SymBool"
+            [ testCase "ExceptT Nothing" $
+                extractSymbolics
+                  (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  @?= emptySet,
+              testCase "ExceptT (Just (Left v))" $
+                extractSymbolics
+                  ( ExceptT (Just (Left (ssymBool "a"))) ::
+                      ExceptT SymBool Maybe SymBool
+                  )
+                  @?= buildSymbolSet (ssymbolBool "a"),
+              testCase "ExceptT (Just (Right v))" $
+                extractSymbolics
+                  ( ExceptT (Just (Right (ssymBool "a"))) ::
+                      ExceptT SymBool Maybe SymBool
+                  )
+                  @?= buildSymbolSet (ssymbolBool "a")
+            ],
+          testGroup
+            "WriterT SymBool Maybe SymBool"
+            [ testGroup
+                "Lazy"
+                [ testCase "WriterT Nothing" $
+                    extractSymbolics
+                      ( WriterLazy.WriterT Nothing ::
+                          WriterLazy.WriterT SymBool Maybe SymBool
+                      )
+                      @?= emptySet,
+                  testCase "WriterT (Just (v1, v2))" $
+                    extractSymbolics
+                      ( WriterLazy.WriterT
+                          (Just (ssymBool "a", ssymBool "b")) ::
+                          WriterLazy.WriterT SymBool Maybe SymBool
+                      )
+                      @?= buildSymbolSet (ssymbolBool "a", ssymbolBool "b")
+                ],
+              testGroup
+                "Strict"
+                [ testCase "WriterT Nothing" $
+                    extractSymbolics
+                      ( WriterStrict.WriterT Nothing ::
+                          WriterStrict.WriterT SymBool Maybe SymBool
+                      )
+                      @?= emptySet,
+                  testCase "WriterT (Just (v1, v2))" $
+                    extractSymbolics
+                      ( WriterStrict.WriterT
+                          (Just (ssymBool "a", ssymBool "b")) ::
+                          WriterStrict.WriterT SymBool Maybe SymBool
+                      )
+                      @?= buildSymbolSet (ssymbolBool "a", ssymbolBool "b")
+                ]
+            ],
+          testProperty "()" (ioProperty . concreteExtractSymbolicsOkProp @()),
+          testCase "(,)" $
+            extractSymbolics (ssymBool "a", ssymBool "b")
+              @?= buildSymbolSet (ssymbolBool "a", ssymbolBool "b"),
+          testCase "(,,)" $
+            extractSymbolics (ssymBool "a", ssymBool "b", ssymBool "c")
+              @?= buildSymbolSet
+                (ssymbolBool "a", ssymbolBool "b", ssymbolBool "c"),
+          testGroup
+            "ByteString"
+            [ testCase "\"\"" $
+                extractSymbolics ("" :: B.ByteString) @?= emptySet,
+              testCase "\"a\"" $
+                extractSymbolics ("a" :: B.ByteString) @?= emptySet
+            ],
+          testCase "Identity SymBool" $
+            extractSymbolics (Identity (ssymBool "a"))
+              @?= buildSymbolSet (ssymbolBool "a"),
+          testGroup
+            "IdentityT (Either SymBool) SymBool"
+            [ testCase "Identity (Left v)" $
+                extractSymbolics
+                  ( IdentityT $ Left (ssymBool "a") ::
+                      IdentityT (Either SymBool) SymBool
+                  )
+                  @?= buildSymbolSet (ssymbolBool "a"),
+              testCase "Identity (Right v)" $
+                extractSymbolics
+                  ( IdentityT $ Right (ssymBool "a") ::
+                      IdentityT (Either SymBool) SymBool
+                  )
+                  @?= buildSymbolSet (ssymbolBool "a")
+            ]
+        ],
+      testGroup
+        "deriving ExtractSymbolics for ADT"
+        [ testGroup
+            "Simple ADT"
+            [ testCase "A1" $
+                extractSymbolics A1 @?= emptySet,
+              testCase "A2" $
+                extractSymbolics (A2 (ssymBool "a"))
+                  @?= buildSymbolSet (ssymbolBool "a"),
+              testCase "A3" $
+                extractSymbolics (A3 (ssymBool "a") (ssymBool "b"))
+                  @?= buildSymbolSet (ssymbolBool "a", ssymbolBool "b")
+            ]
+        ]
+    ]
diff --git a/test/Grisette/Core/Data/Class/GPrettyTests.hs b/test/Grisette/Core/Data/Class/GPrettyTests.hs
--- a/test/Grisette/Core/Data/Class/GPrettyTests.hs
+++ b/test/Grisette/Core/Data/Class/GPrettyTests.hs
@@ -19,8 +19,8 @@
     SomeWordN (SomeWordN),
     WordN,
   )
-import Grisette.Core.Data.Class.Bool (LogicalOp ((&&~)))
 import Grisette.Core.Data.Class.GPretty (GPretty (gpretty))
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp ((.&&)))
 import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
 import Test.Framework (Test, testGroup)
 import Test.Framework.Providers.HUnit (testCase)
@@ -141,7 +141,7 @@
 gprettyTests :: Test
 gprettyTests =
   testGroup
-    "GPrettyTests"
+    "GPretty"
     [ testGroup
         "simple tests"
         [ propertyGPretty "Bool" (arbitrary :: Gen Bool),
@@ -346,12 +346,12 @@
         [ testGPretty
             "enough space"
             80
-            ("a" &&~ "b" :: SymBool)
+            ("a" .&& "b" :: SymBool)
             "(&& a b)",
           testGPretty
             "not enough space"
             6
-            ("a" &&~ "b" :: SymBool)
+            ("a" .&& "b" :: SymBool)
             "..."
         ]
     ]
diff --git a/test/Grisette/Core/Data/Class/GenSymTests.hs b/test/Grisette/Core/Data/Class/GenSymTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/GenSymTests.hs
@@ -0,0 +1,1265 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Grisette.Core.Data.Class.GenSymTests (genSymTests) where
+
+import Control.Monad.Except (ExceptT (ExceptT))
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Data.Class.GenSym
+  ( EnumGenBound (EnumGenBound),
+    EnumGenUpperBound (EnumGenUpperBound),
+    Fresh,
+    FreshT,
+    GenSymSimple (simpleFresh),
+    ListSpec (ListSpec),
+    SimpleListSpec (SimpleListSpec),
+    choose,
+    chooseFresh,
+    chooseSimple,
+    chooseSimpleFresh,
+    chooseUnion,
+    chooseUnionFresh,
+    genSym,
+    genSymSimple,
+    liftFresh,
+    runFresh,
+    runFreshT,
+  )
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( mrgIf,
+    mrgSingle,
+  )
+import Grisette.Core.Data.Class.TestValues (conBool, isymBool, ssymBool)
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit ((@?=))
+
+genSymTests :: Test
+genSymTests =
+  testGroup
+    "GenSym"
+    [ testGroup
+        "GenSym for common types"
+        [ testGroup
+            "SymBool"
+            [ testGroup
+                "() spec"
+                [ testCase "genSym" $
+                    (genSym () "a" :: UnionM SymBool)
+                      @?= mrgSingle (isymBool "a" 0),
+                  testCase "genSymSimple" $
+                    (genSymSimple () "a" :: SymBool)
+                      @?= isymBool "a" 0
+                ],
+              testGroup
+                "SymBool spec"
+                [ testCase "genSym" $
+                    (genSym (conBool True) "a" :: UnionM SymBool)
+                      @?= mrgSingle (isymBool "a" 0),
+                  testCase "genSymSimple" $
+                    (genSymSimple (conBool True) "a" :: SymBool)
+                      @?= isymBool "a" 0
+                ]
+            ],
+          testGroup
+            "Bool"
+            [ testCase "() spec" $
+                (genSym () "a" :: UnionM Bool)
+                  @?= mrgIf (isymBool "a" 0) (mrgSingle False) (mrgSingle True),
+              testGroup
+                "Bool spec"
+                [ testGroup
+                    "genSym"
+                    [ testCase "True" $
+                        (genSym True "a" :: UnionM Bool)
+                          @?= mrgSingle True,
+                      testCase "False" $
+                        (genSym False "a" :: UnionM Bool)
+                          @?= mrgSingle False
+                    ],
+                  testGroup
+                    "genSymSimple"
+                    [ testCase "True" $
+                        (genSymSimple True "a" :: Bool)
+                          @?= True,
+                      testCase "False" $
+                        (genSymSimple False "a" :: Bool)
+                          @?= False
+                    ]
+                ]
+            ],
+          testGroup
+            "Integer"
+            [ testGroup
+                "Integer spec"
+                [ testCase "genSym" $
+                    (genSym (1 :: Integer) "a" :: UnionM Integer)
+                      @?= mrgSingle 1,
+                  testCase "genSymSimple" $
+                    (genSymSimple (1 :: Integer) "a" :: Integer)
+                      @?= 1
+                ],
+              testCase "Upper bound spec" $
+                ( genSym (EnumGenUpperBound (3 :: Integer)) "a" ::
+                    UnionM Integer
+                )
+                  @?= mrgIf
+                    (isymBool "a" 0)
+                    (mrgSingle 0)
+                    (mrgIf (isymBool "a" 1) (mrgSingle 1) (mrgSingle 2)),
+              testCase "Bound spec" $
+                (genSym (EnumGenBound (-1 :: Integer) 2) "a" :: UnionM Integer)
+                  @?= mrgIf
+                    (isymBool "a" 0)
+                    (mrgSingle (-1))
+                    (mrgIf (isymBool "a" 1) (mrgSingle 0) (mrgSingle 1))
+            ],
+          testGroup
+            "Char"
+            [ testGroup
+                "Char spec"
+                [ testCase "genSym" $
+                    (genSym 'x' "a" :: UnionM Char)
+                      @?= mrgSingle 'x',
+                  testCase "genSymSimple" $
+                    (genSymSimple 'x' "a" :: Char) @?= 'x'
+                ],
+              testCase "Upper bound spec" $
+                (genSym (EnumGenUpperBound @Char (toEnum 3)) "a" :: UnionM Char)
+                  @?= mrgIf
+                    (isymBool "a" 0)
+                    (mrgSingle $ toEnum 0)
+                    ( mrgIf
+                        (isymBool "a" 1)
+                        (mrgSingle $ toEnum 1)
+                        (mrgSingle $ toEnum 2)
+                    ),
+              testCase "Bound spec" $
+                (genSym (EnumGenBound 'a' 'd') "a" :: UnionM Char)
+                  @?= mrgIf
+                    (isymBool "a" 0)
+                    (mrgSingle 'a')
+                    (mrgIf (isymBool "a" 1) (mrgSingle 'b') (mrgSingle 'c'))
+            ],
+          testGroup
+            "Maybe SymBool"
+            [ testGroup
+                "Maybe SymBool spec"
+                [ testGroup
+                    "Nothing"
+                    [ testCase "genSym" $
+                        ( genSym (Nothing :: Maybe SymBool) "a" ::
+                            UnionM (Maybe SymBool)
+                        )
+                          @?= mrgSingle Nothing,
+                      testCase "genSymSimple" $
+                        ( genSymSimple (Nothing :: Maybe SymBool) "a" ::
+                            Maybe SymBool
+                        )
+                          @?= Nothing
+                    ],
+                  testGroup
+                    "Just v"
+                    [ testCase "genSym" $
+                        ( genSym (Just (ssymBool "a")) "a" ::
+                            UnionM (Maybe SymBool)
+                        )
+                          @?= mrgSingle (Just (isymBool "a" 0)),
+                      testCase "genSymSimple" $
+                        ( genSymSimple (Just (ssymBool "a")) "a" ::
+                            Maybe SymBool
+                        )
+                          @?= Just (isymBool "a" 0)
+                    ]
+                ],
+              testCase "() spec" $
+                (genSym () "a" :: UnionM (Maybe SymBool))
+                  @?= mrgIf
+                    (isymBool "a" 0)
+                    (mrgSingle Nothing)
+                    (mrgSingle (Just (isymBool "a" 1)))
+            ],
+          testGroup
+            "Either SymBool SymBool"
+            [ testGroup
+                "Either SymBool SymBool spec"
+                [ testGroup
+                    "Left v"
+                    [ testCase "genSym" $
+                        ( genSym
+                            ( Left (ssymBool "a") ::
+                                Either SymBool SymBool
+                            )
+                            "a" ::
+                            UnionM (Either SymBool SymBool)
+                        )
+                          @?= mrgSingle (Left (isymBool "a" 0)),
+                      testCase "genSymSimple" $
+                        ( genSymSimple
+                            ( Left (ssymBool "a") ::
+                                Either SymBool SymBool
+                            )
+                            "a" ::
+                            Either SymBool SymBool
+                        )
+                          @?= Left (isymBool "a" 0)
+                    ],
+                  testGroup
+                    "Right v"
+                    [ testCase "genSym" $
+                        ( genSym
+                            ( Right (ssymBool "a") ::
+                                Either SymBool SymBool
+                            )
+                            "a" ::
+                            UnionM (Either SymBool SymBool)
+                        )
+                          @?= mrgSingle (Right (isymBool "a" 0)),
+                      testCase "genSymSimple" $
+                        ( genSymSimple
+                            ( Right (ssymBool "a") ::
+                                Either SymBool SymBool
+                            )
+                            "a" ::
+                            Either SymBool SymBool
+                        )
+                          @?= Right (isymBool "a" 0)
+                    ]
+                ],
+              testCase "() spec" $ do
+                (genSym () "a" :: UnionM (Either SymBool SymBool))
+                  @?= mrgIf
+                    (isymBool "a" 0)
+                    (mrgSingle $ Left $ isymBool "a" 1)
+                    (mrgSingle $ Right $ isymBool "a" 2)
+            ],
+          testGroup
+            "lists"
+            [ testGroup
+                "Max length spec"
+                [ testCase "max length = 0" $
+                    (genSym (0 :: Integer) "a" :: UnionM [SymBool])
+                      @?= mrgSingle [],
+                  testCase "max length = 3" $
+                    (genSym (3 :: Integer) "a" :: UnionM [SymBool])
+                      @?= mrgIf
+                        (isymBool "a" 3)
+                        (mrgSingle [])
+                        ( mrgIf
+                            (isymBool "a" 4)
+                            (mrgSingle [isymBool "a" 2])
+                            ( mrgIf
+                                (isymBool "a" 5)
+                                (mrgSingle [isymBool "a" 1, isymBool "a" 2])
+                                ( mrgSingle
+                                    [ isymBool "a" 0,
+                                      isymBool "a" 1,
+                                      isymBool "a" 2
+                                    ]
+                                )
+                            )
+                        )
+                ],
+              testGroup
+                "Min & max length spec"
+                [ testCase "min length = 1, max length = 3" $
+                    (genSym (ListSpec 1 3 ()) "a" :: UnionM [SymBool])
+                      @?= mrgIf
+                        (isymBool "a" 3)
+                        (mrgSingle [isymBool "a" 2])
+                        ( mrgIf
+                            (isymBool "a" 4)
+                            (mrgSingle [isymBool "a" 1, isymBool "a" 2])
+                            ( mrgSingle
+                                [ isymBool "a" 0,
+                                  isymBool "a" 1,
+                                  isymBool "a" 2
+                                ]
+                            )
+                        ),
+                  testCase "min length = 1, max length = 2, nested" $
+                    ( genSym (ListSpec 1 2 (ListSpec 1 2 ())) "a" ::
+                        UnionM [UnionM [SymBool]]
+                    )
+                      @?= mrgIf
+                        (isymBool "a" 6)
+                        ( mrgSingle
+                            [ mrgIf
+                                (isymBool "a" 5)
+                                (mrgSingle [isymBool "a" 4])
+                                (mrgSingle [isymBool "a" 3, isymBool "a" 4])
+                            ]
+                        )
+                        ( mrgSingle
+                            [ mrgIf
+                                (isymBool "a" 2)
+                                (mrgSingle [isymBool "a" 1])
+                                (mrgSingle [isymBool "a" 0, isymBool "a" 1]),
+                              mrgIf
+                                (isymBool "a" 5)
+                                (mrgSingle [isymBool "a" 4])
+                                (mrgSingle [isymBool "a" 3, isymBool "a" 4])
+                            ]
+                        )
+                ],
+              testGroup
+                "Exact length spec"
+                [ testGroup
+                    "length = 2"
+                    [ testCase "genSym" $
+                        (genSym (SimpleListSpec 2 ()) "a" :: UnionM [SymBool])
+                          @?= mrgSingle [isymBool "a" 0, isymBool "a" 1],
+                      testCase "genSymSimple" $
+                        (genSymSimple (SimpleListSpec 2 ()) "a" :: [SymBool])
+                          @?= [isymBool "a" 0, isymBool "a" 1]
+                    ],
+                  testGroup
+                    "length = 2, nested"
+                    [ testCase "genSym" $
+                        ( genSym
+                            (SimpleListSpec 2 (SimpleListSpec 2 ()))
+                            "a" ::
+                            UnionM [[SymBool]]
+                        )
+                          @?= mrgSingle
+                            [ [isymBool "a" 0, isymBool "a" 1],
+                              [isymBool "a" 2, isymBool "a" 3]
+                            ],
+                      testCase "genSymSimple" $
+                        ( genSymSimple
+                            (SimpleListSpec 2 (SimpleListSpec 2 ()))
+                            "a" ::
+                            [[SymBool]]
+                        )
+                          @?= [ [isymBool "a" 0, isymBool "a" 1],
+                                [isymBool "a" 2, isymBool "a" 3]
+                              ]
+                    ]
+                ],
+              testGroup
+                "List with same shape spec"
+                [ testCase "genSym" $
+                    ( genSym
+                        [[conBool True], [ssymBool "a", ssymBool "b"]]
+                        "a" ::
+                        UnionM [[SymBool]]
+                    )
+                      @?= mrgSingle
+                        [ [isymBool "a" 0],
+                          [isymBool "a" 1, isymBool "a" 2]
+                        ],
+                  testCase "genSymSimple" $
+                    ( genSymSimple
+                        [ [conBool True],
+                          [ssymBool "a", ssymBool "b"]
+                        ]
+                        "a" ::
+                        [[SymBool]]
+                    )
+                      @?= [[isymBool "a" 0], [isymBool "a" 1, isymBool "a" 2]]
+                ]
+            ],
+          testGroup
+            "()"
+            [ testCase "() spec" $ do
+                (genSym () "a" :: UnionM ()) @?= mrgSingle ()
+                (genSymSimple () "a" :: ()) @?= ()
+            ],
+          testGroup
+            "(,)"
+            [ testGroup
+                "Some spec"
+                [ testCase "genSym" $
+                    ( genSym
+                        ( EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2
+                        )
+                        "a" ::
+                        UnionM (Integer, Integer)
+                    )
+                      @?= do
+                        x1 <- mrgIf (isymBool "a" 0) (mrgSingle 0) (mrgSingle 1)
+                        x2 <- mrgIf (isymBool "a" 1) (mrgSingle 0) (mrgSingle 1)
+                        mrgSingle (x1, x2),
+                  testCase "genSymSimple" $
+                    ( genSymSimple
+                        ( (),
+                          [ [ssymBool "b"],
+                            [ssymBool "b", ssymBool "c"]
+                          ]
+                        )
+                        "a" ::
+                        (SymBool, [[SymBool]])
+                    )
+                      @?= ( isymBool "a" 0,
+                            [ [isymBool "a" 1],
+                              [isymBool "a" 2, isymBool "a" 3]
+                            ]
+                          )
+                ],
+              testGroup
+                "No spec"
+                [ testCase "genSym" $
+                    (genSym () "a" :: UnionM (SymBool, SymBool))
+                      @?= mrgSingle (isymBool "a" 0, isymBool "a" 1),
+                  testCase "genSymSimple" $
+                    (genSymSimple () "a" :: (SymBool, SymBool))
+                      @?= (isymBool "a" 0, isymBool "a" 1)
+                ]
+            ],
+          testGroup
+            "(,,)"
+            [ testGroup
+                "Some spec"
+                [ testCase "genSym" $
+                    ( genSym
+                        ( EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2
+                        )
+                        "a" ::
+                        UnionM (Integer, Integer, Integer)
+                    )
+                      @?= do
+                        x1 <- mrgIf (isymBool "a" 0) (mrgSingle 0) (mrgSingle 1)
+                        x2 <- mrgIf (isymBool "a" 1) (mrgSingle 0) (mrgSingle 1)
+                        x3 <- mrgIf (isymBool "a" 2) (mrgSingle 0) (mrgSingle 1)
+                        mrgSingle (x1, x2, x3),
+                  testCase "genSymSimple" $
+                    ( genSymSimple
+                        ((), [[ssymBool "b"], [ssymBool "b", ssymBool "c"]], ())
+                        "a" ::
+                        (SymBool, [[SymBool]], SymBool)
+                    )
+                      @?= ( isymBool "a" 0,
+                            [ [isymBool "a" 1],
+                              [isymBool "a" 2, isymBool "a" 3]
+                            ],
+                            isymBool "a" 4
+                          )
+                ],
+              testGroup
+                "No spec"
+                [ testCase "genSym" $
+                    (genSym () "a" :: UnionM (SymBool, SymBool, SymBool))
+                      @?= mrgSingle
+                        (isymBool "a" 0, isymBool "a" 1, isymBool "a" 2),
+                  testCase "genSymSimple" $
+                    (genSymSimple () "a" :: (SymBool, SymBool, SymBool))
+                      @?= (isymBool "a" 0, isymBool "a" 1, isymBool "a" 2)
+                ]
+            ],
+          testGroup
+            "(,,,)"
+            [ testGroup
+                "Some spec"
+                [ testCase "genSym" $
+                    ( genSym
+                        ( EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2
+                        )
+                        "a" ::
+                        UnionM (Integer, Integer, Integer, Integer)
+                    )
+                      @?= do
+                        x1 <- mrgIf (isymBool "a" 0) (mrgSingle 0) (mrgSingle 1)
+                        x2 <- mrgIf (isymBool "a" 1) (mrgSingle 0) (mrgSingle 1)
+                        x3 <- mrgIf (isymBool "a" 2) (mrgSingle 0) (mrgSingle 1)
+                        x4 <- mrgIf (isymBool "a" 3) (mrgSingle 0) (mrgSingle 1)
+                        mrgSingle (x1, x2, x3, x4),
+                  testCase "genSymSimple" $
+                    ( genSymSimple
+                        ( (),
+                          [[ssymBool "b"], [ssymBool "b", ssymBool "c"]],
+                          (),
+                          ()
+                        )
+                        "a" ::
+                        (SymBool, [[SymBool]], SymBool, SymBool)
+                    )
+                      @?= ( isymBool "a" 0,
+                            [ [isymBool "a" 1],
+                              [isymBool "a" 2, isymBool "a" 3]
+                            ],
+                            isymBool "a" 4,
+                            isymBool "a" 5
+                          )
+                ],
+              testGroup
+                "No spec"
+                [ testCase "genSym" $
+                    ( genSym () "a" ::
+                        UnionM (SymBool, SymBool, SymBool, SymBool)
+                    )
+                      @?= mrgSingle
+                        ( isymBool "a" 0,
+                          isymBool "a" 1,
+                          isymBool "a" 2,
+                          isymBool "a" 3
+                        ),
+                  testCase "genSymSimple" $
+                    ( genSymSimple () "a" ::
+                        (SymBool, SymBool, SymBool, SymBool)
+                    )
+                      @?= ( isymBool "a" 0,
+                            isymBool "a" 1,
+                            isymBool "a" 2,
+                            isymBool "a" 3
+                          )
+                ]
+            ],
+          testGroup
+            "(,,,,)"
+            [ testGroup
+                "Some spec"
+                [ testCase "genSym" $
+                    ( genSym
+                        ( EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2
+                        )
+                        "a" ::
+                        UnionM (Integer, Integer, Integer, Integer, Integer)
+                    )
+                      @?= do
+                        x1 <- mrgIf (isymBool "a" 0) (mrgSingle 0) (mrgSingle 1)
+                        x2 <- mrgIf (isymBool "a" 1) (mrgSingle 0) (mrgSingle 1)
+                        x3 <- mrgIf (isymBool "a" 2) (mrgSingle 0) (mrgSingle 1)
+                        x4 <- mrgIf (isymBool "a" 3) (mrgSingle 0) (mrgSingle 1)
+                        x5 <- mrgIf (isymBool "a" 4) (mrgSingle 0) (mrgSingle 1)
+                        mrgSingle (x1, x2, x3, x4, x5),
+                  testCase "genSymSimple" $
+                    ( genSymSimple
+                        ( (),
+                          [ [ssymBool "b"],
+                            [ssymBool "b", ssymBool "c"]
+                          ],
+                          (),
+                          (),
+                          ()
+                        )
+                        "a" ::
+                        (SymBool, [[SymBool]], SymBool, SymBool, SymBool)
+                    )
+                      @?= ( isymBool "a" 0,
+                            [ [isymBool "a" 1],
+                              [isymBool "a" 2, isymBool "a" 3]
+                            ],
+                            isymBool "a" 4,
+                            isymBool "a" 5,
+                            isymBool "a" 6
+                          )
+                ],
+              testGroup
+                "No spec"
+                [ testCase "genSym" $
+                    ( genSym () "a" ::
+                        UnionM (SymBool, SymBool, SymBool, SymBool, SymBool)
+                    )
+                      @?= mrgSingle
+                        ( isymBool "a" 0,
+                          isymBool "a" 1,
+                          isymBool "a" 2,
+                          isymBool "a" 3,
+                          isymBool "a" 4
+                        ),
+                  testCase "genSymSimple" $
+                    ( genSymSimple () "a" ::
+                        (SymBool, SymBool, SymBool, SymBool, SymBool)
+                    )
+                      @?= ( isymBool "a" 0,
+                            isymBool "a" 1,
+                            isymBool "a" 2,
+                            isymBool "a" 3,
+                            isymBool "a" 4
+                          )
+                ]
+            ],
+          testGroup
+            "(,,,,,)"
+            [ testGroup
+                "Some spec"
+                [ testCase "genSym" $
+                    ( genSym
+                        ( EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2
+                        )
+                        "a" ::
+                        UnionM
+                          ( Integer,
+                            Integer,
+                            Integer,
+                            Integer,
+                            Integer,
+                            Integer
+                          )
+                    )
+                      @?= do
+                        x1 <- mrgIf (isymBool "a" 0) (mrgSingle 0) (mrgSingle 1)
+                        x2 <- mrgIf (isymBool "a" 1) (mrgSingle 0) (mrgSingle 1)
+                        x3 <- mrgIf (isymBool "a" 2) (mrgSingle 0) (mrgSingle 1)
+                        x4 <- mrgIf (isymBool "a" 3) (mrgSingle 0) (mrgSingle 1)
+                        x5 <- mrgIf (isymBool "a" 4) (mrgSingle 0) (mrgSingle 1)
+                        x6 <- mrgIf (isymBool "a" 5) (mrgSingle 0) (mrgSingle 1)
+                        mrgSingle (x1, x2, x3, x4, x5, x6),
+                  testCase "genSymSimple" $
+                    ( genSymSimple
+                        ( (),
+                          [ [ssymBool "b"],
+                            [ssymBool "b", ssymBool "c"]
+                          ],
+                          (),
+                          (),
+                          (),
+                          ()
+                        )
+                        "a" ::
+                        ( SymBool,
+                          [[SymBool]],
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool
+                        )
+                    )
+                      @?= ( isymBool "a" 0,
+                            [ [isymBool "a" 1],
+                              [isymBool "a" 2, isymBool "a" 3]
+                            ],
+                            isymBool "a" 4,
+                            isymBool "a" 5,
+                            isymBool "a" 6,
+                            isymBool "a" 7
+                          )
+                ],
+              testGroup
+                "No spec"
+                [ testCase "genSym" $
+                    ( genSym () "a" ::
+                        UnionM
+                          ( SymBool,
+                            SymBool,
+                            SymBool,
+                            SymBool,
+                            SymBool,
+                            SymBool
+                          )
+                    )
+                      @?= mrgSingle
+                        ( isymBool "a" 0,
+                          isymBool "a" 1,
+                          isymBool "a" 2,
+                          isymBool "a" 3,
+                          isymBool "a" 4,
+                          isymBool "a" 5
+                        ),
+                  testCase "genSymSimple" $
+                    ( genSymSimple () "a" ::
+                        ( SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool
+                        )
+                    )
+                      @?= ( isymBool "a" 0,
+                            isymBool "a" 1,
+                            isymBool "a" 2,
+                            isymBool "a" 3,
+                            isymBool "a" 4,
+                            isymBool "a" 5
+                          )
+                ]
+            ],
+          testGroup
+            "(,,,,,,)"
+            [ testGroup
+                "Some spec"
+                [ testCase "genSym" $
+                    ( genSym
+                        ( EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2
+                        )
+                        "a" ::
+                        UnionM
+                          ( Integer,
+                            Integer,
+                            Integer,
+                            Integer,
+                            Integer,
+                            Integer,
+                            Integer
+                          )
+                    )
+                      @?= do
+                        x1 <- mrgIf (isymBool "a" 0) (mrgSingle 0) (mrgSingle 1)
+                        x2 <- mrgIf (isymBool "a" 1) (mrgSingle 0) (mrgSingle 1)
+                        x3 <- mrgIf (isymBool "a" 2) (mrgSingle 0) (mrgSingle 1)
+                        x4 <- mrgIf (isymBool "a" 3) (mrgSingle 0) (mrgSingle 1)
+                        x5 <- mrgIf (isymBool "a" 4) (mrgSingle 0) (mrgSingle 1)
+                        x6 <- mrgIf (isymBool "a" 5) (mrgSingle 0) (mrgSingle 1)
+                        x7 <- mrgIf (isymBool "a" 6) (mrgSingle 0) (mrgSingle 1)
+                        mrgSingle (x1, x2, x3, x4, x5, x6, x7),
+                  testCase "genSymSimple" $
+                    ( genSymSimple
+                        ( (),
+                          [ [ssymBool "b"],
+                            [ssymBool "b", ssymBool "c"]
+                          ],
+                          (),
+                          (),
+                          (),
+                          (),
+                          ()
+                        )
+                        "a" ::
+                        ( SymBool,
+                          [[SymBool]],
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool
+                        )
+                    )
+                      @?= ( isymBool "a" 0,
+                            [ [isymBool "a" 1],
+                              [isymBool "a" 2, isymBool "a" 3]
+                            ],
+                            isymBool "a" 4,
+                            isymBool "a" 5,
+                            isymBool "a" 6,
+                            isymBool "a" 7,
+                            isymBool "a" 8
+                          )
+                ],
+              testGroup
+                "No spec"
+                [ testCase "genSym" $
+                    ( genSym () "a" ::
+                        UnionM
+                          ( SymBool,
+                            SymBool,
+                            SymBool,
+                            SymBool,
+                            SymBool,
+                            SymBool,
+                            SymBool
+                          )
+                    )
+                      @?= mrgSingle
+                        ( isymBool "a" 0,
+                          isymBool "a" 1,
+                          isymBool "a" 2,
+                          isymBool "a" 3,
+                          isymBool "a" 4,
+                          isymBool "a" 5,
+                          isymBool "a" 6
+                        ),
+                  testCase "genSymSimple" $
+                    ( genSymSimple () "a" ::
+                        ( SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool
+                        )
+                    )
+                      @?= ( isymBool "a" 0,
+                            isymBool "a" 1,
+                            isymBool "a" 2,
+                            isymBool "a" 3,
+                            isymBool "a" 4,
+                            isymBool "a" 5,
+                            isymBool "a" 6
+                          )
+                ]
+            ],
+          testGroup
+            "(,,,,,,,)"
+            [ testGroup
+                "Some spec"
+                [ testCase "genSym" $
+                    ( genSym
+                        ( EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2,
+                          EnumGenUpperBound @Integer 2
+                        )
+                        "a" ::
+                        UnionM
+                          ( Integer,
+                            Integer,
+                            Integer,
+                            Integer,
+                            Integer,
+                            Integer,
+                            Integer,
+                            Integer
+                          )
+                    )
+                      @?= do
+                        x1 <- mrgIf (isymBool "a" 0) (mrgSingle 0) (mrgSingle 1)
+                        x2 <- mrgIf (isymBool "a" 1) (mrgSingle 0) (mrgSingle 1)
+                        x3 <- mrgIf (isymBool "a" 2) (mrgSingle 0) (mrgSingle 1)
+                        x4 <- mrgIf (isymBool "a" 3) (mrgSingle 0) (mrgSingle 1)
+                        x5 <- mrgIf (isymBool "a" 4) (mrgSingle 0) (mrgSingle 1)
+                        x6 <- mrgIf (isymBool "a" 5) (mrgSingle 0) (mrgSingle 1)
+                        x7 <- mrgIf (isymBool "a" 6) (mrgSingle 0) (mrgSingle 1)
+                        x8 <- mrgIf (isymBool "a" 7) (mrgSingle 0) (mrgSingle 1)
+                        mrgSingle (x1, x2, x3, x4, x5, x6, x7, x8),
+                  testCase "genSymSimple" $
+                    ( genSymSimple
+                        ( (),
+                          [ [ssymBool "b"],
+                            [ssymBool "b", ssymBool "c"]
+                          ],
+                          (),
+                          (),
+                          (),
+                          (),
+                          (),
+                          ()
+                        )
+                        "a" ::
+                        ( SymBool,
+                          [[SymBool]],
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool
+                        )
+                    )
+                      @?= ( isymBool "a" 0,
+                            [ [isymBool "a" 1],
+                              [isymBool "a" 2, isymBool "a" 3]
+                            ],
+                            isymBool "a" 4,
+                            isymBool "a" 5,
+                            isymBool "a" 6,
+                            isymBool "a" 7,
+                            isymBool "a" 8,
+                            isymBool "a" 9
+                          )
+                ],
+              testGroup
+                "No spec"
+                [ testCase "genSym" $
+                    ( genSym () "a" ::
+                        UnionM
+                          ( SymBool,
+                            SymBool,
+                            SymBool,
+                            SymBool,
+                            SymBool,
+                            SymBool,
+                            SymBool,
+                            SymBool
+                          )
+                    )
+                      @?= mrgSingle
+                        ( isymBool "a" 0,
+                          isymBool "a" 1,
+                          isymBool "a" 2,
+                          isymBool "a" 3,
+                          isymBool "a" 4,
+                          isymBool "a" 5,
+                          isymBool "a" 6,
+                          isymBool "a" 7
+                        ),
+                  testCase "genSymSimple" $
+                    ( genSymSimple () "a" ::
+                        ( SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool
+                        )
+                    )
+                      @?= ( isymBool "a" 0,
+                            isymBool "a" 1,
+                            isymBool "a" 2,
+                            isymBool "a" 3,
+                            isymBool "a" 4,
+                            isymBool "a" 5,
+                            isymBool "a" 6,
+                            isymBool "a" 7
+                          )
+                ]
+            ],
+          testGroup
+            "MaybeT Maybe SymBool"
+            [ testGroup
+                "Same shape spec"
+                [ testGroup
+                    "MaybeT Nothing"
+                    [ testCase "genSym" $
+                        ( genSym (MaybeT Nothing :: MaybeT Maybe SymBool) "a" ::
+                            UnionM (MaybeT Maybe SymBool)
+                        )
+                          @?= mrgSingle (MaybeT Nothing),
+                      testCase "genSymSimple" $
+                        ( genSymSimple
+                            (MaybeT Nothing :: MaybeT Maybe SymBool)
+                            "a" ::
+                            MaybeT Maybe SymBool
+                        )
+                          @?= MaybeT Nothing
+                    ],
+                  testGroup
+                    "MaybeT (Just Nothing)"
+                    [ testCase "genSym" $
+                        ( genSym
+                            ( MaybeT (Just Nothing) ::
+                                MaybeT Maybe SymBool
+                            )
+                            "a" ::
+                            UnionM (MaybeT Maybe SymBool)
+                        )
+                          @?= mrgSingle (MaybeT (Just Nothing)),
+                      testCase "genSymSimple" $
+                        ( genSymSimple
+                            ( MaybeT (Just (Just $ ssymBool "a")) ::
+                                MaybeT Maybe SymBool
+                            )
+                            "a" ::
+                            MaybeT Maybe SymBool
+                        )
+                          @?= MaybeT (Just (Just $ isymBool "a" 0))
+                    ],
+                  testGroup
+                    "MaybeT (Just (Just v))"
+                    [ testCase "genSym" $
+                        ( genSym
+                            ( MaybeT (Just (Just $ ssymBool "a")) ::
+                                MaybeT Maybe SymBool
+                            )
+                            "a" ::
+                            UnionM (MaybeT Maybe SymBool)
+                        )
+                          @?= mrgSingle (MaybeT (Just (Just $ isymBool "a" 0))),
+                      testCase "genSymSimple" $
+                        ( genSymSimple
+                            ( MaybeT (Just (Just $ ssymBool "a")) ::
+                                MaybeT Maybe SymBool
+                            )
+                            "a" ::
+                            MaybeT Maybe SymBool
+                        )
+                          @?= MaybeT (Just (Just $ isymBool "a" 0))
+                    ]
+                ],
+              testCase "No spec" $
+                (genSym () "a" :: UnionM (MaybeT Maybe SymBool))
+                  @?= mrgIf
+                    (isymBool "a" 0)
+                    (mrgSingle $ MaybeT Nothing)
+                    ( mrgIf
+                        (isymBool "a" 1)
+                        (mrgSingle $ MaybeT $ Just Nothing)
+                        (mrgSingle $ MaybeT $ Just $ Just $ isymBool "a" 2)
+                    ),
+              testGroup
+                "Maybe (Maybe SymBool) spec"
+                [ testGroup
+                    "Nothing"
+                    [ testCase "genSym" $
+                        ( genSym (Nothing :: Maybe (Maybe SymBool)) "a" ::
+                            UnionM (MaybeT Maybe SymBool)
+                        )
+                          @?= mrgSingle (MaybeT Nothing),
+                      testCase "genSymSimple" $
+                        ( genSymSimple (Nothing :: Maybe (Maybe SymBool)) "a" ::
+                            MaybeT Maybe SymBool
+                        )
+                          @?= MaybeT Nothing
+                    ],
+                  testGroup
+                    "Just Nothing"
+                    [ testCase "genSym" $
+                        ( genSym (Just Nothing :: Maybe (Maybe SymBool)) "a" ::
+                            UnionM (MaybeT Maybe SymBool)
+                        )
+                          @?= mrgSingle (MaybeT (Just Nothing)),
+                      testCase "genSymSimple" $
+                        ( genSymSimple
+                            (Just Nothing :: Maybe (Maybe SymBool))
+                            "a" ::
+                            MaybeT Maybe SymBool
+                        )
+                          @?= MaybeT (Just Nothing)
+                    ],
+                  testGroup
+                    "Just (Just v)"
+                    [ testCase "genSym" $
+                        ( genSym
+                            ( Just $ Just $ ssymBool "a" ::
+                                Maybe (Maybe SymBool)
+                            )
+                            "a" ::
+                            UnionM (MaybeT Maybe SymBool)
+                        )
+                          @?= mrgSingle (MaybeT (Just (Just $ isymBool "a" 0))),
+                      testCase "genSymSimple" $
+                        ( genSymSimple
+                            ( Just $ Just $ ssymBool "a" ::
+                                Maybe (Maybe SymBool)
+                            )
+                            "a" ::
+                            MaybeT Maybe SymBool
+                        )
+                          @?= MaybeT (Just (Just $ isymBool "a" 0))
+                    ]
+                ]
+            ],
+          testGroup
+            "ExceptT SymBool Maybe SymBool"
+            [ testGroup
+                "Same shape spec"
+                [ testGroup
+                    "ExceptT Nothing"
+                    [ testCase "genSym" $
+                        ( genSym
+                            ( ExceptT Nothing ::
+                                ExceptT SymBool Maybe SymBool
+                            )
+                            "a" ::
+                            UnionM (ExceptT SymBool Maybe SymBool)
+                        )
+                          @?= mrgSingle (ExceptT Nothing),
+                      testCase "genSymSimple" $
+                        ( genSymSimple
+                            ( ExceptT Nothing ::
+                                ExceptT SymBool Maybe SymBool
+                            )
+                            "a" ::
+                            ExceptT SymBool Maybe SymBool
+                        )
+                          @?= ExceptT Nothing
+                    ],
+                  testGroup
+                    "ExceptT (Just (Left v))"
+                    [ testCase "genSym" $
+                        ( genSym
+                            ( ExceptT $ Just $ Left $ ssymBool "a" ::
+                                ExceptT SymBool Maybe SymBool
+                            )
+                            "a" ::
+                            UnionM (ExceptT SymBool Maybe SymBool)
+                        )
+                          @?= mrgSingle
+                            (ExceptT $ Just $ Left $ isymBool "a" 0),
+                      testCase "genSymSimple" $
+                        ( genSymSimple
+                            ( ExceptT $ Just $ Left $ ssymBool "a" ::
+                                ExceptT SymBool Maybe SymBool
+                            )
+                            "a" ::
+                            ExceptT SymBool Maybe SymBool
+                        )
+                          @?= ExceptT (Just $ Left $ isymBool "a" 0)
+                    ],
+                  testGroup
+                    "ExceptT (Just (Right v))"
+                    [ testCase "genSym" $
+                        ( genSym
+                            ( ExceptT $ Just $ Right $ ssymBool "a" ::
+                                ExceptT SymBool Maybe SymBool
+                            )
+                            "a" ::
+                            UnionM (ExceptT SymBool Maybe SymBool)
+                        )
+                          @?= mrgSingle
+                            (ExceptT $ Just $ Right $ isymBool "a" 0),
+                      testCase "genSymSimple" $
+                        ( genSymSimple
+                            ( ExceptT $ Just $ Right $ ssymBool "a" ::
+                                ExceptT SymBool Maybe SymBool
+                            )
+                            "a" ::
+                            ExceptT SymBool Maybe SymBool
+                        )
+                          @?= ExceptT (Just $ Right $ isymBool "a" 0)
+                    ]
+                ],
+              testCase "() spec" $ do
+                (genSym () "a" :: UnionM (ExceptT SymBool Maybe SymBool))
+                  @?= mrgIf
+                    (isymBool "a" 0)
+                    (mrgSingle $ ExceptT Nothing)
+                    ( mrgIf
+                        (isymBool "a" 1)
+                        (mrgSingle $ ExceptT $ Just $ Left $ isymBool "a" 2)
+                        (mrgSingle $ ExceptT $ Just $ Right $ isymBool "a" 3)
+                    ),
+              testGroup
+                "Maybe (Either SymBool SymBool) spec"
+                [ testGroup
+                    "Nothing"
+                    [ testCase "genSym" $
+                        ( genSym
+                            (Nothing :: Maybe (Either SymBool SymBool))
+                            "a" ::
+                            UnionM (ExceptT SymBool Maybe SymBool)
+                        )
+                          @?= mrgSingle (ExceptT Nothing),
+                      testCase "genSymSimple" $
+                        ( genSymSimple
+                            (Nothing :: Maybe (Either SymBool SymBool))
+                            "a" ::
+                            ExceptT SymBool Maybe SymBool
+                        )
+                          @?= ExceptT Nothing
+                    ],
+                  testGroup
+                    "Just (left v)"
+                    [ testCase "genSym" $
+                        ( genSym
+                            ( Just $ Left $ ssymBool "a" ::
+                                Maybe (Either SymBool SymBool)
+                            )
+                            "a" ::
+                            UnionM (ExceptT SymBool Maybe SymBool)
+                        )
+                          @?= mrgSingle
+                            (ExceptT (Just (Left $ isymBool "a" 0))),
+                      testCase "genSymSimple" $
+                        ( genSymSimple
+                            ( Just $ Left $ ssymBool "a" ::
+                                Maybe (Either SymBool SymBool)
+                            )
+                            "a" ::
+                            ExceptT SymBool Maybe SymBool
+                        )
+                          @?= ExceptT (Just (Left $ isymBool "a" 0))
+                    ],
+                  testGroup
+                    "Just (left v)"
+                    [ testCase "genSym" $
+                        ( genSym
+                            ( Just $ Right $ ssymBool "a" ::
+                                Maybe (Either SymBool SymBool)
+                            )
+                            "a" ::
+                            UnionM (ExceptT SymBool Maybe SymBool)
+                        )
+                          @?= mrgSingle
+                            (ExceptT (Just (Right $ isymBool "a" 0))),
+                      testCase "genSymSimple" $
+                        ( genSymSimple
+                            ( Just $ Right $ ssymBool "a" ::
+                                Maybe (Either SymBool SymBool)
+                            )
+                            "a" ::
+                            ExceptT SymBool Maybe SymBool
+                        )
+                          @?= ExceptT (Just (Right $ isymBool "a" 0))
+                    ]
+                ]
+            ]
+        ],
+      testGroup
+        "choose*"
+        [ testCase "chooseFresh" $ do
+            (runFresh (chooseFresh [1, 2, 3]) "a" :: UnionM Int)
+              @?= mrgIf
+                (isymBool "a" 0)
+                (mrgSingle 1)
+                (mrgIf (isymBool "a" 1) (mrgSingle 2) (mrgSingle 3)),
+          testCase "choose" $ do
+            (choose [1, 2, 3] "a" :: UnionM Int)
+              @?= mrgIf
+                (isymBool "a" 0)
+                (mrgSingle 1)
+                (mrgIf (isymBool "a" 1) (mrgSingle 2) (mrgSingle 3)),
+          testCase "chooseSimpleFresh" $ do
+            (runFresh (chooseSimpleFresh ["x", "y", "z"]) "a" :: SymBool)
+              @?= symIte
+                (isymBool "a" 0)
+                (ssymBool "x")
+                (symIte (isymBool "a" 1) (ssymBool "y") (ssymBool "z")),
+          testCase "chooseSimple" $ do
+            (chooseSimple ["x", "y", "z"] "a" :: SymBool)
+              @?= symIte
+                (isymBool "a" 0)
+                (ssymBool "x")
+                (symIte (isymBool "a" 1) (ssymBool "y") (ssymBool "z")),
+          testCase "chooseUnionFresh" $ do
+            ( runFresh
+                ( chooseUnionFresh
+                    [ mrgIf (ssymBool "x") 1 2,
+                      mrgIf (ssymBool "x") 2 3,
+                      mrgIf (ssymBool "x") 3 4
+                    ]
+                )
+                "a" ::
+                UnionM Int
+              )
+              @?= mrgIf
+                (isymBool "a" 0)
+                (mrgIf (ssymBool "x") 1 2)
+                ( mrgIf
+                    (isymBool "a" 1)
+                    (mrgIf (ssymBool "x") 2 3)
+                    (mrgIf (ssymBool "x") 3 4)
+                ),
+          testCase "chooseUnion" $ do
+            ( chooseUnion
+                [ mrgIf (ssymBool "x") 1 2,
+                  mrgIf (ssymBool "x") 2 3,
+                  mrgIf (ssymBool "x") 3 4
+                ]
+                "a" ::
+                UnionM Int
+              )
+              @?= mrgIf
+                (isymBool "a" 0)
+                (mrgIf (ssymBool "x") 1 2)
+                ( mrgIf
+                    (isymBool "a" 1)
+                    (mrgIf (ssymBool "x") 2 3)
+                    (mrgIf (ssymBool "x") 3 4)
+                ),
+          testCase "liftFresh" $ do
+            let orig = simpleFresh () :: Fresh (SymBool, SymBool)
+            let actual = flip runFreshT "a" $ do
+                  r1 <- liftFresh orig
+                  r2 <- liftFresh orig
+                  return (r1, r2) ::
+                    FreshT UnionM ((SymBool, SymBool), (SymBool, SymBool))
+            let expected =
+                  return
+                    ( (isymBool "a" 0, isymBool "a" 1),
+                      (isymBool "a" 2, isymBool "a" 3)
+                    )
+            actual @?= expected
+        ]
+    ]
diff --git a/test/Grisette/Core/Data/Class/MergeableTests.hs b/test/Grisette/Core/Data/Class/MergeableTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/MergeableTests.hs
@@ -0,0 +1,1083 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+module Grisette.Core.Data.Class.MergeableTests (mergeableTests) where
+
+import Control.Monad.Cont (ContT (ContT, runContT))
+import Control.Monad.Except (ExceptT (ExceptT))
+import Control.Monad.Identity
+  ( Identity (Identity),
+    IdentityT (IdentityT),
+  )
+import qualified Control.Monad.RWS.Lazy as RWSTLazy
+import qualified Control.Monad.RWS.Strict as RWSTStrict
+import Control.Monad.Reader (ReaderT (ReaderT, runReaderT))
+import qualified Control.Monad.State.Lazy as StateLazy
+import qualified Control.Monad.State.Strict as StateStrict
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import qualified Control.Monad.Writer.Lazy as WriterLazy
+import qualified Control.Monad.Writer.Strict as WriterStrict
+import qualified Data.ByteString.Char8 as C
+import Data.Functor.Sum (Sum (InL, InR))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.Stack (HasCallStack)
+import Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&), (.||)))
+import Grisette.Core.Data.Class.Mergeable
+  ( DynamicSortedIdx (DynamicSortedIdx),
+    Mergeable (rootStrategy),
+    MergingStrategy (NoStrategy, SimpleStrategy),
+    StrategyList (StrategyList),
+    buildStrategyList,
+    resolveStrategy,
+  )
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( mrgIf,
+    mrgSingle,
+  )
+import Grisette.Core.Data.Class.Solvable (Solvable (con, ssym))
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit (Assertion, assertFailure, (@?=))
+import Test.QuickCheck (ioProperty)
+
+testMergeableSimpleEquivClass ::
+  (HasCallStack, Mergeable x, Show x, Eq x) =>
+  x ->
+  [DynamicSortedIdx] ->
+  [(SymBool, x, x, x)] ->
+  Assertion
+testMergeableSimpleEquivClass x idxs cases = do
+  let (idxsT, s) = resolveStrategy rootStrategy x
+  case s of
+    SimpleStrategy m -> do
+      idxsT @?= idxs
+      go cases
+      where
+        go [] = return ()
+        go ((c, t, f, r) : xs) = do
+          fst (resolveStrategy rootStrategy t) @?= idxs
+          fst (resolveStrategy rootStrategy f) @?= idxs
+          fst (resolveStrategy rootStrategy r) @?= idxs
+          m c t f @?= r
+          go xs
+    _ -> assertFailure $ "Bad strategy type for " ++ show x
+
+mergeableTests :: Test
+mergeableTests =
+  testGroup
+    "Mergeable"
+    [ testGroup
+        "Mergeable for common types"
+        [ let SimpleStrategy f = rootStrategy :: MergingStrategy SymBool
+           in testGroup
+                "Mergeable for SymBool"
+                [ testCase "true condition" $
+                    f (con True) (ssym "a") (ssym "b") @?= ssym "a",
+                  testCase "false condition" $
+                    f (con False) (ssym "a") (ssym "b") @?= ssym "b",
+                  testCase "general condition" $
+                    f (ssym "a") (ssym "b") (ssym "c")
+                      @?= symIte (ssym "a") (ssym "b") (ssym "c")
+                ],
+          testProperty "Bool" $
+            ioProperty . \(x :: Bool) ->
+              testMergeableSimpleEquivClass
+                x
+                [DynamicSortedIdx x]
+                [(ssym "a", x, x, x)],
+          testProperty "Integer" $
+            ioProperty . \(x :: Integer) ->
+              testMergeableSimpleEquivClass
+                x
+                [DynamicSortedIdx x]
+                [(ssym "a", x, x, x)],
+          testProperty "Char" $
+            ioProperty . \(x :: Char) ->
+              testMergeableSimpleEquivClass
+                x
+                [DynamicSortedIdx x]
+                [(ssym "a", x, x, x)],
+          testProperty "Int" $
+            ioProperty . \(x :: Int) ->
+              testMergeableSimpleEquivClass
+                x
+                [DynamicSortedIdx x]
+                [(ssym "a", x, x, x)],
+          testProperty "Int8" $
+            ioProperty . \(x :: Int8) ->
+              testMergeableSimpleEquivClass
+                x
+                [DynamicSortedIdx x]
+                [(ssym "a", x, x, x)],
+          testProperty "Int16" $
+            ioProperty . \(x :: Int16) ->
+              testMergeableSimpleEquivClass
+                x
+                [DynamicSortedIdx x]
+                [(ssym "a", x, x, x)],
+          testProperty "Int32" $
+            ioProperty . \(x :: Int32) ->
+              testMergeableSimpleEquivClass
+                x
+                [DynamicSortedIdx x]
+                [(ssym "a", x, x, x)],
+          testProperty "Int64" $
+            ioProperty . \(x :: Int64) ->
+              testMergeableSimpleEquivClass
+                x
+                [DynamicSortedIdx x]
+                [(ssym "a", x, x, x)],
+          testProperty "Word" $
+            ioProperty . \(x :: Word) ->
+              testMergeableSimpleEquivClass
+                x
+                [DynamicSortedIdx x]
+                [(ssym "a", x, x, x)],
+          testProperty "Word8" $
+            ioProperty . \(x :: Word8) ->
+              testMergeableSimpleEquivClass
+                x
+                [DynamicSortedIdx x]
+                [(ssym "a", x, x, x)],
+          testProperty "Word16" $
+            ioProperty . \(x :: Word16) ->
+              testMergeableSimpleEquivClass
+                x
+                [DynamicSortedIdx x]
+                [(ssym "a", x, x, x)],
+          testProperty "Word32" $
+            ioProperty . \(x :: Word32) ->
+              testMergeableSimpleEquivClass
+                x
+                [DynamicSortedIdx x]
+                [(ssym "a", x, x, x)],
+          testProperty "Word64" $
+            ioProperty . \(x :: Word64) ->
+              testMergeableSimpleEquivClass
+                x
+                [DynamicSortedIdx x]
+                [(ssym "a", x, x, x)],
+          testProperty "()" $
+            ioProperty . \(x :: ()) ->
+              testMergeableSimpleEquivClass x [] [(ssym "a", x, x, x)],
+          testProperty "ByteString" $
+            ioProperty . \(x :: String) ->
+              let b = C.pack x
+               in testMergeableSimpleEquivClass
+                    b
+                    [DynamicSortedIdx b]
+                    [(ssym "a", b, b, b)],
+          testGroup
+            "Either"
+            [ testGroup
+                "Either Integer Integer"
+                [ testProperty "Left x" $
+                    ioProperty . \(x :: Integer) -> do
+                      testMergeableSimpleEquivClass
+                        (Left x :: Either Integer Integer)
+                        [DynamicSortedIdx False, DynamicSortedIdx x]
+                        [(ssym "a", Left x, Left x, Left x)],
+                  testProperty "Right x" $
+                    ioProperty . \(x :: Integer) -> do
+                      testMergeableSimpleEquivClass
+                        (Right x :: Either Integer Integer)
+                        [DynamicSortedIdx True, DynamicSortedIdx x]
+                        [(ssym "a", Right x, Right x, Right x)]
+                ],
+              testGroup
+                "Either SymBool SymBool"
+                [ testCase "Left v" $ do
+                    let (idxsL, SimpleStrategy fL) =
+                          resolveStrategy
+                            rootStrategy
+                            (Left (ssym "a") :: Either SymBool SymBool)
+                    idxsL @?= [DynamicSortedIdx False]
+                    fL (ssym "a") (Left $ ssym "b") (Left $ ssym "c")
+                      @?= Left (symIte (ssym "a") (ssym "b") (ssym "c")),
+                  testCase "Right v" $ do
+                    let (idxsR, SimpleStrategy fR) =
+                          resolveStrategy
+                            rootStrategy
+                            (Right (ssym "a") :: Either SymBool SymBool)
+                    idxsR @?= [DynamicSortedIdx True]
+                    fR (ssym "a") (Right $ ssym "b") (Right $ ssym "c")
+                      @?= Right (symIte (ssym "a") (ssym "b") (ssym "c"))
+                ]
+            ],
+          testGroup
+            "Maybe"
+            [ testGroup
+                "Maybe Integer"
+                [ testProperty "Nothing" $
+                    ioProperty . \(_ :: Integer) -> do
+                      testMergeableSimpleEquivClass
+                        (Nothing :: Maybe Integer)
+                        [DynamicSortedIdx False]
+                        [(ssym "a", Nothing, Nothing, Nothing)],
+                  testProperty "Just v" $
+                    ioProperty . \(x :: Integer) -> do
+                      testMergeableSimpleEquivClass
+                        (Just x :: Maybe Integer)
+                        [DynamicSortedIdx True, DynamicSortedIdx x]
+                        [(ssym "a", Just x, Just x, Just x)]
+                ],
+              testCase "Maybe SymBool / Just v" $ do
+                let (idxsJ, SimpleStrategy fJ) =
+                      resolveStrategy
+                        rootStrategy
+                        (Just (ssym "a") :: Maybe SymBool)
+                idxsJ @?= [DynamicSortedIdx True]
+                fJ (ssym "a") (Just $ ssym "b") (Just $ ssym "c")
+                  @?= Just (symIte (ssym "a") (ssym "b") (ssym "c"))
+            ],
+          testGroup
+            "List"
+            [ testCase "BuildStrategyList" $ do
+                case buildStrategyList @Integer rootStrategy [1, 2, 3] of
+                  StrategyList idxs _ -> do
+                    idxs
+                      @?= [ [DynamicSortedIdx (1 :: Integer)],
+                            [DynamicSortedIdx (2 :: Integer)],
+                            [DynamicSortedIdx (3 :: Integer)]
+                          ],
+              testProperty "List for ordered type" $
+                ioProperty . \(x :: [Integer]) -> do
+                  testMergeableSimpleEquivClass
+                    x
+                    [ DynamicSortedIdx (length x),
+                      DynamicSortedIdx $ buildStrategyList rootStrategy x
+                    ]
+                    [(ssym "a", x, x, x)],
+              testProperty "Nested List for ordered type" $
+                ioProperty . \(x :: [[Integer]]) -> do
+                  testMergeableSimpleEquivClass
+                    x
+                    [ DynamicSortedIdx (length x),
+                      DynamicSortedIdx $ buildStrategyList rootStrategy x
+                    ]
+                    [(ssym "a", x, x, x)],
+              testGroup
+                "[SymBool]"
+                [ testCase "[]" $
+                    testMergeableSimpleEquivClass
+                      ([] :: [SymBool])
+                      [DynamicSortedIdx (0 :: Int)]
+                      [(ssym "a", [], [], [])],
+                  testCase "[v1, v2]" $
+                    testMergeableSimpleEquivClass
+                      [ssym "a" :: SymBool, ssym "b"]
+                      [DynamicSortedIdx (2 :: Int)]
+                      [ ( ssym "a",
+                          [ssym "b", ssym "c"],
+                          [ssym "d", ssym "e"],
+                          [ symIte (ssym "a") (ssym "b") (ssym "d"),
+                            symIte (ssym "a") (ssym "c") (ssym "e")
+                          ]
+                        )
+                      ]
+                ]
+            ],
+          testCase "(,)" $
+            testMergeableSimpleEquivClass
+              ([1 :: Integer], [ssym "b" :: SymBool, ssym "c"])
+              [ DynamicSortedIdx (1 :: Int),
+                DynamicSortedIdx $
+                  buildStrategyList rootStrategy [1 :: Integer],
+                DynamicSortedIdx (2 :: Int)
+              ]
+              [ ( ssym "a",
+                  ([1], [ssym "c", ssym "d"]),
+                  ([1], [ssym "f", ssym "g"]),
+                  ( [1],
+                    [ symIte (ssym "a") (ssym "c") (ssym "f"),
+                      symIte (ssym "a") (ssym "d") (ssym "g")
+                    ]
+                  )
+                )
+              ],
+          testCase "(,,)" $
+            testMergeableSimpleEquivClass
+              ( [1 :: Integer],
+                [ssym "b" :: SymBool, ssym "c"],
+                ssym "d" :: SymBool
+              )
+              [ DynamicSortedIdx (1 :: Int),
+                DynamicSortedIdx $
+                  buildStrategyList rootStrategy [1 :: Integer],
+                DynamicSortedIdx (2 :: Int)
+              ]
+              [ ( ssym "a",
+                  ([1], [ssym "c", ssym "d"], ssym "e"),
+                  ([1], [ssym "f", ssym "g"], ssym "h"),
+                  ( [1],
+                    [ symIte (ssym "a") (ssym "c") (ssym "f"),
+                      symIte (ssym "a") (ssym "d") (ssym "g")
+                    ],
+                    symIte (ssym "a") (ssym "e") (ssym "h")
+                  )
+                )
+              ],
+          testCase "(,,,)" $
+            testMergeableSimpleEquivClass
+              ( [1 :: Integer],
+                [ssym "b" :: SymBool, ssym "c"],
+                ssym "d" :: SymBool,
+                [ssym "f" :: SymBool]
+              )
+              [ DynamicSortedIdx (1 :: Int),
+                DynamicSortedIdx $
+                  buildStrategyList rootStrategy [1 :: Integer],
+                DynamicSortedIdx (2 :: Int),
+                DynamicSortedIdx (1 :: Int)
+              ]
+              [ ( ssym "a",
+                  ([1], [ssym "c", ssym "d"], ssym "e", [ssym "i"]),
+                  ([1], [ssym "f", ssym "g"], ssym "h", [ssym "j"]),
+                  ( [1],
+                    [ symIte (ssym "a") (ssym "c") (ssym "f"),
+                      symIte (ssym "a") (ssym "d") (ssym "g")
+                    ],
+                    symIte (ssym "a") (ssym "e") (ssym "h"),
+                    [symIte (ssym "a") (ssym "i") (ssym "j")]
+                  )
+                )
+              ],
+          testCase "(,,,,)" $
+            testMergeableSimpleEquivClass
+              ( [1 :: Integer],
+                [ssym "b" :: SymBool, ssym "c"],
+                ssym "d" :: SymBool,
+                [ssym "f" :: SymBool],
+                [2 :: Integer, 3]
+              )
+              [ DynamicSortedIdx (1 :: Int),
+                DynamicSortedIdx $
+                  buildStrategyList rootStrategy [1 :: Integer],
+                DynamicSortedIdx (2 :: Int),
+                DynamicSortedIdx (1 :: Int),
+                DynamicSortedIdx (2 :: Int),
+                DynamicSortedIdx $
+                  buildStrategyList rootStrategy [2 :: Integer, 3]
+              ]
+              [ ( ssym "a",
+                  ([1], [ssym "c", ssym "d"], ssym "e", [ssym "i"], [2, 3]),
+                  ([1], [ssym "f", ssym "g"], ssym "h", [ssym "j"], [2, 3]),
+                  ( [1],
+                    [ symIte (ssym "a") (ssym "c") (ssym "f"),
+                      symIte (ssym "a") (ssym "d") (ssym "g")
+                    ],
+                    symIte (ssym "a") (ssym "e") (ssym "h"),
+                    [symIte (ssym "a") (ssym "i") (ssym "j")],
+                    [2, 3]
+                  )
+                )
+              ],
+          testCase "(,,,,,)" $
+            testMergeableSimpleEquivClass
+              ( [1 :: Integer],
+                [ssym "b" :: SymBool, ssym "c"],
+                ssym "d" :: SymBool,
+                [ssym "f" :: SymBool],
+                [2 :: Integer, 3],
+                2 :: Integer
+              )
+              [ DynamicSortedIdx (1 :: Int),
+                DynamicSortedIdx $
+                  buildStrategyList rootStrategy [1 :: Integer],
+                DynamicSortedIdx (2 :: Int),
+                DynamicSortedIdx (1 :: Int),
+                DynamicSortedIdx (2 :: Int),
+                DynamicSortedIdx $
+                  buildStrategyList rootStrategy [2 :: Integer, 3],
+                DynamicSortedIdx (2 :: Integer)
+              ]
+              [ ( ssym "a",
+                  ([1], [ssym "c", ssym "d"], ssym "e", [ssym "i"], [2, 3], 2),
+                  ([1], [ssym "f", ssym "g"], ssym "h", [ssym "j"], [2, 3], 2),
+                  ( [1],
+                    [ symIte (ssym "a") (ssym "c") (ssym "f"),
+                      symIte (ssym "a") (ssym "d") (ssym "g")
+                    ],
+                    symIte (ssym "a") (ssym "e") (ssym "h"),
+                    [symIte (ssym "a") (ssym "i") (ssym "j")],
+                    [2, 3],
+                    2
+                  )
+                )
+              ],
+          testCase "(,,,,,,)" $
+            testMergeableSimpleEquivClass
+              ( [1 :: Integer],
+                [ssym "b" :: SymBool, ssym "c"],
+                ssym "d" :: SymBool,
+                [ssym "f" :: SymBool],
+                [2 :: Integer, 3],
+                2 :: Integer,
+                Just (ssym "a" :: SymBool)
+              )
+              [ DynamicSortedIdx (1 :: Int),
+                DynamicSortedIdx $
+                  buildStrategyList rootStrategy [1 :: Integer],
+                DynamicSortedIdx (2 :: Int),
+                DynamicSortedIdx (1 :: Int),
+                DynamicSortedIdx (2 :: Int),
+                DynamicSortedIdx $
+                  buildStrategyList rootStrategy [2 :: Integer, 3],
+                DynamicSortedIdx (2 :: Integer),
+                DynamicSortedIdx True
+              ]
+              [ ( ssym "a",
+                  ( [1],
+                    [ssym "c", ssym "d"],
+                    ssym "e",
+                    [ssym "i"],
+                    [2, 3],
+                    2,
+                    Just (ssym "k")
+                  ),
+                  ( [1],
+                    [ssym "f", ssym "g"],
+                    ssym "h",
+                    [ssym "j"],
+                    [2, 3],
+                    2,
+                    Just (ssym "l")
+                  ),
+                  ( [1],
+                    [ symIte (ssym "a") (ssym "c") (ssym "f"),
+                      symIte (ssym "a") (ssym "d") (ssym "g")
+                    ],
+                    symIte (ssym "a") (ssym "e") (ssym "h"),
+                    [symIte (ssym "a") (ssym "i") (ssym "j")],
+                    [2, 3],
+                    2,
+                    Just $ symIte (ssym "a") (ssym "k") (ssym "l")
+                  )
+                )
+              ],
+          testCase "(,,,,,,,)" $
+            testMergeableSimpleEquivClass
+              ( [1 :: Integer],
+                [ssym "b" :: SymBool, ssym "c"],
+                ssym "d" :: SymBool,
+                [ssym "f" :: SymBool],
+                [2 :: Integer, 3],
+                2 :: Integer,
+                Just (ssym "a" :: SymBool),
+                Left 1 :: Either Integer Integer
+              )
+              [ DynamicSortedIdx (1 :: Int),
+                DynamicSortedIdx $
+                  buildStrategyList rootStrategy [1 :: Integer],
+                DynamicSortedIdx (2 :: Int),
+                DynamicSortedIdx (1 :: Int),
+                DynamicSortedIdx (2 :: Int),
+                DynamicSortedIdx $
+                  buildStrategyList rootStrategy [2 :: Integer, 3],
+                DynamicSortedIdx (2 :: Integer),
+                DynamicSortedIdx True,
+                DynamicSortedIdx False,
+                DynamicSortedIdx (1 :: Integer)
+              ]
+              [ ( ssym "a",
+                  ( [1],
+                    [ssym "c", ssym "d"],
+                    ssym "e",
+                    [ssym "i"],
+                    [2, 3],
+                    2,
+                    Just (ssym "k"),
+                    Left 1
+                  ),
+                  ( [1],
+                    [ssym "f", ssym "g"],
+                    ssym "h",
+                    [ssym "j"],
+                    [2, 3],
+                    2,
+                    Just (ssym "l"),
+                    Left 1
+                  ),
+                  ( [1],
+                    [ symIte (ssym "a") (ssym "c") (ssym "f"),
+                      symIte (ssym "a") (ssym "d") (ssym "g")
+                    ],
+                    symIte (ssym "a") (ssym "e") (ssym "h"),
+                    [symIte (ssym "a") (ssym "i") (ssym "j")],
+                    [2, 3],
+                    2,
+                    Just $ symIte (ssym "a") (ssym "k") (ssym "l"),
+                    Left 1
+                  )
+                )
+              ],
+          let f1 :: Maybe SymBool -> SymBool =
+                \case Just x -> x; Nothing -> (con True)
+              f2 :: Maybe SymBool -> SymBool =
+                \case Just x -> (symNot x); Nothing -> (con False)
+           in testGroup
+                "Function"
+                [ testCase "Simply mergeable result" $ do
+                    case rootStrategy ::
+                           MergingStrategy (Maybe SymBool -> SymBool) of
+                      SimpleStrategy f -> do
+                        let r = f (ssym "a") f1 f2
+                        r (Just (ssym "x"))
+                          @?= symIte (ssym "a") (ssym "x") (symNot (ssym "x"))
+                        r Nothing @?= symIte (ssym "a") (con True) (con False)
+                      _ -> assertFailure "Bad mergeable strategy type",
+                  testCase "Other mergeable result" $ do
+                    case rootStrategy ::
+                           MergingStrategy (Maybe SymBool -> Integer) of
+                      NoStrategy -> return ()
+                      _ -> assertFailure "Bad mergeable strategy type"
+                ],
+          testGroup
+            "MaybeT"
+            [ testGroup
+                "MaybeT Maybe Integer"
+                [ testCase "MaybeT Nothing" $
+                    testMergeableSimpleEquivClass
+                      (MaybeT Nothing :: MaybeT Maybe Integer)
+                      [DynamicSortedIdx False]
+                      [ ( ssym "a",
+                          MaybeT Nothing,
+                          MaybeT Nothing,
+                          MaybeT Nothing
+                        )
+                      ],
+                  testCase "MaybeT (Just Nothing)" $
+                    testMergeableSimpleEquivClass
+                      (MaybeT $ Just Nothing :: MaybeT Maybe Integer)
+                      [DynamicSortedIdx True, DynamicSortedIdx False]
+                      [ ( ssym "a",
+                          MaybeT $ Just Nothing,
+                          MaybeT $ Just Nothing,
+                          MaybeT $ Just Nothing
+                        )
+                      ],
+                  testProperty "MaybeT (Just (Just v))" $
+                    ioProperty . \(x :: Integer) -> do
+                      testMergeableSimpleEquivClass
+                        (MaybeT $ Just $ Just x :: MaybeT Maybe Integer)
+                        [ DynamicSortedIdx True,
+                          DynamicSortedIdx True,
+                          DynamicSortedIdx x
+                        ]
+                        [ ( ssym "a",
+                            MaybeT $ Just $ Just x,
+                            MaybeT $ Just $ Just x,
+                            MaybeT $ Just $ Just x
+                          )
+                        ]
+                ],
+              testCase "MaybeT Maybe SymBool / MaybeT (Just (Just v))" $ do
+                let (idxsJ, SimpleStrategy fJ) =
+                      resolveStrategy
+                        rootStrategy
+                        ( MaybeT (Just (Just (ssym "a"))) ::
+                            MaybeT Maybe SymBool
+                        )
+                idxsJ @?= [DynamicSortedIdx True, DynamicSortedIdx True]
+                fJ
+                  (ssym "a")
+                  (MaybeT $ Just $ Just $ ssym "b")
+                  (MaybeT $ Just $ Just $ ssym "c")
+                  @?= MaybeT
+                    (Just (Just (symIte (ssym "a") (ssym "b") (ssym "c"))))
+            ],
+          testGroup
+            "ExceptT"
+            [ testGroup
+                "ExceptT Integer Maybe Integer"
+                [ testCase "ExceptT Nothing" $
+                    testMergeableSimpleEquivClass
+                      (ExceptT Nothing :: ExceptT Integer Maybe Integer)
+                      [DynamicSortedIdx False]
+                      [ ( ssym "a",
+                          ExceptT Nothing,
+                          ExceptT Nothing,
+                          ExceptT Nothing
+                        )
+                      ],
+                  testProperty "ExceptT (Just (Left v))" $
+                    ioProperty . \(x :: Integer) -> do
+                      testMergeableSimpleEquivClass
+                        ( ExceptT $ Just $ Left x ::
+                            ExceptT Integer Maybe Integer
+                        )
+                        [ DynamicSortedIdx True,
+                          DynamicSortedIdx False,
+                          DynamicSortedIdx x
+                        ]
+                        [ ( ssym "a",
+                            ExceptT $ Just $ Left x,
+                            ExceptT $ Just $ Left x,
+                            ExceptT $ Just $ Left x
+                          )
+                        ],
+                  testProperty "ExceptT (Just (Right v))" $
+                    ioProperty . \(x :: Integer) -> do
+                      testMergeableSimpleEquivClass
+                        ( ExceptT $ Just $ Right x ::
+                            ExceptT Integer Maybe Integer
+                        )
+                        [ DynamicSortedIdx True,
+                          DynamicSortedIdx True,
+                          DynamicSortedIdx x
+                        ]
+                        [ ( ssym "a",
+                            ExceptT $ Just $ Right x,
+                            ExceptT $ Just $ Right x,
+                            ExceptT $ Just $ Right x
+                          )
+                        ]
+                ],
+              testGroup
+                "ExceptT SymBool Maybe SymBool"
+                [ testCase "ExceptT (Just (Left v))" $ do
+                    let (idxsJL, SimpleStrategy fJL) =
+                          resolveStrategy
+                            rootStrategy
+                            ( ExceptT (Just (Left (ssym "a"))) ::
+                                ExceptT SymBool Maybe SymBool
+                            )
+                    idxsJL @?= [DynamicSortedIdx True, DynamicSortedIdx False]
+                    fJL
+                      (ssym "a")
+                      (ExceptT $ Just $ Left $ ssym "b")
+                      (ExceptT $ Just $ Left $ ssym "c")
+                      @?= ExceptT
+                        (Just (Left (symIte (ssym "a") (ssym "b") (ssym "c")))),
+                  testCase "ExceptT (Just (Right v))" $ do
+                    let (idxsJR, SimpleStrategy fJR) =
+                          resolveStrategy
+                            rootStrategy
+                            ( ExceptT (Just (Right (ssym "a"))) ::
+                                ExceptT SymBool Maybe SymBool
+                            )
+                    idxsJR @?= [DynamicSortedIdx True, DynamicSortedIdx True]
+                    fJR
+                      (ssym "a")
+                      (ExceptT $ Just $ Right $ ssym "b")
+                      (ExceptT $ Just $ Right $ ssym "c")
+                      @?= ExceptT
+                        (Just (Right (symIte (ssym "a") (ssym "b") (ssym "c"))))
+                ]
+            ],
+          testGroup
+            "StateT"
+            [ testCase "Lazy StateT" $ do
+                let SimpleStrategy s =
+                      rootStrategy ::
+                        MergingStrategy
+                          (StateLazy.StateT Integer UnionM SymBool)
+                let st1 :: StateLazy.StateT Integer UnionM SymBool =
+                      StateLazy.StateT $ \(x :: Integer) ->
+                        mrgSingle (ssym "a", x + 2)
+                let st2 :: StateLazy.StateT Integer UnionM SymBool =
+                      StateLazy.StateT $ \(x :: Integer) ->
+                        mrgSingle (ssym "b", x * 2)
+                let st3 = s (ssym "c") st1 st2
+                StateLazy.runStateT st3 2
+                  @?= mrgSingle (symIte (ssym "c") (ssym "a") (ssym "b"), 4)
+                StateLazy.runStateT st3 3
+                  @?= mrgIf
+                    (ssym "c")
+                    (mrgSingle (ssym "a", 5))
+                    (mrgSingle (ssym "b", 6)),
+              testCase "Strict StateT" $ do
+                let SimpleStrategy s =
+                      rootStrategy ::
+                        MergingStrategy
+                          (StateStrict.StateT Integer UnionM SymBool)
+                let st1 :: StateStrict.StateT Integer UnionM SymBool =
+                      StateStrict.StateT $
+                        \(x :: Integer) -> mrgSingle (ssym "a", x + 2)
+                let st2 :: StateStrict.StateT Integer UnionM SymBool =
+                      StateStrict.StateT $
+                        \(x :: Integer) -> mrgSingle (ssym "b", x * 2)
+                let st3 = s (ssym "c") st1 st2
+                StateStrict.runStateT st3 2
+                  @?= mrgSingle (symIte (ssym "c") (ssym "a") (ssym "b"), 4)
+                StateStrict.runStateT st3 3
+                  @?= mrgIf
+                    (ssym "c")
+                    (mrgSingle (ssym "a", 5))
+                    (mrgSingle (ssym "b", 6))
+            ],
+          testCase "ContT" $ do
+            let SimpleStrategy s =
+                  rootStrategy ::
+                    MergingStrategy
+                      (ContT (SymBool, Integer) UnionM (SymBool, Integer))
+            let c1 :: ContT (SymBool, Integer) UnionM (SymBool, Integer) =
+                  ContT $ \f -> f (ssym "a", 2)
+            let c2 :: ContT (SymBool, Integer) UnionM (SymBool, Integer) =
+                  ContT $ \f -> f (ssym "b", 3)
+            let c3 = s (ssym "c") c1 c2
+            runContT
+              c3
+              ( \(a, x) ->
+                  mrgIf
+                    (ssym "p")
+                    (mrgSingle (a, x))
+                    (mrgSingle (symNot a, x + 1))
+              )
+              @?= mrgIf
+                (ssym "c")
+                ( mrgIf
+                    (ssym "p")
+                    (mrgSingle (ssym "a", 2))
+                    (mrgSingle (symNot $ ssym "a", 3))
+                )
+                ( mrgIf
+                    (ssym "p")
+                    (mrgSingle (ssym "b", 3))
+                    (mrgSingle (symNot $ ssym "b", 4))
+                ),
+          testGroup
+            "RWST"
+            [ testCase "Lazy RWST" $ do
+                let SimpleStrategy s =
+                      rootStrategy ::
+                        MergingStrategy
+                          ( RWSTLazy.RWST
+                              (Integer, SymBool)
+                              (Integer, SymBool)
+                              (Integer, SymBool)
+                              UnionM
+                              (Integer, SymBool)
+                          )
+                let rws1 ::
+                      RWSTLazy.RWST
+                        (Integer, SymBool)
+                        (Integer, SymBool)
+                        (Integer, SymBool)
+                        UnionM
+                        (Integer, SymBool) =
+                        RWSTLazy.RWST $ \(ir, br) (is, bs) ->
+                          mrgSingle
+                            ( (ir + is, br .&& bs),
+                              (ir - is, br .|| bs),
+                              (ir * is, bs .&& br)
+                            )
+                let rws2 ::
+                      RWSTLazy.RWST
+                        (Integer, SymBool)
+                        (Integer, SymBool)
+                        (Integer, SymBool)
+                        UnionM
+                        (Integer, SymBool) =
+                        RWSTLazy.RWST $ \(ir, br) (is, bs) ->
+                          mrgSingle
+                            ( (ir + is, br .|| bs),
+                              (ir - is, br .&& bs),
+                              (ir * is, bs .|| br)
+                            )
+                let rws3 = s (ssym "c") rws1 rws2
+
+                let res1 ::
+                      UnionM
+                        ( (Integer, SymBool),
+                          (Integer, SymBool),
+                          (Integer, SymBool)
+                        ) =
+                        mrgIf
+                          (ssym "c")
+                          ( mrgSingle
+                              ( (1, ssym "a" .&& ssym "b"),
+                                (-1, ssym "a" .|| ssym "b"),
+                                (0, ssym "b" .&& ssym "a")
+                              )
+                          )
+                          ( mrgSingle
+                              ( (1, ssym "a" .|| ssym "b"),
+                                (-1, ssym "a" .&& ssym "b"),
+                                (0, ssym "b" .|| ssym "a")
+                              )
+                          )
+                RWSTLazy.runRWST rws3 (0, ssym "a") (1, ssym "b") @?= res1,
+              testCase "Strict RWST" $ do
+                let SimpleStrategy s =
+                      rootStrategy ::
+                        MergingStrategy
+                          ( RWSTStrict.RWST
+                              (Integer, SymBool)
+                              (Integer, SymBool)
+                              (Integer, SymBool)
+                              UnionM
+                              (Integer, SymBool)
+                          )
+                let rws1 ::
+                      RWSTStrict.RWST
+                        (Integer, SymBool)
+                        (Integer, SymBool)
+                        (Integer, SymBool)
+                        UnionM
+                        (Integer, SymBool) =
+                        RWSTStrict.RWST $ \(ir, br) (is, bs) ->
+                          mrgSingle
+                            ( (ir + is, br .&& bs),
+                              (ir - is, br .|| bs),
+                              (ir * is, bs .&& br)
+                            )
+                let rws2 ::
+                      RWSTStrict.RWST
+                        (Integer, SymBool)
+                        (Integer, SymBool)
+                        (Integer, SymBool)
+                        UnionM
+                        (Integer, SymBool) =
+                        RWSTStrict.RWST $ \(ir, br) (is, bs) ->
+                          mrgSingle
+                            ( (ir + is, br .|| bs),
+                              (ir - is, br .&& bs),
+                              (ir * is, bs .|| br)
+                            )
+                let rws3 = s (ssym "c") rws1 rws2
+
+                let res1 ::
+                      UnionM
+                        ( (Integer, SymBool),
+                          (Integer, SymBool),
+                          (Integer, SymBool)
+                        ) =
+                        mrgIf
+                          (ssym "c")
+                          ( mrgSingle
+                              ( (1, "a" .&& "b"),
+                                (-1, "a" .|| "b"),
+                                (0, "b" .&& "a")
+                              )
+                          )
+                          ( mrgSingle
+                              ( (1, "a" .|| "b"),
+                                (-1, "a" .&& "b"),
+                                (0, "b" .|| "a")
+                              )
+                          )
+                RWSTStrict.runRWST rws3 (0, ssym "a") (1, ssym "b") @?= res1
+            ],
+          testGroup
+            "WriterT"
+            [ testCase "Lazy WriterT" $ do
+                let SimpleStrategy s =
+                      rootStrategy ::
+                        MergingStrategy
+                          (WriterLazy.WriterT Integer UnionM SymBool)
+                let w1 :: WriterLazy.WriterT Integer UnionM SymBool =
+                      WriterLazy.WriterT $ mrgSingle (ssym "a", 1)
+                let w2 :: WriterLazy.WriterT Integer UnionM SymBool =
+                      WriterLazy.WriterT $ mrgSingle (ssym "b", 2)
+                let w3 :: WriterLazy.WriterT Integer UnionM SymBool =
+                      WriterLazy.WriterT $ mrgSingle (ssym "c", 1)
+                let w4 = s (ssym "d") w1 w2
+                let w5 = s (ssym "d") w1 w3
+                WriterLazy.runWriterT w4
+                  @?= mrgIf
+                    (ssym "d")
+                    (mrgSingle (ssym "a", 1))
+                    (mrgSingle (ssym "b", 2))
+                WriterLazy.runWriterT w5
+                  @?= mrgSingle (symIte (ssym "d") (ssym "a") (ssym "c"), 1),
+              testCase "Strict WriterT" $ do
+                let SimpleStrategy s =
+                      rootStrategy ::
+                        MergingStrategy
+                          (WriterStrict.WriterT Integer UnionM SymBool)
+                let w1 :: WriterStrict.WriterT Integer UnionM SymBool =
+                      WriterStrict.WriterT $ mrgSingle (ssym "a", 1)
+                let w2 :: WriterStrict.WriterT Integer UnionM SymBool =
+                      WriterStrict.WriterT $ mrgSingle (ssym "b", 2)
+                let w3 :: WriterStrict.WriterT Integer UnionM SymBool =
+                      WriterStrict.WriterT $ mrgSingle (ssym "c", 1)
+                let w4 = s (ssym "d") w1 w2
+                let w5 = s (ssym "d") w1 w3
+                WriterStrict.runWriterT w4
+                  @?= mrgIf
+                    (ssym "d")
+                    (mrgSingle (ssym "a", 1))
+                    (mrgSingle (ssym "b", 2))
+                WriterStrict.runWriterT w5
+                  @?= mrgSingle (symIte (ssym "d") (ssym "a") (ssym "c"), 1)
+            ],
+          testCase "ReaderT" $ do
+            let SimpleStrategy s =
+                  rootStrategy ::
+                    MergingStrategy (ReaderT Integer UnionM Integer)
+            let r1 :: ReaderT Integer UnionM Integer =
+                  ReaderT $ \(x :: Integer) -> mrgSingle $ x + 2
+            let r2 :: ReaderT Integer UnionM Integer =
+                  ReaderT $ \(x :: Integer) -> mrgSingle $ x * 2
+            let r3 = s (ssym "c") r1 r2
+            runReaderT r3 2 @?= mrgSingle 4
+            runReaderT r3 3 @?= mrgIf (ssym "c") (mrgSingle 5) (mrgSingle 6),
+          testGroup
+            "Identity"
+            [ testProperty "Identity Integer" $
+                ioProperty . \x -> do
+                  testMergeableSimpleEquivClass
+                    (Identity x :: Identity Integer)
+                    [DynamicSortedIdx x]
+                    [(ssym "a", Identity x, Identity x, Identity x)],
+              testCase "Identity SymBool" $ do
+                testMergeableSimpleEquivClass
+                  (Identity (ssym "a" :: SymBool))
+                  []
+                  [ ( ssym "a",
+                      Identity $ ssym "b",
+                      Identity $ ssym "c",
+                      Identity $ symIte (ssym "a") (ssym "b") (ssym "c")
+                    )
+                  ]
+            ],
+          testGroup
+            "IdentityT Maybe Integer"
+            [ testGroup
+                "IdentityT Maybe Integer"
+                [ testCase "IdentityT Nothing" $
+                    testMergeableSimpleEquivClass
+                      (IdentityT Nothing :: IdentityT Maybe Integer)
+                      [DynamicSortedIdx False]
+                      [ ( ssym "a",
+                          IdentityT Nothing,
+                          IdentityT Nothing,
+                          IdentityT Nothing
+                        )
+                      ],
+                  testProperty "IdentityT (Just v)" $
+                    ioProperty . \x -> do
+                      testMergeableSimpleEquivClass
+                        (IdentityT $ Just x :: IdentityT Maybe Integer)
+                        [DynamicSortedIdx True, DynamicSortedIdx x]
+                        [ ( ssym "a",
+                            IdentityT $ Just x,
+                            IdentityT $ Just x,
+                            IdentityT $ Just x
+                          )
+                        ]
+                ],
+              testGroup
+                "IdentityT Maybe SymBool"
+                [ testCase "IdentityT Nothing" $
+                    testMergeableSimpleEquivClass
+                      (IdentityT Nothing :: IdentityT Maybe SymBool)
+                      [DynamicSortedIdx False]
+                      [ ( ssym "a",
+                          IdentityT Nothing,
+                          IdentityT Nothing,
+                          IdentityT Nothing
+                        )
+                      ],
+                  testCase "IdentityT (Just v)" $
+                    testMergeableSimpleEquivClass
+                      (IdentityT $ Just $ ssym "a" :: IdentityT Maybe SymBool)
+                      [DynamicSortedIdx True]
+                      [ ( ssym "a",
+                          IdentityT $ Just $ ssym "b",
+                          IdentityT $ Just $ ssym "c",
+                          IdentityT $
+                            Just $
+                              symIte (ssym "a") (ssym "b") (ssym "c")
+                        )
+                      ]
+                ]
+            ],
+          testGroup
+            "Sum"
+            [ testGroup
+                "Sum Maybe Maybe Integer"
+                [ testCase "InL Nothing" $
+                    testMergeableSimpleEquivClass
+                      (InL Nothing :: Sum Maybe Maybe Integer)
+                      [DynamicSortedIdx False, DynamicSortedIdx False]
+                      [(ssym "a", InL Nothing, InL Nothing, InL Nothing)],
+                  testProperty "InL (Just v)" $
+                    ioProperty . \x -> do
+                      testMergeableSimpleEquivClass
+                        (InL $ Just x :: Sum Maybe Maybe Integer)
+                        [ DynamicSortedIdx False,
+                          DynamicSortedIdx True,
+                          DynamicSortedIdx x
+                        ]
+                        [(ssym "a", InL $ Just x, InL $ Just x, InL $ Just x)],
+                  testCase "InR Nothing" $
+                    testMergeableSimpleEquivClass
+                      (InR Nothing :: Sum Maybe Maybe Integer)
+                      [DynamicSortedIdx True, DynamicSortedIdx False]
+                      [(ssym "a", InR Nothing, InR Nothing, InR Nothing)],
+                  testProperty "InR (Just v)" $
+                    ioProperty . \x -> do
+                      testMergeableSimpleEquivClass
+                        (InR $ Just x :: Sum Maybe Maybe Integer)
+                        [ DynamicSortedIdx True,
+                          DynamicSortedIdx True,
+                          DynamicSortedIdx x
+                        ]
+                        [(ssym "a", InR $ Just x, InR $ Just x, InR $ Just x)]
+                ],
+              testGroup
+                "Sum Maybe Maybe SymBool"
+                [ testCase "InL Nothing" $
+                    testMergeableSimpleEquivClass
+                      (InL Nothing :: Sum Maybe Maybe SymBool)
+                      [DynamicSortedIdx False, DynamicSortedIdx False]
+                      [(ssym "a", InL Nothing, InL Nothing, InL Nothing)],
+                  testCase "InL (Just v)" $
+                    testMergeableSimpleEquivClass
+                      (InL $ Just $ ssym "a" :: Sum Maybe Maybe SymBool)
+                      [DynamicSortedIdx False, DynamicSortedIdx True]
+                      [ ( ssym "a",
+                          InL $ Just $ ssym "b",
+                          InL $ Just $ ssym "c",
+                          InL $ Just $ symIte (ssym "a") (ssym "b") (ssym "c")
+                        )
+                      ],
+                  testCase "InR Nothing" $
+                    testMergeableSimpleEquivClass
+                      (InR Nothing :: Sum Maybe Maybe SymBool)
+                      [DynamicSortedIdx True, DynamicSortedIdx False]
+                      [(ssym "a", InR Nothing, InR Nothing, InR Nothing)],
+                  testCase "InR (Just v)" $
+                    testMergeableSimpleEquivClass
+                      (InR $ Just $ ssym "a" :: Sum Maybe Maybe SymBool)
+                      [DynamicSortedIdx True, DynamicSortedIdx True]
+                      [ ( ssym "a",
+                          InR $ Just $ ssym "b",
+                          InR $ Just $ ssym "c",
+                          InR $ Just $ symIte (ssym "a") (ssym "b") (ssym "c")
+                        )
+                      ]
+                ]
+            ],
+          testGroup
+            "Ordering"
+            [ testCase "LT" $
+                testMergeableSimpleEquivClass
+                  LT
+                  [DynamicSortedIdx False]
+                  [(ssym "a", LT, LT, LT)],
+              testCase "EQ" $
+                testMergeableSimpleEquivClass
+                  EQ
+                  [DynamicSortedIdx True, DynamicSortedIdx False]
+                  [(ssym "a", EQ, EQ, EQ)],
+              testCase "GT" $
+                testMergeableSimpleEquivClass
+                  GT
+                  [DynamicSortedIdx True, DynamicSortedIdx True]
+                  [(ssym "a", GT, GT, GT)]
+            ]
+        ]
+    ]
diff --git a/test/Grisette/Core/Data/Class/SEqTests.hs b/test/Grisette/Core/Data/Class/SEqTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/SEqTests.hs
@@ -0,0 +1,715 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Grisette.Core.Data.Class.SEqTests (seqTests) where
+
+import Control.Monad.Except (ExceptT (ExceptT))
+import Control.Monad.Identity
+  ( Identity (Identity),
+    IdentityT (IdentityT),
+  )
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import qualified Control.Monad.Writer.Lazy as WriterLazy
+import qualified Control.Monad.Writer.Strict as WriterStrict
+import Data.Bifunctor (Bifunctor (bimap))
+import qualified Data.ByteString as B
+import Data.Foldable (traverse_)
+import Data.Functor.Sum (Sum (InL, InR))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.Stack (HasCallStack)
+import Generics.Deriving (Default (Default), Generic)
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&)))
+import Grisette.Core.Data.Class.SEq (SEq ((./=), (.==)))
+import Grisette.Core.Data.Class.Solvable (Solvable (con))
+import Grisette.Core.Data.Class.TestValues (conBool, ssymBool)
+import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bool (pevalEqvTerm)
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool (SymBool))
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit (Assertion, (@=?))
+import Test.QuickCheck (ioProperty)
+
+data A = A1 | A2 SymBool | A3 SymBool SymBool
+  deriving (Generic, Show, Eq)
+  deriving (SEq) via (Default A)
+
+concreteSEqOkProp :: (HasCallStack, SEq a, Eq a) => (a, a) -> Assertion
+concreteSEqOkProp (i, j) = do
+  i .== j @=? con (i == j)
+  i ./= j @=? con (i /= j)
+
+seqTests :: Test
+seqTests =
+  testGroup
+    "SEq"
+    [ testGroup
+        "SEq for common types"
+        [ testGroup
+            "SymBool"
+            [ testCase "conBool" $ do
+                let bools :: [Bool] = [True, False]
+                traverse_
+                  ( \(i, j) ->
+                      conBool i
+                        .== conBool j
+                        @=? conBool (i == j)
+                  )
+                  [(x, y) | x <- bools, y <- bools],
+              testCase "conBool True vs SymBool" $ do
+                conBool True .== ssymBool "a" @=? ssymBool "a",
+              testCase "conBool False vs SymBool" $ do
+                conBool False .== ssymBool "a" @=? symNot (ssymBool "a"),
+              testCase "SymBool vs conBool True" $ do
+                ssymBool "a" .== conBool True @=? ssymBool "a",
+              testCase "SymBool vs conBool False" $ do
+                ssymBool "a" .== conBool False @=? symNot (ssymBool "a"),
+              testCase "SymBool vs same SymBool" $ do
+                ssymBool "a" .== ssymBool "a" @=? conBool True,
+              testCase "SymBool vs different SymBool" $ do
+                let SymBool terma = ssymBool "a"
+                    SymBool termb = ssymBool "b"
+                ssymBool "a"
+                  .== ssymBool "b"
+                  @=? SymBool (pevalEqvTerm terma termb)
+            ],
+          testProperty "Bool" (ioProperty . concreteSEqOkProp @Bool),
+          testProperty "Integer" (ioProperty . concreteSEqOkProp @Integer),
+          testProperty "Char" (ioProperty . concreteSEqOkProp @Char),
+          testProperty "Int" (ioProperty . concreteSEqOkProp @Int),
+          testProperty "Int8" (ioProperty . concreteSEqOkProp @Int8),
+          testProperty "Int16" (ioProperty . concreteSEqOkProp @Int16),
+          testProperty "Int32" (ioProperty . concreteSEqOkProp @Int32),
+          testProperty "Int64" (ioProperty . concreteSEqOkProp @Int64),
+          testProperty "Word" (ioProperty . concreteSEqOkProp @Word),
+          testProperty "Word8" (ioProperty . concreteSEqOkProp @Word8),
+          testProperty "Word16" (ioProperty . concreteSEqOkProp @Word16),
+          testProperty "Word32" (ioProperty . concreteSEqOkProp @Word32),
+          testProperty "Word64" (ioProperty . concreteSEqOkProp @Word64),
+          testGroup
+            "List"
+            [ testProperty "[Integer]" $
+                ioProperty . concreteSEqOkProp @[Integer],
+              testGroup
+                "[SymBool]"
+                [ testCase "Same length 1" $
+                    [ssymBool "a"]
+                      .== [ssymBool "b"]
+                      @=? ssymBool "a"
+                        .== ssymBool "b",
+                  testCase "Same length 2" $
+                    [ssymBool "a", ssymBool "b"]
+                      .== [ssymBool "c", ssymBool "d"]
+                      @=? (ssymBool "a" .== ssymBool "c")
+                        .&& (ssymBool "b" .== ssymBool "d"),
+                  testCase "length 1 vs length 0" $
+                    [ssymBool "a"] .== [] @=? conBool False,
+                  testCase "length 1 vs length 2" $
+                    [ssymBool "a"]
+                      .== [ssymBool "c", ssymBool "d"]
+                      @=? conBool False
+                ]
+            ],
+          testGroup
+            "Maybe"
+            [ testProperty "Maybe Integer" $
+                ioProperty . concreteSEqOkProp @(Maybe Integer),
+              testGroup
+                "Maybe SymBool"
+                [ testCase "Nothing vs Nothing" $
+                    (Nothing :: Maybe SymBool) .== Nothing @=? conBool True,
+                  testCase "Just vs Nothing" $
+                    Just (ssymBool "a") .== Nothing @=? conBool False,
+                  testCase "Nothing vs Just" $
+                    Nothing .== Just (ssymBool "a") @=? conBool False,
+                  testCase "Just vs Just" $
+                    Just (ssymBool "a")
+                      .== Just (ssymBool "b")
+                      @=? ssymBool "a"
+                        .== ssymBool "b"
+                ]
+            ],
+          testGroup
+            "Either"
+            [ testProperty "Either" $
+                ioProperty . concreteSEqOkProp @(Either Integer Integer),
+              testGroup
+                "Either SymBool SymBool"
+                [ testCase "Left vs Left" $
+                    (Left (ssymBool "a") :: Either SymBool SymBool)
+                      .== Left (ssymBool "b")
+                      @=? ssymBool "a"
+                        .== ssymBool "b",
+                  testCase "Right vs Left" $
+                    (Right (ssymBool "a") :: Either SymBool SymBool)
+                      .== Left (ssymBool "b")
+                      @=? conBool False,
+                  testCase "Left vs Right" $
+                    (Left (ssymBool "a") :: Either SymBool SymBool)
+                      .== Right (ssymBool "b")
+                      @=? conBool False,
+                  testCase "Right vs Right" $
+                    (Right (ssymBool "a") :: Either SymBool SymBool)
+                      .== Right (ssymBool "b")
+                      @=? ssymBool "a"
+                        .== ssymBool "b"
+                ]
+            ],
+          testGroup
+            "MaybeT"
+            [ testProperty "MaybeT" $
+                ioProperty
+                  . concreteSEqOkProp @(MaybeT Maybe Integer)
+                  . bimap MaybeT MaybeT,
+              testGroup
+                "MaybeT Maybe SymBool"
+                [ testCase "MaybeT Nothing vs MaybeT Nothing" $
+                    (MaybeT Nothing :: MaybeT Maybe SymBool)
+                      .== MaybeT Nothing
+                      @=? conBool True,
+                  testCase "MaybeT Nothing vs MaybeT (Just Nothing)" $
+                    (MaybeT Nothing :: MaybeT Maybe SymBool)
+                      .== MaybeT (Just Nothing)
+                      @=? conBool False,
+                  testCase "MaybeT Nothing vs MaybeT (Just (Just v))" $
+                    (MaybeT Nothing :: MaybeT Maybe SymBool)
+                      .== MaybeT (Just (Just (ssymBool "a")))
+                      @=? conBool False,
+                  testCase "MaybeT (Just Nothing) vs MaybeT Nothing" $
+                    MaybeT (Just Nothing)
+                      .== (MaybeT Nothing :: MaybeT Maybe SymBool)
+                      @=? conBool False,
+                  testCase "MaybeT (Just (Just v)) vs MaybeT Nothing" $
+                    MaybeT (Just (Just (ssymBool "a")))
+                      .== (MaybeT Nothing :: MaybeT Maybe SymBool)
+                      @=? conBool False,
+                  testCase "MaybeT (Just Nothing) vs MaybeT (Just Nothing)" $
+                    MaybeT (Just Nothing)
+                      .== (MaybeT (Just Nothing) :: MaybeT Maybe SymBool)
+                      @=? conBool True,
+                  testCase "MaybeT (Just (Just v)) vs MaybeT (Just Nothing)" $
+                    MaybeT (Just (Just (ssymBool "a")))
+                      .== (MaybeT (Just Nothing) :: MaybeT Maybe SymBool)
+                      @=? conBool False,
+                  testCase "MaybeT (Just Nothing) vs MaybeT (Just (Just v))" $
+                    MaybeT (Just Nothing)
+                      .== ( MaybeT (Just (Just (ssymBool "b"))) ::
+                              MaybeT Maybe SymBool
+                          )
+                      @=? conBool False,
+                  testCase "MaybeT (Just (Just v)) vs MaybeT (Just (Just v))" $
+                    MaybeT (Just (Just (ssymBool "a")))
+                      .== ( MaybeT (Just (Just (ssymBool "b"))) ::
+                              MaybeT Maybe SymBool
+                          )
+                      @=? ssymBool "a"
+                        .== ssymBool "b"
+                ]
+            ],
+          testGroup
+            "ExceptT"
+            [ testProperty "ExceptT Integer Maybe Itneger" $
+                ioProperty
+                  . concreteSEqOkProp @(ExceptT Integer Maybe Integer)
+                  . bimap ExceptT ExceptT,
+              testGroup
+                "ExceptT SymBool Maybe SymBool"
+                [ testCase "ExceptT Nothing vs ExceptT Nothing" $
+                    (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                      .== ExceptT Nothing
+                      @=? conBool True,
+                  testCase "ExceptT Nothing vs ExceptT (Just (Left v))" $
+                    (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                      .== ExceptT (Just (Left (ssymBool "a")))
+                      @=? conBool False,
+                  testCase "ExceptT Nothing vs ExceptT (Just (Right v))" $
+                    (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                      .== ExceptT (Just (Right (ssymBool "a")))
+                      @=? conBool False,
+                  testCase "ExceptT (Just (Left v)) vs ExceptT Nothing" $
+                    ExceptT (Just (Left (ssymBool "a")))
+                      .== (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                      @=? conBool False,
+                  testCase "ExceptT (Just (Right v)) vs ExceptT Nothing" $
+                    ExceptT (Just (Right (ssymBool "a")))
+                      .== (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                      @=? conBool False,
+                  testCase
+                    "ExceptT (Just (Left v)) vs ExceptT (Just (Left v))"
+                    $ ExceptT (Just (Left (ssymBool "a")))
+                      .== ( ExceptT (Just (Left (ssymBool "b"))) ::
+                              ExceptT SymBool Maybe SymBool
+                          )
+                      @=? ssymBool "a"
+                        .== ssymBool "b",
+                  testCase
+                    "ExceptT (Just (Right v)) vs ExceptT (Just (Left v))"
+                    $ ExceptT (Just (Right (ssymBool "a")))
+                      .== ( ExceptT (Just (Left (ssymBool "b"))) ::
+                              ExceptT SymBool Maybe SymBool
+                          )
+                      @=? conBool False,
+                  testCase
+                    "ExceptT (Just (Left v)) vs ExceptT (Just (Right v))"
+                    $ ExceptT (Just (Left (ssymBool "a")))
+                      .== ( ExceptT (Just (Right (ssymBool "b"))) ::
+                              ExceptT SymBool Maybe SymBool
+                          )
+                      @=? conBool False,
+                  testCase
+                    "ExceptT (Just (Right v)) vs ExceptT (Just (Right v))"
+                    $ ExceptT (Just (Right (ssymBool "a")))
+                      .== ( ExceptT (Just (Right (ssymBool "b"))) ::
+                              ExceptT SymBool Maybe SymBool
+                          )
+                      @=? ssymBool "a"
+                        .== ssymBool "b"
+                ]
+            ],
+          testProperty "()" (ioProperty . concreteSEqOkProp @()),
+          testGroup
+            "(,)"
+            [ testProperty "(Integer, Integer)" $
+                ioProperty . concreteSEqOkProp @(Integer, Integer),
+              testCase "(SymBool, SymBool)" $ do
+                (ssymBool "a", ssymBool "c")
+                  .== (ssymBool "b", ssymBool "d")
+                  @=? ssymBool "a"
+                    .== ssymBool "b"
+                    .&& ssymBool "c"
+                      .== ssymBool "d"
+            ],
+          testGroup
+            "(,,)"
+            [ testProperty "(Integer, Integer, Integer)" $
+                ioProperty . concreteSEqOkProp @(Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool)" $
+                (ssymBool "a", ssymBool "c", ssymBool "e")
+                  .== (ssymBool "b", ssymBool "d", ssymBool "f")
+                  @=? (ssymBool "a" .== ssymBool "b")
+                    .&& ( (ssymBool "c" .== ssymBool "d")
+                            .&& (ssymBool "e" .== ssymBool "f")
+                        )
+            ],
+          testGroup
+            "(,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteSEqOkProp @(Integer, Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool, SymBool)" $ do
+                (ssymBool "a", ssymBool "c", ssymBool "e", ssymBool "g")
+                  .== (ssymBool "b", ssymBool "d", ssymBool "f", ssymBool "h")
+                  @=? ( (ssymBool "a" .== ssymBool "b")
+                          .&& (ssymBool "c" .== ssymBool "d")
+                      )
+                    .&& ( (ssymBool "e" .== ssymBool "f")
+                            .&& (ssymBool "g" .== ssymBool "h")
+                        )
+            ],
+          testGroup
+            "(,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteSEqOkProp
+                    @(Integer, Integer, Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool, SymBool, SymBool)" $ do
+                ( ssymBool "a",
+                  ssymBool "c",
+                  ssymBool "e",
+                  ssymBool "g",
+                  ssymBool "i"
+                  )
+                  .== ( ssymBool "b",
+                        ssymBool "d",
+                        ssymBool "f",
+                        ssymBool "h",
+                        ssymBool "j"
+                      )
+                  @=? ( (ssymBool "a" .== ssymBool "b")
+                          .&& (ssymBool "c" .== ssymBool "d")
+                      )
+                    .&& ( (ssymBool "e" .== ssymBool "f")
+                            .&& ( (ssymBool "g" .== ssymBool "h")
+                                    .&& (ssymBool "i" .== ssymBool "j")
+                                )
+                        )
+            ],
+          testGroup
+            "(,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteSEqOkProp
+                    @( Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer
+                     ),
+              testCase
+                "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                $ ( ssymBool "a",
+                    ssymBool "c",
+                    ssymBool "e",
+                    ssymBool "g",
+                    ssymBool "i",
+                    ssymBool "k"
+                  )
+                  .== ( ssymBool "b",
+                        ssymBool "d",
+                        ssymBool "f",
+                        ssymBool "h",
+                        ssymBool "j",
+                        ssymBool "l"
+                      )
+                  @=? ( (ssymBool "a" .== ssymBool "b")
+                          .&& ( (ssymBool "c" .== ssymBool "d")
+                                  .&& (ssymBool "e" .== ssymBool "f")
+                              )
+                      )
+                    .&& ( (ssymBool "g" .== ssymBool "h")
+                            .&& ( (ssymBool "i" .== ssymBool "j")
+                                    .&& (ssymBool "k" .== ssymBool "l")
+                                )
+                        )
+            ],
+          testGroup
+            "(,,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteSEqOkProp
+                    @( Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer
+                     ),
+              testCase
+                "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                $ do
+                  ( ssymBool "a",
+                    ssymBool "c",
+                    ssymBool "e",
+                    ssymBool "g",
+                    ssymBool "i",
+                    ssymBool "k",
+                    ssymBool "m"
+                    )
+                    .== ( ssymBool "b",
+                          ssymBool "d",
+                          ssymBool "f",
+                          ssymBool "h",
+                          ssymBool "j",
+                          ssymBool "l",
+                          ssymBool "n"
+                        )
+                    @=? ( (ssymBool "a" .== ssymBool "b")
+                            .&& ( (ssymBool "c" .== ssymBool "d")
+                                    .&& (ssymBool "e" .== ssymBool "f")
+                                )
+                        )
+                      .&& ( ( (ssymBool "g" .== ssymBool "h")
+                                .&& (ssymBool "i" .== ssymBool "j")
+                            )
+                              .&& ( (ssymBool "k" .== ssymBool "l")
+                                      .&& (ssymBool "m" .== ssymBool "n")
+                                  )
+                          )
+            ],
+          testGroup
+            "(,,,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteSEqOkProp
+                    @( Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer
+                     ),
+              testCase
+                "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                $ ( ssymBool "a",
+                    ssymBool "c",
+                    ssymBool "e",
+                    ssymBool "g",
+                    ssymBool "i",
+                    ssymBool "k",
+                    ssymBool "m",
+                    ssymBool "o"
+                  )
+                  .== ( ssymBool "b",
+                        ssymBool "d",
+                        ssymBool "f",
+                        ssymBool "h",
+                        ssymBool "j",
+                        ssymBool "l",
+                        ssymBool "n",
+                        ssymBool "p"
+                      )
+                  @=? ( ( (ssymBool "a" .== ssymBool "b")
+                            .&& (ssymBool "c" .== ssymBool "d")
+                        )
+                          .&& ( (ssymBool "e" .== ssymBool "f")
+                                  .&& (ssymBool "g" .== ssymBool "h")
+                              )
+                      )
+                    .&& ( ( (ssymBool "i" .== ssymBool "j")
+                              .&& (ssymBool "k" .== ssymBool "l")
+                          )
+                            .&& ( (ssymBool "m" .== ssymBool "n")
+                                    .&& (ssymBool "o" .== ssymBool "p")
+                                )
+                        )
+            ],
+          testCase "ByteString" $ do
+            let bytestrings :: [B.ByteString] = ["", "a", "ab"]
+            traverse_
+              (\(i, j) -> i .== j @=? conBool (i == j))
+              [(x, y) | x <- bytestrings, y <- bytestrings],
+          testGroup
+            "Sum"
+            [ testProperty "Sum Maybe Maybe Integer" $
+                ioProperty
+                  . ( \v ->
+                        let eitherToSum ::
+                              Either (Maybe Integer) (Maybe Integer) ->
+                              Sum Maybe Maybe Integer
+                            eitherToSum (Left x) = InL x
+                            eitherToSum (Right x) = InR x
+                         in concreteSEqOkProp (bimap eitherToSum eitherToSum v)
+                    ),
+              testGroup
+                "Sum Maybe Maybe SymBool"
+                [ testCase "InL (Just v) vs InL (Just v)" $
+                    (InL $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                      .== InL (Just $ ssymBool "b")
+                      @=? ssymBool "a"
+                        .== ssymBool "b",
+                  testCase "InL (Just v) vs InR (Just v)" $
+                    (InL $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                      .== InR (Just $ ssymBool "b")
+                      @=? conBool False,
+                  testCase "InR (Just v) vs InR (Just v)" $
+                    (InR $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                      .== InR (Just $ ssymBool "b")
+                      @=? ssymBool "a"
+                        .== ssymBool "b",
+                  testCase "InR (Just v) vs InL (Just v)" $
+                    (InR $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                      .== InL (Just $ ssymBool "b")
+                      @=? conBool False
+                ]
+            ],
+          testGroup
+            "Writer"
+            [ testGroup
+                "Lazy"
+                [ testProperty
+                    "WriterT Integer (Either Integer) Integer"
+                    ( ioProperty
+                        . \( v1 :: Either Integer (Integer, Integer),
+                             v2 :: Either Integer (Integer, Integer)
+                             ) ->
+                            concreteSEqOkProp
+                              ( WriterLazy.WriterT v1,
+                                WriterLazy.WriterT v2
+                              )
+                    ),
+                  testGroup
+                    "WriterT SymBool (Either SymBool) SymBool"
+                    [ testCase "WriterT (Left v) vs WriterT (Left v)" $
+                        ( WriterLazy.WriterT (Left $ ssymBool "a") ::
+                            WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                        )
+                          .== WriterLazy.WriterT (Left $ ssymBool "b")
+                          @=? ssymBool "a"
+                            .== ssymBool "b",
+                      testCase "WriterT (Left v) vs WriterT (Right v)" $
+                        ( WriterLazy.WriterT (Left $ ssymBool "a") ::
+                            WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                        )
+                          .== WriterLazy.WriterT
+                            (Right (ssymBool "b", ssymBool "c"))
+                          @=? conBool False,
+                      testCase "WriterT (Right v) vs WriterT (Left v)" $
+                        ( WriterLazy.WriterT
+                            (Right (ssymBool "b", ssymBool "c")) ::
+                            WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                        )
+                          .== WriterLazy.WriterT (Left $ ssymBool "a")
+                          @=? conBool False,
+                      testCase "WriterT (Right v) vs WriterT (Right v)" $
+                        ( WriterLazy.WriterT
+                            (Right (ssymBool "a", ssymBool "b")) ::
+                            WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                        )
+                          .== WriterLazy.WriterT
+                            (Right (ssymBool "c", ssymBool "d"))
+                          @=? (ssymBool "a" .== ssymBool "c")
+                            .&& (ssymBool "b" .== ssymBool "d")
+                    ]
+                ],
+              testGroup
+                "Strict"
+                [ testProperty
+                    "WriterT Integer (Either Integer) Integer"
+                    ( ioProperty
+                        . \( v1 :: Either Integer (Integer, Integer),
+                             v2 :: Either Integer (Integer, Integer)
+                             ) ->
+                            concreteSEqOkProp
+                              ( WriterStrict.WriterT v1,
+                                WriterStrict.WriterT v2
+                              )
+                    ),
+                  testGroup
+                    "WriterT SymBool (Either SymBool) SymBool"
+                    [ testCase "WriterT (Left v) vs WriterT (Left v)" $
+                        ( WriterStrict.WriterT (Left $ ssymBool "a") ::
+                            WriterStrict.WriterT
+                              SymBool
+                              (Either SymBool)
+                              SymBool
+                        )
+                          .== WriterStrict.WriterT (Left $ ssymBool "b")
+                          @=? ssymBool "a"
+                            .== ssymBool "b",
+                      testCase "WriterT (Left v) vs WriterT (Right v)" $
+                        ( WriterStrict.WriterT (Left $ ssymBool "a") ::
+                            WriterStrict.WriterT
+                              SymBool
+                              (Either SymBool)
+                              SymBool
+                        )
+                          .== WriterStrict.WriterT
+                            (Right (ssymBool "b", ssymBool "c"))
+                          @=? conBool False,
+                      testCase "WriterT (Right v) vs WriterT (Left v)" $
+                        ( WriterStrict.WriterT
+                            (Right (ssymBool "b", ssymBool "c")) ::
+                            WriterStrict.WriterT
+                              SymBool
+                              (Either SymBool)
+                              SymBool
+                        )
+                          .== WriterStrict.WriterT (Left $ ssymBool "a")
+                          @=? conBool False,
+                      testCase "WriterT (Right v) vs WriterT (Right v)" $
+                        ( WriterStrict.WriterT
+                            (Right (ssymBool "a", ssymBool "b")) ::
+                            WriterStrict.WriterT
+                              SymBool
+                              (Either SymBool)
+                              SymBool
+                        )
+                          .== WriterStrict.WriterT
+                            (Right (ssymBool "c", ssymBool "d"))
+                          @=? ssymBool "a"
+                            .== ssymBool "c"
+                            .&& ssymBool "b"
+                              .== ssymBool "d"
+                    ]
+                ]
+            ],
+          testGroup
+            "Identity"
+            [ testProperty
+                "Identity Integer"
+                ( ioProperty . \(v1 :: Integer, v2) ->
+                    concreteSEqOkProp (Identity v1, Identity v2)
+                ),
+              testCase "Identity SymBool" $ do
+                (Identity $ ssymBool "a" :: Identity SymBool)
+                  .== Identity (ssymBool "b")
+                  @=? ssymBool "a"
+                    .== ssymBool "b"
+            ],
+          testGroup
+            "IdentityT"
+            [ testProperty
+                "IdentityT (Either Integer) Integer"
+                ( ioProperty . \(v1 :: Either Integer Integer, v2) ->
+                    concreteSEqOkProp (IdentityT v1, IdentityT v2)
+                ),
+              testGroup
+                "IdentityT (Either SymBool) SymBool"
+                [ testCase "IdentityT (Left v) vs IdentityT (Left v)" $
+                    ( IdentityT $ Left $ ssymBool "a" ::
+                        IdentityT (Either SymBool) SymBool
+                    )
+                      .== IdentityT (Left $ ssymBool "b")
+                      @=? ssymBool "a"
+                        .== ssymBool "b",
+                  testCase "IdentityT (Left v) vs IdentityT (Right v)" $
+                    ( IdentityT $ Left $ ssymBool "a" ::
+                        IdentityT (Either SymBool) SymBool
+                    )
+                      .== IdentityT (Right $ ssymBool "b")
+                      @=? conBool False,
+                  testCase "IdentityT (Right v) vs IdentityT (Left v)" $
+                    ( IdentityT $ Right $ ssymBool "a" ::
+                        IdentityT (Either SymBool) SymBool
+                    )
+                      .== IdentityT (Left $ ssymBool "b")
+                      @=? conBool False,
+                  testCase "IdentityT (Right v) vs IdentityT (Right v)" $
+                    ( IdentityT $ Right $ ssymBool "a" ::
+                        IdentityT (Either SymBool) SymBool
+                    )
+                      .== IdentityT (Right $ ssymBool "b")
+                      @=? ssymBool "a"
+                        .== ssymBool "b"
+                ]
+            ]
+        ],
+      testGroup
+        "deriving SEq for ADT"
+        [ testGroup
+            "Simple ADT"
+            [ testCase "A1 vs A1" $
+                A1 .== A1 @=? conBool True,
+              testCase "A1 vs A2" $
+                A1 .== A2 (ssymBool "a") @=? conBool False,
+              testCase "A1 vs A3" $
+                A1 .== A3 (ssymBool "a") (ssymBool "b") @=? conBool False,
+              testCase "A2 vs A1" $
+                A2 (ssymBool "a") .== A1 @=? conBool False,
+              testCase "A2 vs A2" $
+                A2 (ssymBool "a")
+                  .== A2 (ssymBool "b")
+                  @=? ssymBool "a"
+                    .== ssymBool "b",
+              testCase "A2 vs A3" $
+                A2 (ssymBool "a")
+                  .== A3 (ssymBool "b") (ssymBool "c")
+                  @=? conBool False,
+              testCase "A3 vs A1" $
+                A3 (ssymBool "a") (ssymBool "b") .== A1 @=? conBool False,
+              testCase "A3 vs A2" $
+                A3 (ssymBool "a") (ssymBool "b")
+                  .== A2 (ssymBool "c")
+                  @=? conBool False,
+              testCase "A3 vs A3" $
+                A3 (ssymBool "a") (ssymBool "b")
+                  .== A3 (ssymBool "c") (ssymBool "d")
+                  @=? (ssymBool "a" .== ssymBool "c")
+                    .&& (ssymBool "b" .== ssymBool "d")
+            ]
+        ]
+    ]
diff --git a/test/Grisette/Core/Data/Class/SOrdTests.hs b/test/Grisette/Core/Data/Class/SOrdTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/SOrdTests.hs
@@ -0,0 +1,1383 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Grisette.Core.Data.Class.SOrdTests (sordTests) where
+
+import Control.Monad.Except (ExceptT (ExceptT))
+import Control.Monad.Identity
+  ( Identity (Identity),
+    IdentityT (IdentityT),
+  )
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import qualified Control.Monad.Writer.Lazy as WriterLazy
+import qualified Control.Monad.Writer.Strict as WriterStrict
+import Data.Bifunctor (Bifunctor (bimap))
+import qualified Data.ByteString as B
+import Data.Foldable (traverse_)
+import Data.Functor.Sum (Sum (InL, InR))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.Stack (HasCallStack)
+import Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&), (.||)))
+import Grisette.Core.Data.Class.SEq (SEq ((.==)))
+import Grisette.Core.Data.Class.SOrd
+  ( SOrd (symCompare, (.<), (.<=), (.>), (.>=)),
+  )
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( mrgIf,
+    mrgSingle,
+  )
+import Grisette.Core.Data.Class.TestValues (conBool, ssymBool)
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Grisette.Lib.Control.Monad (mrgReturn)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit (Assertion, (@?=))
+import Test.QuickCheck (ioProperty)
+
+concreteOrdOkProp :: (HasCallStack, SOrd a, Ord a) => (a, a) -> Assertion
+concreteOrdOkProp (i, j) = do
+  i .<= j @?= conBool (i <= j)
+  i .< j @?= conBool (i < j)
+  i .>= j @?= conBool (i >= j)
+  i .> j @?= conBool (i > j)
+  symCompare i j @?= (mrgReturn $ compare i j :: UnionM Ordering)
+
+symbolicProdOrdOkProp ::
+  (HasCallStack, Show v, Show vl, Show vr, SOrd v, SOrd vl, SOrd vr) =>
+  v ->
+  v ->
+  vl ->
+  vr ->
+  vl ->
+  vr ->
+  Assertion
+symbolicProdOrdOkProp l r ll lr rl rr = do
+  l .<= r @?= ((ll .< rl) .|| ((ll .== rl) .&& (lr .<= rr)))
+  l .< r @?= ((ll .< rl) .|| ((ll .== rl) .&& (lr .< rr)))
+  l .>= r @?= ((ll .> rl) .|| ((ll .== rl) .&& (lr .>= rr)))
+  l .> r @?= ((ll .> rl) .|| ((ll .== rl) .&& (lr .> rr)))
+  l
+    `symCompare` r
+    @?= ( ( do
+              lc <- symCompare ll rl
+              case lc of
+                EQ -> symCompare lr rr
+                _ -> mrgReturn lc
+          ) ::
+            UnionM Ordering
+        )
+
+sordTests :: Test
+sordTests =
+  testGroup
+    "SOrd"
+    [ testGroup
+        "SOrd for common types"
+        [ testGroup
+            "SymBool"
+            [ testCase "Concrete SymBool" $ do
+                conBool False .<= conBool False @?= conBool True
+                conBool False .< conBool False @?= conBool False
+                conBool False .>= conBool False @?= conBool True
+                conBool False .> conBool False @?= conBool False
+                conBool False .<= conBool True @?= conBool True
+                conBool False .< conBool True @?= conBool True
+                conBool False .>= conBool True @?= conBool False
+                conBool False .> conBool True @?= conBool False
+                conBool True .<= conBool False @?= conBool False
+                conBool True .< conBool False @?= conBool False
+                conBool True .>= conBool False @?= conBool True
+                conBool True .> conBool False @?= conBool True
+                conBool True .<= conBool True @?= conBool True
+                conBool True .< conBool True @?= conBool False
+                conBool True .>= conBool True @?= conBool True
+                conBool True .> conBool True @?= conBool False,
+              testCase "Symbolic SymBool" $ do
+                ssymBool "a"
+                  .<= ssymBool "b"
+                  @?= (symNot (ssymBool "a"))
+                    .|| (ssymBool "b")
+                ssymBool "a"
+                  .< ssymBool "b"
+                  @?= (symNot (ssymBool "a"))
+                    .&& (ssymBool "b")
+                ssymBool "a"
+                  .>= ssymBool "b"
+                  @?= (ssymBool "a")
+                    .|| (symNot (ssymBool "b"))
+                ssymBool "a"
+                  .> ssymBool "b"
+                  @?= (ssymBool "a")
+                    .&& (symNot (ssymBool "b"))
+                symCompare (ssymBool "a") (ssymBool "b")
+                  @?= ( mrgIf
+                          ((symNot (ssymBool "a")) .&& (ssymBool "b"))
+                          (mrgSingle LT)
+                          ( mrgIf
+                              ((ssymBool "a") .== (ssymBool "b"))
+                              (mrgSingle EQ)
+                              (mrgSingle GT)
+                          ) ::
+                          UnionM Ordering
+                      )
+            ],
+          testProperty "Bool" (ioProperty . concreteOrdOkProp @Bool),
+          testProperty "Integer" (ioProperty . concreteOrdOkProp @Integer),
+          testProperty "Char" (ioProperty . concreteOrdOkProp @Char),
+          testProperty "Int" (ioProperty . concreteOrdOkProp @Int),
+          testProperty "Int8" (ioProperty . concreteOrdOkProp @Int8),
+          testProperty "Int16" (ioProperty . concreteOrdOkProp @Int16),
+          testProperty "Int32" (ioProperty . concreteOrdOkProp @Int32),
+          testProperty "Int64" (ioProperty . concreteOrdOkProp @Int64),
+          testProperty "Word" (ioProperty . concreteOrdOkProp @Word),
+          testProperty "Word8" (ioProperty . concreteOrdOkProp @Word8),
+          testProperty "Word16" (ioProperty . concreteOrdOkProp @Word16),
+          testProperty "Word32" (ioProperty . concreteOrdOkProp @Word32),
+          testProperty "Word64" (ioProperty . concreteOrdOkProp @Word64),
+          testGroup
+            "List"
+            [ testProperty "[Integer]" $
+                ioProperty . concreteOrdOkProp @[Integer],
+              testProperty "[String]" $
+                ioProperty . concreteOrdOkProp @[String],
+              testCase "[SymBool]" $ do
+                ([] :: [SymBool]) .<= [] @?= conBool True
+                ([] :: [SymBool]) .< [] @?= conBool False
+                ([] :: [SymBool]) .>= [] @?= conBool True
+                ([] :: [SymBool]) .> [] @?= conBool False
+                ([] :: [SymBool])
+                  `symCompare` []
+                  @?= (mrgSingle EQ :: UnionM Ordering)
+                [] .<= [ssymBool "a"] @?= conBool True
+                [] .< [ssymBool "a"] @?= conBool True
+                [] .>= [ssymBool "a"] @?= conBool False
+                [] .> [ssymBool "a"] @?= conBool False
+                []
+                  `symCompare` [ssymBool "a"]
+                  @?= (mrgSingle LT :: UnionM Ordering)
+                [ssymBool "a"] .<= [] @?= conBool False
+                [ssymBool "a"] .< [] @?= conBool False
+                [ssymBool "a"] .>= [] @?= conBool True
+                [ssymBool "a"] .> [] @?= conBool True
+                [ssymBool "a"]
+                  `symCompare` []
+                  @?= (mrgSingle GT :: UnionM Ordering)
+
+                [ssymBool "a", ssymBool "b"]
+                  .<= [ssymBool "c"]
+                  @?= (ssymBool "a" .< ssymBool "c" :: SymBool)
+                [ssymBool "a", ssymBool "b"]
+                  .< [ssymBool "c"]
+                  @?= (ssymBool "a" .< ssymBool "c" :: SymBool)
+                [ssymBool "a", ssymBool "b"]
+                  .>= [ssymBool "c"]
+                  @?= ( (ssymBool "a" .> ssymBool "c")
+                          .|| (ssymBool "a" .== ssymBool "c") ::
+                          SymBool
+                      )
+                [ssymBool "a", ssymBool "b"]
+                  .> [ssymBool "c"]
+                  @?= ( (ssymBool "a" .> ssymBool "c")
+                          .|| (ssymBool "a" .== ssymBool "c") ::
+                          SymBool
+                      )
+                [ssymBool "a"]
+                  `symCompare` [ssymBool "b"]
+                  @?= (ssymBool "a" `symCompare` ssymBool "b" :: UnionM Ordering)
+
+                [ssymBool "a"]
+                  .<= [ssymBool "b", ssymBool "c"]
+                  @?= ( (ssymBool "a" .< ssymBool "b")
+                          .|| (ssymBool "a" .== ssymBool "b") ::
+                          SymBool
+                      )
+                [ssymBool "a"]
+                  .< [ssymBool "b", ssymBool "c"]
+                  @?= ( (ssymBool "a" .< ssymBool "b")
+                          .|| (ssymBool "a" .== ssymBool "b") ::
+                          SymBool
+                      )
+                [ssymBool "a"]
+                  .>= [ssymBool "b", ssymBool "c"]
+                  @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+                [ssymBool "a"]
+                  .> [ssymBool "b", ssymBool "c"]
+                  @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+                [ssymBool "a"]
+                  `symCompare` [ssymBool "b", ssymBool "c"]
+                  @?= ( mrgIf
+                          (ssymBool "a" .< ssymBool "b")
+                          (mrgSingle LT)
+                          ( mrgIf
+                              (ssymBool "a" .== ssymBool "b")
+                              (mrgSingle LT)
+                              (mrgSingle GT)
+                          ) ::
+                          UnionM Ordering
+                      )
+
+                [ssymBool "a", ssymBool "b"]
+                  .<= [ssymBool "c", ssymBool "d"]
+                  @?= ( (ssymBool "a" .< ssymBool "c")
+                          .|| ( ssymBool "a"
+                                  .== ssymBool "c"
+                                  .&& ( (ssymBool "b" .< ssymBool "d")
+                                          .|| (ssymBool "b" .== ssymBool "d")
+                                      )
+                              ) ::
+                          SymBool
+                      )
+                [ssymBool "a", ssymBool "b"]
+                  .< [ssymBool "c", ssymBool "d"]
+                  @?= ( (ssymBool "a" .< ssymBool "c")
+                          .|| ( ssymBool "a"
+                                  .== ssymBool "c"
+                                  .&& (ssymBool "b" .< ssymBool "d")
+                              ) ::
+                          SymBool
+                      )
+                [ssymBool "a", ssymBool "b"]
+                  .>= [ssymBool "c", ssymBool "d"]
+                  @?= ( (ssymBool "a" .> ssymBool "c")
+                          .|| ( ssymBool "a"
+                                  .== ssymBool "c"
+                                  .&& ( (ssymBool "b" .> ssymBool "d")
+                                          .|| (ssymBool "b" .== ssymBool "d")
+                                      )
+                              ) ::
+                          SymBool
+                      )
+                [ssymBool "a", ssymBool "b"]
+                  .> [ssymBool "c", ssymBool "d"]
+                  @?= ( (ssymBool "a" .> ssymBool "c")
+                          .|| ( ssymBool "a"
+                                  .== ssymBool "c"
+                                  .&& (ssymBool "b" .> ssymBool "d")
+                              ) ::
+                          SymBool
+                      )
+                [ssymBool "a", ssymBool "b"]
+                  `symCompare` [ssymBool "c", ssymBool "d"]
+                  @?= ( mrgIf
+                          (ssymBool "a" .< ssymBool "c")
+                          (mrgSingle LT)
+                          ( mrgIf
+                              (ssymBool "a" .== ssymBool "c")
+                              (ssymBool "b" `symCompare` ssymBool "d")
+                              (mrgSingle GT)
+                          ) ::
+                          UnionM Ordering
+                      )
+            ],
+          testGroup
+            "Maybe"
+            [ testProperty "Maybe Integer" $
+                ioProperty . concreteOrdOkProp @(Maybe Integer),
+              testCase "Maybe SymBool" $ do
+                (Nothing :: Maybe SymBool) .<= Nothing @?= conBool True
+                (Nothing :: Maybe SymBool) .< Nothing @?= conBool False
+                (Nothing :: Maybe SymBool) .>= Nothing @?= conBool True
+                (Nothing :: Maybe SymBool) .> Nothing @?= conBool False
+                (Nothing :: Maybe SymBool)
+                  `symCompare` Nothing
+                  @?= (mrgSingle EQ :: UnionM Ordering)
+                Nothing .<= Just (ssymBool "a") @?= conBool True
+                Nothing .< Just (ssymBool "a") @?= conBool True
+                Nothing .>= Just (ssymBool "a") @?= conBool False
+                Nothing .> Just (ssymBool "a") @?= conBool False
+                Nothing
+                  `symCompare` Just (ssymBool "a")
+                  @?= (mrgSingle LT :: UnionM Ordering)
+                Just (ssymBool "a") .<= Nothing @?= conBool False
+                Just (ssymBool "a") .< Nothing @?= conBool False
+                Just (ssymBool "a") .>= Nothing @?= conBool True
+                Just (ssymBool "a") .> Nothing @?= conBool True
+                Just (ssymBool "a")
+                  `symCompare` Nothing
+                  @?= (mrgSingle GT :: UnionM Ordering)
+                Just (ssymBool "a")
+                  .<= Just (ssymBool "b")
+                  @?= (ssymBool "a" .<= ssymBool "b" :: SymBool)
+                Just (ssymBool "a")
+                  .< Just (ssymBool "b")
+                  @?= (ssymBool "a" .< ssymBool "b" :: SymBool)
+                Just (ssymBool "a")
+                  .>= Just (ssymBool "b")
+                  @?= (ssymBool "a" .>= ssymBool "b" :: SymBool)
+                Just (ssymBool "a")
+                  .> Just (ssymBool "b")
+                  @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+                Just (ssymBool "a")
+                  `symCompare` Just (ssymBool "b")
+                  @?= ( ssymBool "a" `symCompare` ssymBool "b" ::
+                          UnionM Ordering
+                      )
+            ],
+          testGroup
+            "MaybeT"
+            [ testProperty "MaybeT Maybe Integer" $
+                ioProperty
+                  . concreteOrdOkProp @(MaybeT Maybe Integer)
+                  . bimap MaybeT MaybeT,
+              testCase "MaybeT Maybe SymBool" $ do
+                (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  .<= MaybeT Nothing
+                  @?= conBool True
+                (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  .<= MaybeT (Just (Just (ssymBool "a")))
+                  @?= conBool True
+                MaybeT (Just (Just (ssymBool "a")))
+                  .<= (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  @?= conBool False
+                MaybeT (Just (Just (ssymBool "a")))
+                  .<= ( MaybeT (Just (Just (ssymBool "b"))) ::
+                          MaybeT Maybe SymBool
+                      )
+                  @?= (ssymBool "a" .<= ssymBool "b" :: SymBool)
+
+                (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  .< MaybeT Nothing
+                  @?= conBool False
+                (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  .< MaybeT (Just (Just (ssymBool "a")))
+                  @?= conBool True
+                MaybeT (Just (Just (ssymBool "a")))
+                  .< (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  @?= conBool False
+                MaybeT (Just (Just (ssymBool "a")))
+                  .< ( MaybeT (Just (Just (ssymBool "b"))) ::
+                         MaybeT Maybe SymBool
+                     )
+                  @?= (ssymBool "a" .< ssymBool "b" :: SymBool)
+
+                (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  .>= MaybeT Nothing
+                  @?= conBool True
+                (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  .>= MaybeT (Just (Just (ssymBool "a")))
+                  @?= conBool False
+                MaybeT (Just (Just (ssymBool "a")))
+                  .>= (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  @?= conBool True
+                MaybeT (Just (Just (ssymBool "a")))
+                  .>= ( MaybeT (Just (Just (ssymBool "b"))) ::
+                          MaybeT Maybe SymBool
+                      )
+                  @?= (ssymBool "a" .>= ssymBool "b" :: SymBool)
+
+                (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  .> MaybeT Nothing
+                  @?= conBool False
+                (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  .> MaybeT (Just (Just (ssymBool "a")))
+                  @?= conBool False
+                MaybeT (Just (Just (ssymBool "a")))
+                  .> (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  @?= conBool True
+                MaybeT (Just (Just (ssymBool "a")))
+                  .> ( MaybeT (Just (Just (ssymBool "b"))) ::
+                         MaybeT Maybe SymBool
+                     )
+                  @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+
+                (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  `symCompare` MaybeT Nothing
+                  @?= (mrgSingle EQ :: UnionM Ordering)
+                (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  `symCompare` MaybeT (Just (Just (ssymBool "a")))
+                  @?= (mrgSingle LT :: UnionM Ordering)
+                MaybeT (Just (Just (ssymBool "a")))
+                  `symCompare` (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  @?= (mrgSingle GT :: UnionM Ordering)
+                MaybeT (Just (Just (ssymBool "a")))
+                  `symCompare` ( MaybeT (Just (Just (ssymBool "b"))) ::
+                                   MaybeT Maybe SymBool
+                               )
+                  @?= ( ssymBool "a" `symCompare` ssymBool "b" ::
+                          UnionM Ordering
+                      )
+            ],
+          testGroup
+            "Either"
+            [ testProperty "Either Integer Integer" $
+                ioProperty . concreteOrdOkProp @(Either Integer Integer),
+              testCase "Either SymBool SymBool" $ do
+                (Left (ssymBool "a") :: Either SymBool SymBool)
+                  .<= Left (ssymBool "b")
+                  @?= (ssymBool "a" .<= ssymBool "b" :: SymBool)
+                (Left (ssymBool "a") :: Either SymBool SymBool)
+                  .< Left (ssymBool "b")
+                  @?= (ssymBool "a" .< ssymBool "b" :: SymBool)
+                (Left (ssymBool "a") :: Either SymBool SymBool)
+                  .>= Left (ssymBool "b")
+                  @?= (ssymBool "a" .>= ssymBool "b" :: SymBool)
+                (Left (ssymBool "a") :: Either SymBool SymBool)
+                  .> Left (ssymBool "b")
+                  @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+                (Left (ssymBool "a") :: Either SymBool SymBool)
+                  `symCompare` Left (ssymBool "b")
+                  @?= (ssymBool "a" `symCompare` ssymBool "b")
+                (Left (ssymBool "a") :: Either SymBool SymBool)
+                  .<= Right (ssymBool "b")
+                  @?= conBool True
+                (Left (ssymBool "a") :: Either SymBool SymBool)
+                  .< Right (ssymBool "b")
+                  @?= conBool True
+                (Left (ssymBool "a") :: Either SymBool SymBool)
+                  .>= Right (ssymBool "b")
+                  @?= conBool False
+                (Left (ssymBool "a") :: Either SymBool SymBool)
+                  .> Right (ssymBool "b")
+                  @?= conBool False
+                (Left (ssymBool "a") :: Either SymBool SymBool)
+                  `symCompare` Right (ssymBool "b")
+                  @?= (mrgSingle LT :: UnionM Ordering)
+                (Right (ssymBool "a") :: Either SymBool SymBool)
+                  .<= Left (ssymBool "b")
+                  @?= conBool False
+                (Right (ssymBool "a") :: Either SymBool SymBool)
+                  .< Left (ssymBool "b")
+                  @?= conBool False
+                (Right (ssymBool "a") :: Either SymBool SymBool)
+                  .>= Left (ssymBool "b")
+                  @?= conBool True
+                (Right (ssymBool "a") :: Either SymBool SymBool)
+                  .> Left (ssymBool "b")
+                  @?= conBool True
+                (Right (ssymBool "a") :: Either SymBool SymBool)
+                  `symCompare` Left (ssymBool "b")
+                  @?= (mrgSingle GT :: UnionM Ordering)
+                (Right (ssymBool "a") :: Either SymBool SymBool)
+                  .<= Right (ssymBool "b")
+                  @?= (ssymBool "a" .<= ssymBool "b" :: SymBool)
+                (Right (ssymBool "a") :: Either SymBool SymBool)
+                  .< Right (ssymBool "b")
+                  @?= (ssymBool "a" .< ssymBool "b" :: SymBool)
+                (Right (ssymBool "a") :: Either SymBool SymBool)
+                  .>= Right (ssymBool "b")
+                  @?= (ssymBool "a" .>= ssymBool "b" :: SymBool)
+                (Right (ssymBool "a") :: Either SymBool SymBool)
+                  .> Right (ssymBool "b")
+                  @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+                (Right (ssymBool "a") :: Either SymBool SymBool)
+                  `symCompare` Right (ssymBool "b")
+                  @?= (ssymBool "a" `symCompare` ssymBool "b")
+            ],
+          testGroup
+            "ExceptT"
+            [ testProperty
+                "ExceptT Integer Maybe Integer"
+                $ ioProperty
+                  . concreteOrdOkProp @(ExceptT Integer Maybe Integer)
+                  . bimap ExceptT ExceptT,
+              testCase "ExceptT SymBool Maybe SymBool" $ do
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  .<= ExceptT Nothing
+                  @?= conBool True
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  .<= ExceptT (Just (Left (ssymBool "a")))
+                  @?= conBool True
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  .<= ExceptT (Just (Right (ssymBool "a")))
+                  @?= conBool True
+                ExceptT (Just (Left (ssymBool "a")))
+                  .<= (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  @?= conBool False
+                ExceptT (Just (Right (ssymBool "a")))
+                  .<= (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  @?= conBool False
+                ExceptT (Just (Left (ssymBool "a")))
+                  .<= ( ExceptT (Just (Left (ssymBool "b"))) ::
+                          ExceptT SymBool Maybe SymBool
+                      )
+                  @?= (ssymBool "a" .<= ssymBool "b" :: SymBool)
+                ExceptT (Just (Right (ssymBool "a")))
+                  .<= ( ExceptT (Just (Left (ssymBool "b"))) ::
+                          ExceptT SymBool Maybe SymBool
+                      )
+                  @?= conBool False
+                ExceptT (Just (Left (ssymBool "a")))
+                  .<= ( ExceptT (Just (Right (ssymBool "b"))) ::
+                          ExceptT SymBool Maybe SymBool
+                      )
+                  @?= conBool True
+                ExceptT (Just (Right (ssymBool "a")))
+                  .<= ( ExceptT (Just (Right (ssymBool "b"))) ::
+                          ExceptT SymBool Maybe SymBool
+                      )
+                  @?= (ssymBool "a" .<= ssymBool "b" :: SymBool)
+
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  .< ExceptT Nothing
+                  @?= conBool False
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  .< ExceptT (Just (Left (ssymBool "a")))
+                  @?= conBool True
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  .< ExceptT (Just (Right (ssymBool "a")))
+                  @?= conBool True
+                ExceptT (Just (Left (ssymBool "a")))
+                  .< (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  @?= conBool False
+                ExceptT (Just (Right (ssymBool "a")))
+                  .< (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  @?= conBool False
+                ExceptT (Just (Left (ssymBool "a")))
+                  .< ( ExceptT (Just (Left (ssymBool "b"))) ::
+                         ExceptT SymBool Maybe SymBool
+                     )
+                  @?= (ssymBool "a" .< ssymBool "b" :: SymBool)
+                ExceptT (Just (Right (ssymBool "a")))
+                  .< ( ExceptT (Just (Left (ssymBool "b"))) ::
+                         ExceptT SymBool Maybe SymBool
+                     )
+                  @?= conBool False
+                ExceptT (Just (Left (ssymBool "a")))
+                  .< ( ExceptT (Just (Right (ssymBool "b"))) ::
+                         ExceptT SymBool Maybe SymBool
+                     )
+                  @?= conBool True
+                ExceptT (Just (Right (ssymBool "a")))
+                  .< ( ExceptT (Just (Right (ssymBool "b"))) ::
+                         ExceptT SymBool Maybe SymBool
+                     )
+                  @?= (ssymBool "a" .< ssymBool "b" :: SymBool)
+
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  .>= ExceptT Nothing
+                  @?= conBool True
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  .>= ExceptT (Just (Left (ssymBool "a")))
+                  @?= conBool False
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  .>= ExceptT (Just (Right (ssymBool "a")))
+                  @?= conBool False
+                ExceptT (Just (Left (ssymBool "a")))
+                  .>= (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  @?= conBool True
+                ExceptT (Just (Right (ssymBool "a")))
+                  .>= (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  @?= conBool True
+                ExceptT (Just (Left (ssymBool "a")))
+                  .>= ( ExceptT (Just (Left (ssymBool "b"))) ::
+                          ExceptT SymBool Maybe SymBool
+                      )
+                  @?= (ssymBool "a" .>= ssymBool "b" :: SymBool)
+                ExceptT (Just (Right (ssymBool "a")))
+                  .>= ( ExceptT (Just (Left (ssymBool "b"))) ::
+                          ExceptT SymBool Maybe SymBool
+                      )
+                  @?= conBool True
+                ExceptT (Just (Left (ssymBool "a")))
+                  .>= ( ExceptT (Just (Right (ssymBool "b"))) ::
+                          ExceptT SymBool Maybe SymBool
+                      )
+                  @?= conBool False
+                ExceptT (Just (Right (ssymBool "a")))
+                  .>= ( ExceptT (Just (Right (ssymBool "b"))) ::
+                          ExceptT SymBool Maybe SymBool
+                      )
+                  @?= (ssymBool "a" .>= ssymBool "b" :: SymBool)
+
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  .> ExceptT Nothing
+                  @?= conBool False
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  .> ExceptT (Just (Left (ssymBool "a")))
+                  @?= conBool False
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  .> ExceptT (Just (Right (ssymBool "a")))
+                  @?= conBool False
+                ExceptT (Just (Left (ssymBool "a")))
+                  .> (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  @?= conBool True
+                ExceptT (Just (Right (ssymBool "a")))
+                  .> (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  @?= conBool True
+                ExceptT (Just (Left (ssymBool "a")))
+                  .> ( ExceptT (Just (Left (ssymBool "b"))) ::
+                         ExceptT SymBool Maybe SymBool
+                     )
+                  @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+                ExceptT (Just (Right (ssymBool "a")))
+                  .> ( ExceptT (Just (Left (ssymBool "b"))) ::
+                         ExceptT SymBool Maybe SymBool
+                     )
+                  @?= conBool True
+                ExceptT (Just (Left (ssymBool "a")))
+                  .> ( ExceptT (Just (Right (ssymBool "b"))) ::
+                         ExceptT SymBool Maybe SymBool
+                     )
+                  @?= conBool False
+                ExceptT (Just (Right (ssymBool "a")))
+                  .> ( ExceptT (Just (Right (ssymBool "b"))) ::
+                         ExceptT SymBool Maybe SymBool
+                     )
+                  @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  `symCompare` ExceptT Nothing
+                  @?= (mrgSingle EQ :: UnionM Ordering)
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  `symCompare` ExceptT (Just (Left (ssymBool "a")))
+                  @?= (mrgSingle LT :: UnionM Ordering)
+                (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                  `symCompare` ExceptT (Just (Right (ssymBool "a")))
+                  @?= (mrgSingle LT :: UnionM Ordering)
+                ExceptT (Just (Left (ssymBool "a")))
+                  `symCompare` ( ExceptT Nothing ::
+                                   ExceptT SymBool Maybe SymBool
+                               )
+                  @?= (mrgSingle GT :: UnionM Ordering)
+                ExceptT (Just (Right (ssymBool "a")))
+                  `symCompare` ( ExceptT Nothing ::
+                                   ExceptT SymBool Maybe SymBool
+                               )
+                  @?= (mrgSingle GT :: UnionM Ordering)
+                ExceptT (Just (Left (ssymBool "a")))
+                  `symCompare` ( ExceptT (Just (Left (ssymBool "b"))) ::
+                                   ExceptT SymBool Maybe SymBool
+                               )
+                  @?= (ssymBool "a" `symCompare` ssymBool "b" :: UnionM Ordering)
+                ExceptT (Just (Right (ssymBool "a")))
+                  `symCompare` ( ExceptT (Just (Left (ssymBool "b"))) ::
+                                   ExceptT SymBool Maybe SymBool
+                               )
+                  @?= (mrgSingle GT :: UnionM Ordering)
+                ExceptT (Just (Left (ssymBool "a")))
+                  `symCompare` ( ExceptT (Just (Right (ssymBool "b"))) ::
+                                   ExceptT SymBool Maybe SymBool
+                               )
+                  @?= (mrgSingle LT :: UnionM Ordering)
+                ExceptT (Just (Right (ssymBool "a")))
+                  `symCompare` ( ExceptT (Just (Right (ssymBool "b"))) ::
+                                   ExceptT SymBool Maybe SymBool
+                               )
+                  @?= ( ssymBool "a" `symCompare` ssymBool "b" ::
+                          UnionM Ordering
+                      )
+            ],
+          testProperty "()" (ioProperty . concreteOrdOkProp @()),
+          testGroup
+            "(,)"
+            [ testProperty "(Integer, Integer)" $
+                ioProperty . concreteOrdOkProp @(Integer, Integer),
+              testCase "(SymBool, SymBool)" $ do
+                let l = (ssymBool "a", ssymBool "c")
+                let r = (ssymBool "b", ssymBool "d")
+                let ll = ssymBool "a"
+                let lr = ssymBool "c"
+                let rl = ssymBool "b"
+                let rr = ssymBool "d"
+                symbolicProdOrdOkProp l r ll lr rl rr
+            ],
+          testGroup
+            "(,,)"
+            [ testProperty "(Integer, Integer, Integer)" $
+                ioProperty . concreteOrdOkProp @(Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool)" $ do
+                let l = (ssymBool "a", ssymBool "c", ssymBool "e")
+                let r = (ssymBool "b", ssymBool "d", ssymBool "f")
+                let ll = ssymBool "a"
+                let lr = (ssymBool "c", ssymBool "e")
+                let rl = ssymBool "b"
+                let rr = (ssymBool "d", ssymBool "f")
+                symbolicProdOrdOkProp l r ll lr rl rr
+            ],
+          testGroup
+            "(,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteOrdOkProp @(Integer, Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool, SymBool)" $ do
+                let l = (ssymBool "a", ssymBool "c", ssymBool "e", ssymBool "g")
+                let r = (ssymBool "b", ssymBool "d", ssymBool "f", ssymBool "h")
+                let ll = (ssymBool "a", ssymBool "c")
+                let lr = (ssymBool "e", ssymBool "g")
+                let rl = (ssymBool "b", ssymBool "d")
+                let rr = (ssymBool "f", ssymBool "h")
+                symbolicProdOrdOkProp l r ll lr rl rr
+            ],
+          testGroup
+            "(,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteOrdOkProp
+                    @(Integer, Integer, Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool, SymBool, SymBool)" $ do
+                let l =
+                      ( ssymBool "a",
+                        ssymBool "c",
+                        ssymBool "e",
+                        ssymBool "g",
+                        ssymBool "i"
+                      )
+                let r =
+                      ( ssymBool "b",
+                        ssymBool "d",
+                        ssymBool "f",
+                        ssymBool "h",
+                        ssymBool "j"
+                      )
+                let ll = (ssymBool "a", ssymBool "c")
+                let lr = (ssymBool "e", ssymBool "g", ssymBool "i")
+                let rl = (ssymBool "b", ssymBool "d")
+                let rr = (ssymBool "f", ssymBool "h", ssymBool "j")
+                symbolicProdOrdOkProp l r ll lr rl rr
+            ],
+          testGroup
+            "(,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteOrdOkProp
+                    @( Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer
+                     ),
+              testCase
+                "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                $ do
+                  let l =
+                        ( ssymBool "a",
+                          ssymBool "c",
+                          ssymBool "e",
+                          ssymBool "g",
+                          ssymBool "i",
+                          ssymBool "k"
+                        )
+                  let r =
+                        ( ssymBool "b",
+                          ssymBool "d",
+                          ssymBool "f",
+                          ssymBool "h",
+                          ssymBool "j",
+                          ssymBool "l"
+                        )
+                  let ll = (ssymBool "a", ssymBool "c", ssymBool "e")
+                  let lr = (ssymBool "g", ssymBool "i", ssymBool "k")
+                  let rl = (ssymBool "b", ssymBool "d", ssymBool "f")
+                  let rr = (ssymBool "h", ssymBool "j", ssymBool "l")
+                  symbolicProdOrdOkProp l r ll lr rl rr
+            ],
+          testGroup
+            "(,,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteOrdOkProp @(Integer, Integer, Integer, Integer, Integer, Integer, Integer),
+              testCase
+                "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                $ do
+                  let l =
+                        ( ssymBool "a",
+                          ssymBool "c",
+                          ssymBool "e",
+                          ssymBool "g",
+                          ssymBool "i",
+                          ssymBool "k",
+                          ssymBool "m"
+                        )
+                  let r =
+                        ( ssymBool "b",
+                          ssymBool "d",
+                          ssymBool "f",
+                          ssymBool "h",
+                          ssymBool "j",
+                          ssymBool "l",
+                          ssymBool "n"
+                        )
+                  let ll = (ssymBool "a", ssymBool "c", ssymBool "e")
+                  let lr =
+                        ( ssymBool "g",
+                          ssymBool "i",
+                          ssymBool "k",
+                          ssymBool "m"
+                        )
+                  let rl = (ssymBool "b", ssymBool "d", ssymBool "f")
+                  let rr =
+                        ( ssymBool "h",
+                          ssymBool "j",
+                          ssymBool "l",
+                          ssymBool "n"
+                        )
+                  symbolicProdOrdOkProp l r ll lr rl rr
+            ],
+          testGroup
+            "(,,,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer, Integer, Integer)"
+                ( ioProperty
+                    . concreteOrdOkProp
+                      @( Integer,
+                         Integer,
+                         Integer,
+                         Integer,
+                         Integer,
+                         Integer,
+                         Integer,
+                         Integer
+                       )
+                ),
+              testCase
+                "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                $ do
+                  let l =
+                        ( ssymBool "a",
+                          ssymBool "c",
+                          ssymBool "e",
+                          ssymBool "g",
+                          ssymBool "i",
+                          ssymBool "k",
+                          ssymBool "m",
+                          ssymBool "o"
+                        )
+                  let r =
+                        ( ssymBool "b",
+                          ssymBool "d",
+                          ssymBool "f",
+                          ssymBool "h",
+                          ssymBool "j",
+                          ssymBool "l",
+                          ssymBool "n",
+                          ssymBool "p"
+                        )
+                  let ll =
+                        ( ssymBool "a",
+                          ssymBool "c",
+                          ssymBool "e",
+                          ssymBool "g"
+                        )
+                  let lr =
+                        ( ssymBool "i",
+                          ssymBool "k",
+                          ssymBool "m",
+                          ssymBool "o"
+                        )
+                  let rl =
+                        ( ssymBool "b",
+                          ssymBool "d",
+                          ssymBool "f",
+                          ssymBool "h"
+                        )
+                  let rr =
+                        ( ssymBool "j",
+                          ssymBool "l",
+                          ssymBool "n",
+                          ssymBool "p"
+                        )
+                  symbolicProdOrdOkProp l r ll lr rl rr
+            ],
+          testGroup
+            "Sum"
+            [ testProperty
+                "Sum Maybe Maybe Integer"
+                ( ioProperty . \v ->
+                    let eitherToSum ::
+                          Either (Maybe Integer) (Maybe Integer) ->
+                          Sum Maybe Maybe Integer
+                        eitherToSum (Left x) = InL x
+                        eitherToSum (Right x) = InR x
+                     in concreteOrdOkProp (bimap eitherToSum eitherToSum v)
+                ),
+              testCase "Sum Maybe Maybe SymBool" $ do
+                (InL $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .<= InL (Just $ ssymBool "b")
+                  @?= (ssymBool "a" .<= ssymBool "b" :: SymBool)
+                (InL $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .< InL (Just $ ssymBool "b")
+                  @?= (ssymBool "a" .< ssymBool "b" :: SymBool)
+                (InL $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .>= InL (Just $ ssymBool "b")
+                  @?= (ssymBool "a" .>= ssymBool "b" :: SymBool)
+                (InL $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .> InL (Just $ ssymBool "b")
+                  @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+                (InL $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .<= InR (Just $ ssymBool "b")
+                  @?= conBool True
+                (InL $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .< InR (Just $ ssymBool "b")
+                  @?= conBool True
+                (InL $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .>= InR (Just $ ssymBool "b")
+                  @?= conBool False
+                (InL $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .> InR (Just $ ssymBool "b")
+                  @?= conBool False
+                (InR $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .<= InR (Just $ ssymBool "b")
+                  @?= (ssymBool "a" .<= ssymBool "b" :: SymBool)
+                (InR $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .< InR (Just $ ssymBool "b")
+                  @?= (ssymBool "a" .< ssymBool "b" :: SymBool)
+                (InR $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .>= InR (Just $ ssymBool "b")
+                  @?= (ssymBool "a" .>= ssymBool "b" :: SymBool)
+                (InR $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .> InR (Just $ ssymBool "b")
+                  @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+                (InR $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .<= InL (Just $ ssymBool "b")
+                  @?= conBool False
+                (InR $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .< InL (Just $ ssymBool "b")
+                  @?= conBool False
+                (InR $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .>= InL (Just $ ssymBool "b")
+                  @?= conBool True
+                (InR $ Just $ ssymBool "a" :: Sum Maybe Maybe SymBool)
+                  .> InL (Just $ ssymBool "b")
+                  @?= conBool True
+            ],
+          testGroup
+            "WriterT"
+            [ testGroup
+                "Lazy"
+                [ testProperty
+                    "WriterT Integer (Either Integer) Integer"
+                    ( ioProperty
+                        . \( v1 :: Either Integer (Integer, Integer),
+                             v2 :: Either Integer (Integer, Integer)
+                             ) ->
+                            concreteOrdOkProp
+                              ( WriterLazy.WriterT v1,
+                                WriterLazy.WriterT v2
+                              )
+                    ),
+                  testCase "WriterT SymBool (Either SymBool) SymBool" $ do
+                    ( WriterLazy.WriterT $ Left $ ssymBool "a" ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .<= WriterLazy.WriterT (Left $ ssymBool "b")
+                      @?= (ssymBool "a" .<= ssymBool "b" :: SymBool)
+                    ( WriterLazy.WriterT $ Left $ ssymBool "a" ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .< WriterLazy.WriterT (Left $ ssymBool "b")
+                      @?= (ssymBool "a" .< ssymBool "b" :: SymBool)
+                    ( WriterLazy.WriterT $ Left $ ssymBool "a" ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .>= WriterLazy.WriterT (Left $ ssymBool "b")
+                      @?= (ssymBool "a" .>= ssymBool "b" :: SymBool)
+                    ( WriterLazy.WriterT $ Left $ ssymBool "a" ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .> WriterLazy.WriterT (Left $ ssymBool "b")
+                      @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+                    ( WriterLazy.WriterT $ Left $ ssymBool "a" ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      `symCompare` WriterLazy.WriterT (Left $ ssymBool "b")
+                      @?= ( ssymBool "a" `symCompare` ssymBool "b" ::
+                              UnionM Ordering
+                          )
+
+                    ( WriterLazy.WriterT $ Left $ ssymBool "a" ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .<= WriterLazy.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= conBool True
+                    ( WriterLazy.WriterT $ Left $ ssymBool "a" ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .< WriterLazy.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= conBool True
+                    ( WriterLazy.WriterT $ Left $ ssymBool "a" ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .>= WriterLazy.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= conBool False
+                    ( WriterLazy.WriterT $ Left $ ssymBool "a" ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .> WriterLazy.WriterT (Right (ssymBool "b", ssymBool "d"))
+                      @?= conBool False
+                    ( WriterLazy.WriterT $ Left $ ssymBool "a" ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      `symCompare` WriterLazy.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= (mrgSingle LT :: UnionM Ordering)
+
+                    ( WriterLazy.WriterT $ Right (ssymBool "a", ssymBool "c") ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .<= WriterLazy.WriterT (Left $ ssymBool "b")
+                      @?= conBool False
+                    ( WriterLazy.WriterT $ Right (ssymBool "a", ssymBool "c") ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .< WriterLazy.WriterT (Left $ ssymBool "b")
+                      @?= conBool False
+                    ( WriterLazy.WriterT $ Right (ssymBool "a", ssymBool "c") ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .>= WriterLazy.WriterT (Left $ ssymBool "b")
+                      @?= conBool True
+                    ( WriterLazy.WriterT $ Right (ssymBool "a", ssymBool "c") ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .> WriterLazy.WriterT (Left $ ssymBool "b")
+                      @?= conBool True
+                    ( WriterLazy.WriterT $ Right (ssymBool "a", ssymBool "c") ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      `symCompare` WriterLazy.WriterT (Left $ ssymBool "b")
+                      @?= (mrgSingle GT :: UnionM Ordering)
+
+                    ( WriterLazy.WriterT $ Right (ssymBool "a", ssymBool "c") ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .<= WriterLazy.WriterT (Right (ssymBool "b", ssymBool "d"))
+                      @?= ( (ssymBool "a", ssymBool "c")
+                              .<= (ssymBool "b", ssymBool "d") ::
+                              SymBool
+                          )
+                    ( WriterLazy.WriterT $ Right (ssymBool "a", ssymBool "c") ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .< WriterLazy.WriterT (Right (ssymBool "b", ssymBool "d"))
+                      @?= ( (ssymBool "a", ssymBool "c")
+                              .< (ssymBool "b", ssymBool "d") ::
+                              SymBool
+                          )
+                    ( WriterLazy.WriterT $ Right (ssymBool "a", ssymBool "c") ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .>= WriterLazy.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= ( (ssymBool "a", ssymBool "c")
+                              .>= (ssymBool "b", ssymBool "d") ::
+                              SymBool
+                          )
+                    ( WriterLazy.WriterT $ Right (ssymBool "a", ssymBool "c") ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .> WriterLazy.WriterT (Right (ssymBool "b", ssymBool "d"))
+                      @?= ( (ssymBool "a", ssymBool "c")
+                              .> (ssymBool "b", ssymBool "d") ::
+                              SymBool
+                          )
+                    ( WriterLazy.WriterT $ Right (ssymBool "a", ssymBool "c") ::
+                        WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      `symCompare` WriterLazy.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= ( (ssymBool "a", ssymBool "c")
+                              `symCompare` (ssymBool "b", ssymBool "d") ::
+                              UnionM Ordering
+                          )
+                ],
+              testGroup
+                "Strict"
+                [ testProperty
+                    "WriterT Integer (Either Integer) Integer"
+                    ( ioProperty
+                        . \( v1 :: Either Integer (Integer, Integer),
+                             v2 :: Either Integer (Integer, Integer)
+                             ) ->
+                            concreteOrdOkProp
+                              ( WriterStrict.WriterT v1,
+                                WriterStrict.WriterT v2
+                              )
+                    ),
+                  testCase "WriterT Integer (Either Integer) Integer" $ do
+                    ( WriterStrict.WriterT $ Left $ ssymBool "a" ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .<= WriterStrict.WriterT (Left $ ssymBool "b")
+                      @?= (ssymBool "a" .<= ssymBool "b" :: SymBool)
+                    ( WriterStrict.WriterT $ Left $ ssymBool "a" ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .< WriterStrict.WriterT (Left $ ssymBool "b")
+                      @?= (ssymBool "a" .< ssymBool "b" :: SymBool)
+                    ( WriterStrict.WriterT $ Left $ ssymBool "a" ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .>= WriterStrict.WriterT (Left $ ssymBool "b")
+                      @?= (ssymBool "a" .>= ssymBool "b" :: SymBool)
+                    ( WriterStrict.WriterT $ Left $ ssymBool "a" ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .> WriterStrict.WriterT (Left $ ssymBool "b")
+                      @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+                    ( WriterStrict.WriterT $ Left $ ssymBool "a" ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      `symCompare` WriterStrict.WriterT (Left $ ssymBool "b")
+                      @?= ( ssymBool "a" `symCompare` ssymBool "b" ::
+                              UnionM Ordering
+                          )
+
+                    ( WriterStrict.WriterT $ Left $ ssymBool "a" ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .<= WriterStrict.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= conBool True
+                    ( WriterStrict.WriterT $ Left $ ssymBool "a" ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .< WriterStrict.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= conBool True
+                    ( WriterStrict.WriterT $ Left $ ssymBool "a" ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .>= WriterStrict.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= conBool False
+                    ( WriterStrict.WriterT $ Left $ ssymBool "a" ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .> WriterStrict.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= conBool False
+                    ( WriterStrict.WriterT $ Left $ ssymBool "a" ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      `symCompare` WriterStrict.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= (mrgSingle LT :: UnionM Ordering)
+
+                    ( WriterStrict.WriterT $
+                        Right (ssymBool "a", ssymBool "c") ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .<= WriterStrict.WriterT (Left $ ssymBool "b")
+                      @?= conBool False
+                    ( WriterStrict.WriterT $
+                        Right (ssymBool "a", ssymBool "c") ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .< WriterStrict.WriterT (Left $ ssymBool "b")
+                      @?= conBool False
+                    ( WriterStrict.WriterT $
+                        Right (ssymBool "a", ssymBool "c") ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .>= WriterStrict.WriterT (Left $ ssymBool "b")
+                      @?= conBool True
+                    ( WriterStrict.WriterT $
+                        Right (ssymBool "a", ssymBool "c") ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .> WriterStrict.WriterT (Left $ ssymBool "b")
+                      @?= conBool True
+                    ( WriterStrict.WriterT $
+                        Right (ssymBool "a", ssymBool "c") ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      `symCompare` WriterStrict.WriterT (Left $ ssymBool "b")
+                      @?= (mrgSingle GT :: UnionM Ordering)
+
+                    ( WriterStrict.WriterT $
+                        Right (ssymBool "a", ssymBool "c") ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .<= WriterStrict.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= ( (ssymBool "a", ssymBool "c")
+                              .<= (ssymBool "b", ssymBool "d") ::
+                              SymBool
+                          )
+                    ( WriterStrict.WriterT $
+                        Right (ssymBool "a", ssymBool "c") ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .< WriterStrict.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= ( (ssymBool "a", ssymBool "c")
+                              .< (ssymBool "b", ssymBool "d") ::
+                              SymBool
+                          )
+                    ( WriterStrict.WriterT $
+                        Right (ssymBool "a", ssymBool "c") ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .>= WriterStrict.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= ( (ssymBool "a", ssymBool "c")
+                              .>= (ssymBool "b", ssymBool "d") ::
+                              SymBool
+                          )
+                    ( WriterStrict.WriterT $
+                        Right (ssymBool "a", ssymBool "c") ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      .> WriterStrict.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= ( (ssymBool "a", ssymBool "c")
+                              .> (ssymBool "b", ssymBool "d") ::
+                              SymBool
+                          )
+                    ( WriterStrict.WriterT $
+                        Right (ssymBool "a", ssymBool "c") ::
+                        WriterStrict.WriterT SymBool (Either SymBool) SymBool
+                      )
+                      `symCompare` WriterStrict.WriterT
+                        (Right (ssymBool "b", ssymBool "d"))
+                      @?= ( (ssymBool "a", ssymBool "c")
+                              `symCompare` (ssymBool "b", ssymBool "d") ::
+                              UnionM Ordering
+                          )
+                ]
+            ],
+          testGroup
+            "Identity"
+            [ testProperty
+                "Identity Integer"
+                ( ioProperty . \(v1 :: Integer, v2) ->
+                    concreteOrdOkProp (Identity v1, Identity v2)
+                ),
+              testCase "Identity SymBool" $ do
+                (Identity $ ssymBool "a" :: Identity SymBool)
+                  .<= Identity (ssymBool "b")
+                  @?= (ssymBool "a" .<= ssymBool "b" :: SymBool)
+                (Identity $ ssymBool "a" :: Identity SymBool)
+                  .< Identity (ssymBool "b")
+                  @?= (ssymBool "a" .< ssymBool "b" :: SymBool)
+                (Identity $ ssymBool "a" :: Identity SymBool)
+                  .>= Identity (ssymBool "b")
+                  @?= (ssymBool "a" .>= ssymBool "b" :: SymBool)
+                (Identity $ ssymBool "a" :: Identity SymBool)
+                  .> Identity (ssymBool "b")
+                  @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+            ],
+          testGroup
+            "IdentityT"
+            [ testProperty
+                "IdentityT (Either Integer) Integer"
+                ( ioProperty . \(v1 :: Either Integer Integer, v2) ->
+                    concreteOrdOkProp (IdentityT v1, IdentityT v2)
+                ),
+              testCase "IdentityT (Either SymBool) SymBool" $ do
+                ( IdentityT $ Left $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .<= IdentityT (Left $ ssymBool "b")
+                  @?= (ssymBool "a" .<= ssymBool "b" :: SymBool)
+                ( IdentityT $ Left $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .< IdentityT (Left $ ssymBool "b")
+                  @?= (ssymBool "a" .< ssymBool "b" :: SymBool)
+                ( IdentityT $ Left $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .>= IdentityT (Left $ ssymBool "b")
+                  @?= (ssymBool "a" .>= ssymBool "b" :: SymBool)
+                ( IdentityT $ Left $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .> IdentityT (Left $ ssymBool "b")
+                  @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+                ( IdentityT $ Left $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  `symCompare` IdentityT (Left $ ssymBool "b")
+                  @?= (ssymBool "a" `symCompare` ssymBool "b")
+
+                ( IdentityT $ Left $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .<= IdentityT (Right $ ssymBool "b")
+                  @?= conBool True
+                ( IdentityT $ Left $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .< IdentityT (Right $ ssymBool "b")
+                  @?= conBool True
+                ( IdentityT $ Left $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .>= IdentityT (Right $ ssymBool "b")
+                  @?= conBool False
+                ( IdentityT $ Left $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .> IdentityT (Right $ ssymBool "b")
+                  @?= conBool False
+                ( IdentityT $ Left $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  `symCompare` IdentityT (Right $ ssymBool "b")
+                  @?= (mrgSingle LT :: UnionM Ordering)
+
+                ( IdentityT $ Right $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .<= IdentityT (Left $ ssymBool "b")
+                  @?= conBool False
+                ( IdentityT $ Right $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .< IdentityT (Left $ ssymBool "b")
+                  @?= conBool False
+                ( IdentityT $ Right $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .>= IdentityT (Left $ ssymBool "b")
+                  @?= conBool True
+                ( IdentityT $ Right $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .> IdentityT (Left $ ssymBool "b")
+                  @?= conBool True
+                ( IdentityT $ Right $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  `symCompare` IdentityT (Left $ ssymBool "b")
+                  @?= (mrgSingle GT :: UnionM Ordering)
+
+                ( IdentityT $ Right $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .<= IdentityT (Right $ ssymBool "b")
+                  @?= (ssymBool "a" .<= ssymBool "b" :: SymBool)
+                ( IdentityT $ Right $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .< IdentityT (Right $ ssymBool "b")
+                  @?= (ssymBool "a" .< ssymBool "b" :: SymBool)
+                ( IdentityT $ Right $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .>= IdentityT (Right $ ssymBool "b")
+                  @?= (ssymBool "a" .>= ssymBool "b" :: SymBool)
+                ( IdentityT $ Right $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  .> IdentityT (Right $ ssymBool "b")
+                  @?= (ssymBool "a" .> ssymBool "b" :: SymBool)
+                ( IdentityT $ Right $ ssymBool "a" ::
+                    IdentityT (Either SymBool) SymBool
+                  )
+                  `symCompare` IdentityT (Right $ ssymBool "b")
+                  @?= (ssymBool "a" `symCompare` ssymBool "b")
+            ],
+          testCase "ByteString" $ do
+            let bytestrings :: [B.ByteString] =
+                  ["", "a", "b", "ab", "ba", "aa", "bb"]
+            traverse_
+              concreteOrdOkProp
+              [(x, y) | x <- bytestrings, y <- bytestrings]
+        ]
+    ]
diff --git a/test/Grisette/Core/Data/Class/SafeSymRotateTests.hs b/test/Grisette/Core/Data/Class/SafeSymRotateTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/SafeSymRotateTests.hs
@@ -0,0 +1,301 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Grisette.Core.Data.Class.SafeSymRotateTests
+  ( safeSymRotateTests,
+  )
+where
+
+import Control.Exception (ArithException (Overflow))
+import Control.Monad.Except (ExceptT)
+import Data.Bits (Bits (rotateL, rotateR), FiniteBits (finiteBitSize))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Typeable (Proxy (Proxy), Typeable)
+import Data.Word (Word16, Word32, Word64, Word8)
+import Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Data.BV (IntN, WordN)
+import Grisette.Core.Data.Class.Mergeable (Mergeable)
+import Grisette.Core.Data.Class.SafeSymRotate
+  ( SafeSymRotate (safeSymRotateL, safeSymRotateR),
+  )
+import Grisette.Core.Data.Class.Solvable (Solvable (con))
+import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term (LinkedRep)
+import Grisette.IR.SymPrim.Data.SymPrim (SymIntN, SymWordN)
+import Grisette.Lib.Control.Monad (mrgReturn)
+import Grisette.Lib.Control.Monad.Except (mrgThrowError)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit ((@?=))
+import Test.QuickCheck (Arbitrary, ioProperty)
+import Test.QuickCheck.Gen (chooseInt)
+import Test.QuickCheck.Property (forAll)
+
+type EM a = ExceptT ArithException UnionM a
+
+overflowError :: (Mergeable a) => EM a
+overflowError = mrgThrowError Overflow
+
+concreteTypeSafeSymRotateTests ::
+  forall proxy a.
+  ( Arbitrary a,
+    Show a,
+    Num a,
+    Eq a,
+    SafeSymRotate ArithException a,
+    FiniteBits a,
+    Bounded a,
+    Typeable a,
+    Integral a,
+    Mergeable a
+  ) =>
+  proxy a ->
+  [Test]
+concreteTypeSafeSymRotateTests _ =
+  [ testProperty "In bound" $ \(x :: a) -> do
+      let b = fromIntegral (maxBound :: a) :: Integer
+      let bs = 2 * fromIntegral (finiteBitSize x) :: Integer
+      let maxRotateAmount = fromIntegral (min b bs)
+      forAll (chooseInt (0, maxRotateAmount)) $
+        \(s :: Int) ->
+          ioProperty $ do
+            let rotateAmount = fromIntegral s
+            let rotateLExpected = mrgReturn (rotateL x s) :: EM a
+            let rotateRExpected = mrgReturn (rotateR x s) :: EM a
+            safeSymRotateL x rotateAmount @?= rotateLExpected
+            safeSymRotateR x rotateAmount @?= rotateRExpected
+  ]
+
+concreteSignedAtLeastThreeBitsTypeSafeSymRotateTests ::
+  forall proxy a.
+  ( Arbitrary a,
+    Show a,
+    Num a,
+    Eq a,
+    SafeSymRotate ArithException a,
+    FiniteBits a,
+    Bounded a,
+    Typeable a,
+    Integral a,
+    Mergeable a
+  ) =>
+  proxy a ->
+  [Test]
+concreteSignedAtLeastThreeBitsTypeSafeSymRotateTests p =
+  testCase
+    "Min bound"
+    ( do
+        let x = -1 :: a
+        let rotateAmount = minBound :: a
+        safeSymRotateL x rotateAmount @?= overflowError
+        safeSymRotateR x rotateAmount @?= overflowError
+    )
+    : concreteTypeSafeSymRotateTests p
+
+concreteUnsignedSymTypeSafeSymRotateTests ::
+  forall proxy c s.
+  ( Arbitrary c,
+    Show s,
+    Num s,
+    Eq s,
+    SafeSymRotate ArithException s,
+    FiniteBits c,
+    FiniteBits s,
+    Bounded c,
+    Typeable s,
+    Integral c,
+    LinkedRep c s,
+    Solvable c s,
+    Mergeable s
+  ) =>
+  proxy s ->
+  [Test]
+concreteUnsignedSymTypeSafeSymRotateTests _ =
+  [ testProperty "In bound" $ \(x :: c) -> do
+      let b = fromIntegral (maxBound :: c) :: Integer
+      let bs = 2 * fromIntegral (finiteBitSize x) :: Integer
+      let maxRotateAmount = fromIntegral (min b bs)
+      forAll (chooseInt (0, maxRotateAmount)) $
+        \(s :: Int) ->
+          ioProperty $ do
+            let rotateAmount = fromIntegral s
+            let rotateLExpected = mrgReturn (con (rotateL x s)) :: EM s
+            let rotateRExpected = mrgReturn (con (rotateR x s)) :: EM s
+            safeSymRotateL (con x) rotateAmount @?= rotateLExpected
+            safeSymRotateR (con x) rotateAmount @?= rotateRExpected
+  ]
+
+concreteSignedAtLeastThreeBitsSymTypeSafeSymRotateTests ::
+  forall proxy c s.
+  ( Arbitrary c,
+    Show s,
+    Num s,
+    Eq s,
+    SafeSymRotate ArithException s,
+    FiniteBits c,
+    FiniteBits s,
+    Bounded c,
+    Typeable s,
+    Integral c,
+    LinkedRep c s,
+    Solvable c s,
+    Mergeable s
+  ) =>
+  proxy s ->
+  [Test]
+concreteSignedAtLeastThreeBitsSymTypeSafeSymRotateTests p =
+  testCase
+    "Min bound"
+    ( do
+        let x = con (-1 :: c)
+        let rotateAmount = con (minBound :: c)
+        safeSymRotateL x rotateAmount @?= (overflowError :: EM s)
+        safeSymRotateR x rotateAmount @?= overflowError
+    )
+    : concreteUnsignedSymTypeSafeSymRotateTests p
+
+safeSymRotateTests :: Test
+safeSymRotateTests =
+  testGroup
+    "SafeSymRotate"
+    [ testGroup "Word8" $ concreteTypeSafeSymRotateTests (Proxy @Word8),
+      testGroup "Word16" $ concreteTypeSafeSymRotateTests (Proxy @Word16),
+      testGroup "Word32" $ concreteTypeSafeSymRotateTests (Proxy @Word32),
+      testGroup "Word64" $ concreteTypeSafeSymRotateTests (Proxy @Word64),
+      testGroup "Word" $ concreteTypeSafeSymRotateTests (Proxy @Word),
+      testGroup "WordN 1" $ concreteTypeSafeSymRotateTests (Proxy @(WordN 1)),
+      testGroup "WordN 2" $ concreteTypeSafeSymRotateTests (Proxy @(WordN 2)),
+      testGroup "WordN 3" $ concreteTypeSafeSymRotateTests (Proxy @(WordN 3)),
+      testGroup "WordN 63" $ concreteTypeSafeSymRotateTests (Proxy @(WordN 63)),
+      testGroup "WordN 64" $ concreteTypeSafeSymRotateTests (Proxy @(WordN 64)),
+      testGroup "WordN 65" $ concreteTypeSafeSymRotateTests (Proxy @(WordN 65)),
+      testGroup "WordN 128" $
+        concreteTypeSafeSymRotateTests (Proxy @(WordN 128)),
+      testGroup "SymWordN 1" $
+        concreteUnsignedSymTypeSafeSymRotateTests (Proxy @(SymWordN 1)),
+      testGroup "SymWordN 2" $
+        concreteUnsignedSymTypeSafeSymRotateTests (Proxy @(SymWordN 2)),
+      testGroup "SymWordN 3" $
+        concreteUnsignedSymTypeSafeSymRotateTests (Proxy @(SymWordN 3)),
+      testGroup "SymWordN 63" $
+        concreteUnsignedSymTypeSafeSymRotateTests (Proxy @(SymWordN 63)),
+      testGroup "SymWordN 64" $
+        concreteUnsignedSymTypeSafeSymRotateTests (Proxy @(SymWordN 64)),
+      testGroup "SymWordN 65" $
+        concreteUnsignedSymTypeSafeSymRotateTests (Proxy @(SymWordN 65)),
+      testGroup "SymWordN 128" $
+        concreteUnsignedSymTypeSafeSymRotateTests (Proxy @(SymWordN 128)),
+      testGroup "Int8" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymRotateTests (Proxy @Int8),
+      testGroup "Int16" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymRotateTests (Proxy @Int16),
+      testGroup "Int32" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymRotateTests (Proxy @Int32),
+      testGroup "Int64" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymRotateTests (Proxy @Int64),
+      testGroup "Int" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymRotateTests (Proxy @Int),
+      testGroup
+        "IntN 1"
+        [ testGroup
+            "SafeSymRotate"
+            [ testGroup
+                "rotate left"
+                [ testCase "By 0" $ do
+                    safeSymRotateL (-1) 0 @?= (mrgReturn $ -1 :: EM (IntN 1))
+                    safeSymRotateR (-1) 0 @?= (mrgReturn $ -1 :: EM (IntN 1)),
+                  testCase "By -1" $ do
+                    safeSymRotateL (-1) (-1 :: IntN 1) @?= overflowError
+                    safeSymRotateR (-1) (-1 :: IntN 1) @?= overflowError
+                ]
+            ]
+        ],
+      testGroup
+        "IntN 2"
+        [ testGroup
+            "SafeSymRotate"
+            [ testGroup
+                "rotate left"
+                [ testCase "By 0" $ do
+                    safeSymRotateL (-2) 0 @?= (mrgReturn $ -2 :: EM (IntN 2))
+                    safeSymRotateR (-2) 0 @?= (mrgReturn $ -2 :: EM (IntN 2)),
+                  testCase "By 1" $ do
+                    safeSymRotateL (-2) 1 @?= (mrgReturn 1 :: EM (IntN 2))
+                    safeSymRotateR (-2) 1 @?= (mrgReturn 1 :: EM (IntN 2)),
+                  testCase "By -1" $ do
+                    safeSymRotateL (-1) (-1 :: IntN 2) @?= overflowError
+                    safeSymRotateR (-1) (-1 :: IntN 2) @?= overflowError,
+                  testCase "By -2" $ do
+                    safeSymRotateL (-1) (-2 :: IntN 2) @?= overflowError
+                    safeSymRotateR (-1) (-2 :: IntN 2) @?= overflowError
+                ]
+            ]
+        ],
+      testGroup "IntN 3" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymRotateTests (Proxy @(IntN 3)),
+      testGroup "IntN 63" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymRotateTests (Proxy @(IntN 63)),
+      testGroup "IntN 64" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymRotateTests (Proxy @(IntN 64)),
+      testGroup "IntN 65" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymRotateTests (Proxy @(IntN 65)),
+      testGroup "IntN 128" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymRotateTests
+          (Proxy @(IntN 128)),
+      testGroup "SymIntN 3" $
+        concreteSignedAtLeastThreeBitsSymTypeSafeSymRotateTests
+          (Proxy @(SymIntN 3)),
+      testGroup "SymIntN 63" $
+        concreteSignedAtLeastThreeBitsSymTypeSafeSymRotateTests
+          (Proxy @(SymIntN 63)),
+      testGroup "SymIntN 64" $
+        concreteSignedAtLeastThreeBitsSymTypeSafeSymRotateTests
+          (Proxy @(SymIntN 64)),
+      testGroup "SymIntN 65" $
+        concreteSignedAtLeastThreeBitsSymTypeSafeSymRotateTests
+          (Proxy @(SymIntN 65)),
+      testGroup "SymIntN 128" $
+        concreteSignedAtLeastThreeBitsSymTypeSafeSymRotateTests
+          (Proxy @(SymIntN 128)),
+      testGroup
+        "SymIntN 1"
+        [ testGroup
+            "SafeSymRotate"
+            [ testGroup
+                "rotate left"
+                [ testCase "By 0" $ do
+                    safeSymRotateL (-1) 0 @?= (mrgReturn $ -1 :: EM (SymIntN 1))
+                    safeSymRotateR (-1) 0
+                      @?= (mrgReturn $ -1 :: EM (SymIntN 1)),
+                  testCase "By -1" $ do
+                    safeSymRotateL (-1) (-1 :: SymIntN 1) @?= overflowError
+                    safeSymRotateR (-1) (-1 :: SymIntN 1) @?= overflowError
+                ]
+            ]
+        ],
+      testGroup
+        "SymIntN 2"
+        [ testGroup
+            "SafeSymRotate"
+            [ testGroup
+                "rotate left"
+                [ testCase "By 0" $ do
+                    safeSymRotateL (-2) 0 @?= (mrgReturn $ -2 :: EM (SymIntN 2))
+                    safeSymRotateR (-2) 0
+                      @?= (mrgReturn $ -2 :: EM (SymIntN 2)),
+                  testCase "By 1" $ do
+                    safeSymRotateL (-2) 1 @?= (mrgReturn 1 :: EM (IntN 2))
+                    safeSymRotateR (-2) 1 @?= (mrgReturn 1 :: EM (IntN 2)),
+                  testCase "By -1" $ do
+                    safeSymRotateL (-1) (-1 :: SymIntN 2) @?= overflowError
+                    safeSymRotateR (-1) (-1 :: SymIntN 2) @?= overflowError,
+                  testCase "By -2" $ do
+                    safeSymRotateL (-1) (-2 :: SymIntN 2) @?= overflowError
+                    safeSymRotateR (-1) (-2 :: SymIntN 2) @?= overflowError
+                ]
+            ]
+        ]
+    ]
diff --git a/test/Grisette/Core/Data/Class/SafeSymShiftTests.hs b/test/Grisette/Core/Data/Class/SafeSymShiftTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/SafeSymShiftTests.hs
@@ -0,0 +1,371 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Grisette.Core.Data.Class.SafeSymShiftTests (safeSymShiftTests) where
+
+import Control.Exception (ArithException (Overflow))
+import Control.Monad.Except (ExceptT)
+import Data.Bits (Bits (shiftL, shiftR), FiniteBits (finiteBitSize))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Typeable (Proxy (Proxy), Typeable)
+import Data.Word (Word16, Word32, Word64, Word8)
+import Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Data.BV (IntN, WordN)
+import Grisette.Core.Data.Class.Mergeable (Mergeable)
+import Grisette.Core.Data.Class.SafeSymShift
+  ( SafeSymShift
+      ( safeSymShiftL,
+        safeSymShiftR,
+        safeSymStrictShiftL,
+        safeSymStrictShiftR
+      ),
+  )
+import Grisette.Core.Data.Class.Solvable (Solvable (con))
+import Grisette.IR.SymPrim.Data.Prim.InternedTerm.Term (LinkedRep)
+import Grisette.IR.SymPrim.Data.SymPrim (SymIntN, SymWordN)
+import Grisette.Lib.Control.Monad (mrgReturn)
+import Grisette.Lib.Control.Monad.Except (mrgThrowError)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit ((@?=))
+import Test.QuickCheck (Arbitrary, ioProperty)
+import Test.QuickCheck.Gen (chooseInt)
+import Test.QuickCheck.Property (forAll)
+
+type EM a = ExceptT ArithException UnionM a
+
+overflowError :: (Mergeable a) => EM a
+overflowError = mrgThrowError Overflow
+
+concreteTypeSafeSymShiftTests ::
+  forall proxy a.
+  ( Arbitrary a,
+    Show a,
+    Num a,
+    Eq a,
+    SafeSymShift ArithException a,
+    FiniteBits a,
+    Bounded a,
+    Typeable a,
+    Integral a,
+    Mergeable a
+  ) =>
+  proxy a ->
+  [Test]
+concreteTypeSafeSymShiftTests _ =
+  [ testProperty "In bound" $ \(x :: a) ->
+      forAll (chooseInt (0, finiteBitSize x - 1)) $
+        \(s :: Int) ->
+          ioProperty $ do
+            let shiftAmount = fromIntegral s
+            let shiftLExpected = mrgReturn (shiftL x s) :: EM a
+            let shiftRExpected = mrgReturn (shiftR x s) :: EM a
+            safeSymShiftL x shiftAmount @?= shiftLExpected
+            safeSymStrictShiftL x shiftAmount @?= shiftLExpected
+            safeSymShiftR x shiftAmount @?= shiftRExpected
+            safeSymStrictShiftR x shiftAmount @?= shiftRExpected,
+    testCase "Bit size" $ do
+      let x = maxBound :: a
+      let shiftAmount = fromIntegral $ finiteBitSize x
+      safeSymShiftL x shiftAmount @?= (mrgReturn 0 :: EM a)
+      safeSymStrictShiftL x shiftAmount @?= overflowError
+      safeSymShiftR x shiftAmount @?= (mrgReturn 0 :: EM a)
+      safeSymStrictShiftR x shiftAmount @?= overflowError,
+    testCase "Max bound" $ do
+      let x = maxBound :: a
+      let shiftAmount = maxBound :: a
+      safeSymShiftL x shiftAmount @?= (mrgReturn 0 :: EM a)
+      safeSymStrictShiftL x shiftAmount @?= overflowError
+      safeSymShiftR x shiftAmount @?= (mrgReturn 0 :: EM a)
+      safeSymStrictShiftR x shiftAmount @?= overflowError
+  ]
+
+concreteSignedAtLeastThreeBitsTypeSafeSymShiftTests ::
+  forall proxy a.
+  ( Arbitrary a,
+    Show a,
+    Num a,
+    Eq a,
+    SafeSymShift ArithException a,
+    FiniteBits a,
+    Bounded a,
+    Typeable a,
+    Integral a,
+    Mergeable a
+  ) =>
+  proxy a ->
+  [Test]
+concreteSignedAtLeastThreeBitsTypeSafeSymShiftTests p =
+  testCase
+    "Min bound"
+    ( do
+        let x = -1 :: a
+        let shiftAmount = minBound :: a
+        safeSymShiftL x shiftAmount @?= overflowError
+        safeSymStrictShiftL x shiftAmount @?= overflowError
+        safeSymShiftR x shiftAmount @?= overflowError
+        safeSymStrictShiftR x shiftAmount @?= overflowError
+    )
+    : (concreteTypeSafeSymShiftTests p)
+
+concreteUnsignedSymTypeSafeSymShiftTests ::
+  forall proxy c s.
+  ( Arbitrary c,
+    Show s,
+    Num s,
+    Eq s,
+    SafeSymShift ArithException s,
+    FiniteBits c,
+    FiniteBits s,
+    Bounded c,
+    Typeable s,
+    Integral c,
+    LinkedRep c s,
+    Solvable c s,
+    Mergeable s
+  ) =>
+  proxy s ->
+  [Test]
+concreteUnsignedSymTypeSafeSymShiftTests _ =
+  [ testProperty "In bound" $ \(x :: c) ->
+      forAll (chooseInt (0, finiteBitSize x - 1)) $
+        \(s :: Int) ->
+          ioProperty $ do
+            let shiftAmount = fromIntegral s
+            let shiftLExpected = mrgReturn (con (shiftL x s)) :: EM s
+            let shiftRExpected = mrgReturn (con (shiftR x s)) :: EM s
+            safeSymShiftL (con x) shiftAmount @?= shiftLExpected
+            safeSymStrictShiftL (con x) shiftAmount @?= shiftLExpected
+            safeSymShiftR (con x) shiftAmount @?= shiftRExpected
+            safeSymStrictShiftR (con x) shiftAmount @?= shiftRExpected,
+    testCase "Bit size" $ do
+      let x = con (maxBound :: c)
+      let shiftAmount = fromIntegral $ finiteBitSize x
+      safeSymShiftL x shiftAmount @?= (mrgReturn 0 :: EM s)
+      safeSymStrictShiftL x shiftAmount @?= overflowError
+      safeSymShiftR x shiftAmount @?= (mrgReturn 0 :: EM s)
+      safeSymStrictShiftR x shiftAmount @?= overflowError,
+    testCase "Max bound" $ do
+      let x = con (maxBound :: c)
+      let shiftAmount = con (maxBound :: c)
+      safeSymShiftL x shiftAmount @?= (mrgReturn 0 :: EM s)
+      safeSymStrictShiftL x shiftAmount @?= overflowError
+      safeSymShiftR x shiftAmount @?= (mrgReturn 0 :: EM s)
+      safeSymStrictShiftR x shiftAmount @?= overflowError
+  ]
+
+concreteSignedAtLeastThreeBitsSymTypeSafeSymShiftTests ::
+  forall proxy c s.
+  ( Arbitrary c,
+    Show s,
+    Num s,
+    Eq s,
+    SafeSymShift ArithException s,
+    FiniteBits c,
+    FiniteBits s,
+    Bounded c,
+    Typeable s,
+    Integral c,
+    LinkedRep c s,
+    Solvable c s,
+    Mergeable s
+  ) =>
+  proxy s ->
+  [Test]
+concreteSignedAtLeastThreeBitsSymTypeSafeSymShiftTests p =
+  testCase
+    "Min bound"
+    ( do
+        let x = con (-1 :: c)
+        let shiftAmount = con (minBound :: c)
+        safeSymShiftL x shiftAmount @?= (overflowError :: EM s)
+        safeSymStrictShiftL x shiftAmount @?= overflowError
+        safeSymShiftR x shiftAmount @?= overflowError
+        safeSymStrictShiftR x shiftAmount @?= overflowError
+    )
+    : concreteUnsignedSymTypeSafeSymShiftTests p
+
+safeSymShiftTests :: Test
+safeSymShiftTests =
+  testGroup
+    "SafeSymShift"
+    [ testGroup "Word8" $ concreteTypeSafeSymShiftTests (Proxy @Word8),
+      testGroup "Word16" $ concreteTypeSafeSymShiftTests (Proxy @Word16),
+      testGroup "Word32" $ concreteTypeSafeSymShiftTests (Proxy @Word32),
+      testGroup "Word64" $ concreteTypeSafeSymShiftTests (Proxy @Word64),
+      testGroup "Word" $ concreteTypeSafeSymShiftTests (Proxy @Word),
+      testGroup "WordN 1" $ concreteTypeSafeSymShiftTests (Proxy @(WordN 1)),
+      testGroup "WordN 2" $ concreteTypeSafeSymShiftTests (Proxy @(WordN 2)),
+      testGroup "WordN 3" $ concreteTypeSafeSymShiftTests (Proxy @(WordN 3)),
+      testGroup "WordN 63" $ concreteTypeSafeSymShiftTests (Proxy @(WordN 63)),
+      testGroup "WordN 64" $ concreteTypeSafeSymShiftTests (Proxy @(WordN 64)),
+      testGroup "WordN 65" $ concreteTypeSafeSymShiftTests (Proxy @(WordN 65)),
+      testGroup "WordN 128" $
+        concreteTypeSafeSymShiftTests (Proxy @(WordN 128)),
+      testGroup "SymWordN 1" $
+        concreteUnsignedSymTypeSafeSymShiftTests (Proxy @(SymWordN 1)),
+      testGroup "SymWordN 2" $
+        concreteUnsignedSymTypeSafeSymShiftTests (Proxy @(SymWordN 2)),
+      testGroup "SymWordN 3" $
+        concreteUnsignedSymTypeSafeSymShiftTests (Proxy @(SymWordN 3)),
+      testGroup "SymWordN 63" $
+        concreteUnsignedSymTypeSafeSymShiftTests (Proxy @(SymWordN 63)),
+      testGroup "SymWordN 64" $
+        concreteUnsignedSymTypeSafeSymShiftTests (Proxy @(SymWordN 64)),
+      testGroup "SymWordN 65" $
+        concreteUnsignedSymTypeSafeSymShiftTests (Proxy @(SymWordN 65)),
+      testGroup "SymWordN 128" $
+        concreteUnsignedSymTypeSafeSymShiftTests (Proxy @(SymWordN 128)),
+      testGroup "Int8" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymShiftTests (Proxy @Int8),
+      testGroup "Int16" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymShiftTests (Proxy @Int16),
+      testGroup "Int32" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymShiftTests (Proxy @Int32),
+      testGroup "Int64" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymShiftTests (Proxy @Int64),
+      testGroup "Int" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymShiftTests (Proxy @Int),
+      testGroup
+        "IntN 1"
+        [ testGroup
+            "SafeSymShift"
+            [ testGroup
+                "shift left"
+                [ testCase "By 0" $ do
+                    safeSymShiftL (-1) 0 @?= (mrgReturn $ -1 :: EM (IntN 1))
+                    safeSymStrictShiftL (-1) 0
+                      @?= (mrgReturn $ -1 :: EM (IntN 1))
+                    safeSymShiftR (-1) 0 @?= (mrgReturn $ -1 :: EM (IntN 1))
+                    safeSymStrictShiftR (-1) 0
+                      @?= (mrgReturn $ -1 :: EM (IntN 1)),
+                  testCase "By -1" $ do
+                    safeSymShiftL (-1) (-1 :: IntN 1) @?= overflowError
+                    safeSymStrictShiftL (-1) (-1 :: IntN 1) @?= overflowError
+                    safeSymShiftR (-1) (-1 :: IntN 1) @?= overflowError
+                    safeSymStrictShiftR (-1) (-1 :: IntN 1) @?= overflowError
+                ]
+            ]
+        ],
+      testGroup
+        "IntN 2"
+        [ testGroup
+            "SafeSymShift"
+            [ testGroup
+                "shift left"
+                [ testCase "By 0" $ do
+                    safeSymShiftL (-1) 0 @?= (mrgReturn $ -1 :: EM (IntN 2))
+                    safeSymStrictShiftL (-1) 0
+                      @?= (mrgReturn $ -1 :: EM (IntN 2))
+                    safeSymShiftR (-1) 0 @?= (mrgReturn $ -1 :: EM (IntN 2))
+                    safeSymStrictShiftR (-1) 0
+                      @?= (mrgReturn $ -1 :: EM (IntN 2)),
+                  testCase "By 1" $ do
+                    safeSymShiftL (-1) 1 @?= (mrgReturn $ -2 :: EM (IntN 2))
+                    safeSymStrictShiftL (-1) 1
+                      @?= (mrgReturn $ -2 :: EM (IntN 2))
+                    safeSymShiftR (-1) 1 @?= (mrgReturn $ -1 :: EM (IntN 2))
+                    safeSymStrictShiftR (-1) 1
+                      @?= (mrgReturn $ -1 :: EM (IntN 2))
+                    safeSymShiftR 1 1 @?= (mrgReturn 0 :: EM (IntN 2))
+                    safeSymStrictShiftR 1 1 @?= (mrgReturn 0 :: EM (IntN 2)),
+                  testCase "By -1" $ do
+                    safeSymShiftL (-1) (-1 :: IntN 2) @?= overflowError
+                    safeSymStrictShiftL (-1) (-1 :: IntN 2) @?= overflowError
+                    safeSymShiftR (-1) (-1 :: IntN 2) @?= overflowError
+                    safeSymStrictShiftR (-1) (-1 :: IntN 2) @?= overflowError,
+                  testCase "By -2" $ do
+                    safeSymShiftL (-1) (-2 :: IntN 2) @?= overflowError
+                    safeSymStrictShiftL (-1) (-2 :: IntN 2) @?= overflowError
+                    safeSymShiftR (-1) (-2 :: IntN 2) @?= overflowError
+                    safeSymStrictShiftR (-1) (-2 :: IntN 2) @?= overflowError
+                ]
+            ]
+        ],
+      testGroup "IntN 3" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymShiftTests (Proxy @(IntN 3)),
+      testGroup "IntN 63" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymShiftTests (Proxy @(IntN 63)),
+      testGroup "IntN 64" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymShiftTests (Proxy @(IntN 64)),
+      testGroup "IntN 65" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymShiftTests (Proxy @(IntN 65)),
+      testGroup "IntN 128" $
+        concreteSignedAtLeastThreeBitsTypeSafeSymShiftTests (Proxy @(IntN 128)),
+      testGroup "SymIntN 3" $
+        concreteSignedAtLeastThreeBitsSymTypeSafeSymShiftTests
+          (Proxy @(SymIntN 3)),
+      testGroup "SymIntN 63" $
+        concreteSignedAtLeastThreeBitsSymTypeSafeSymShiftTests
+          (Proxy @(SymIntN 63)),
+      testGroup "SymIntN 64" $
+        concreteSignedAtLeastThreeBitsSymTypeSafeSymShiftTests
+          (Proxy @(SymIntN 64)),
+      testGroup "SymIntN 65" $
+        concreteSignedAtLeastThreeBitsSymTypeSafeSymShiftTests
+          (Proxy @(SymIntN 65)),
+      testGroup "SymIntN 128" $
+        concreteSignedAtLeastThreeBitsSymTypeSafeSymShiftTests
+          (Proxy @(SymIntN 128)),
+      testGroup
+        "SymIntN 1"
+        [ testGroup
+            "SafeSymShift"
+            [ testGroup
+                "shift left"
+                [ testCase "By 0" $ do
+                    safeSymShiftL (-1) 0 @?= (mrgReturn $ -1 :: EM (SymIntN 1))
+                    safeSymStrictShiftL (-1) 0
+                      @?= (mrgReturn $ -1 :: EM (SymIntN 1))
+                    safeSymShiftR (-1) 0 @?= (mrgReturn $ -1 :: EM (SymIntN 1))
+                    safeSymStrictShiftR (-1) 0
+                      @?= (mrgReturn $ -1 :: EM (SymIntN 1)),
+                  testCase "By -1" $ do
+                    safeSymShiftL (-1) (-1 :: SymIntN 1) @?= overflowError
+                    safeSymStrictShiftL (-1) (-1 :: SymIntN 1) @?= overflowError
+                    safeSymShiftR (-1) (-1 :: SymIntN 1) @?= overflowError
+                    safeSymStrictShiftR (-1) (-1 :: SymIntN 1) @?= overflowError
+                ]
+            ]
+        ],
+      testGroup
+        "SymIntN 2"
+        [ testGroup
+            "SafeSymShift"
+            [ testGroup
+                "shift left"
+                [ testCase "By 0" $ do
+                    safeSymShiftL (-1) 0 @?= (mrgReturn $ -1 :: EM (SymIntN 2))
+                    safeSymStrictShiftL (-1) 0
+                      @?= (mrgReturn $ -1 :: EM (SymIntN 2))
+                    safeSymShiftR (-1) 0 @?= (mrgReturn $ -1 :: EM (SymIntN 2))
+                    safeSymStrictShiftR (-1) 0
+                      @?= (mrgReturn $ -1 :: EM (SymIntN 2)),
+                  testCase "By 1" $ do
+                    safeSymShiftL (-1) 1 @?= (mrgReturn $ -2 :: EM (SymIntN 2))
+                    safeSymStrictShiftL (-1) 1
+                      @?= (mrgReturn $ -2 :: EM (SymIntN 2))
+                    safeSymShiftR (-1) 1 @?= (mrgReturn $ -1 :: EM (SymIntN 2))
+                    safeSymStrictShiftR (-1) 1
+                      @?= (mrgReturn $ -1 :: EM (SymIntN 2))
+                    safeSymShiftR 1 1 @?= (mrgReturn 0 :: EM (SymIntN 2))
+                    safeSymStrictShiftR 1 1 @?= (mrgReturn 0 :: EM (SymIntN 2)),
+                  testCase "By -1" $ do
+                    safeSymShiftL (-1) (-1 :: SymIntN 2) @?= overflowError
+                    safeSymStrictShiftL (-1) (-1 :: SymIntN 2) @?= overflowError
+                    safeSymShiftR (-1) (-1 :: SymIntN 2) @?= overflowError
+                    safeSymStrictShiftR (-1) (-1 :: SymIntN 2)
+                      @?= overflowError,
+                  testCase "By -2" $ do
+                    safeSymShiftL (-1) (-2 :: SymIntN 2) @?= overflowError
+                    safeSymStrictShiftL (-1) (-2 :: SymIntN 2) @?= overflowError
+                    safeSymShiftR (-1) (-2 :: SymIntN 2) @?= overflowError
+                    safeSymStrictShiftR (-1) (-2 :: SymIntN 2) @?= overflowError
+                ]
+            ]
+        ]
+    ]
diff --git a/test/Grisette/Core/Data/Class/SimpleMergeableTests.hs b/test/Grisette/Core/Data/Class/SimpleMergeableTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/SimpleMergeableTests.hs
@@ -0,0 +1,678 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Grisette.Core.Data.Class.SimpleMergeableTests
+  ( simpleMergeableTests,
+  )
+where
+
+import Control.Monad.Cont (ContT (ContT, runContT))
+import Control.Monad.Except (ExceptT (ExceptT))
+import Control.Monad.Identity
+  ( Identity (Identity, runIdentity),
+    IdentityT (IdentityT, runIdentityT),
+  )
+import qualified Control.Monad.RWS.Lazy as RWSTLazy
+import qualified Control.Monad.RWS.Strict as RWSTStrict
+import Control.Monad.Reader (ReaderT (ReaderT, runReaderT))
+import qualified Control.Monad.State.Lazy as StateLazy
+import qualified Control.Monad.State.Strict as StateStrict
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import qualified Control.Monad.Writer.Lazy as WriterLazy
+import qualified Control.Monad.Writer.Strict as WriterStrict
+import qualified Data.Monoid as Monoid
+import GHC.Generics (Generic)
+import Generics.Deriving (Default (Default))
+import Grisette.Core.Control.Monad.UnionM (UnionM, (.#))
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&), (.||)))
+import Grisette.Core.Data.Class.Mergeable (Mergeable)
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( SimpleMergeable (mrgIte),
+    UnionLike (unionIf),
+    mrgIf,
+    mrgIte1,
+    mrgSingle,
+    onUnion,
+    simpleMerge,
+  )
+import Grisette.Core.Data.Class.TestValues (conBool, ssymBool)
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit ((@?=))
+
+newtype AndMonoidSymBool = AndMonoidSymBool SymBool
+  deriving (Show, Generic, Eq)
+  deriving (Mergeable) via (Default AndMonoidSymBool)
+
+instance Semigroup AndMonoidSymBool where
+  (AndMonoidSymBool a) <> (AndMonoidSymBool b) = AndMonoidSymBool (a .&& b)
+
+instance Monoid AndMonoidSymBool where
+  mempty = AndMonoidSymBool $ conBool True
+
+simpleMergeableTests :: Test
+simpleMergeableTests =
+  testGroup
+    "SimpleMergeable"
+    [ testGroup
+        "SimpleMergeable for common types"
+        [ testCase "SymBool" $ do
+            mrgIte (ssymBool "a") (ssymBool "b") (ssymBool "c")
+              @?= symIte (ssymBool "a") (ssymBool "b") (ssymBool "c"),
+          testCase "()" $ do
+            mrgIte (ssymBool "a") () () @?= (),
+          testCase "(SymBool, SymBool)" $ do
+            mrgIte
+              (ssymBool "a")
+              (ssymBool "b", ssymBool "d")
+              (ssymBool "c", ssymBool "e")
+              @?= ( symIte (ssymBool "a") (ssymBool "b") (ssymBool "c"),
+                    symIte (ssymBool "a") (ssymBool "d") (ssymBool "e")
+                  ),
+          testCase "(SymBool, SymBool, SymBool)" $ do
+            mrgIte
+              (ssymBool "a")
+              (ssymBool "b", ssymBool "d", ssymBool "f")
+              (ssymBool "c", ssymBool "e", ssymBool "g")
+              @?= ( symIte (ssymBool "a") (ssymBool "b") (ssymBool "c"),
+                    symIte (ssymBool "a") (ssymBool "d") (ssymBool "e"),
+                    symIte (ssymBool "a") (ssymBool "f") (ssymBool "g")
+                  ),
+          testCase "(SymBool, SymBool, SymBool, SymBool)" $ do
+            mrgIte
+              (ssymBool "a")
+              (ssymBool "b", ssymBool "d", ssymBool "f", ssymBool "h")
+              (ssymBool "c", ssymBool "e", ssymBool "g", ssymBool "i")
+              @?= ( symIte (ssymBool "a") (ssymBool "b") (ssymBool "c"),
+                    symIte (ssymBool "a") (ssymBool "d") (ssymBool "e"),
+                    symIte (ssymBool "a") (ssymBool "f") (ssymBool "g"),
+                    symIte (ssymBool "a") (ssymBool "h") (ssymBool "i")
+                  ),
+          testCase "(SymBool, SymBool, SymBool, SymBool, SymBool)" $ do
+            mrgIte
+              (ssymBool "a")
+              ( ssymBool "b",
+                ssymBool "d",
+                ssymBool "f",
+                ssymBool "h",
+                ssymBool "j"
+              )
+              ( ssymBool "c",
+                ssymBool "e",
+                ssymBool "g",
+                ssymBool "i",
+                ssymBool "k"
+              )
+              @?= ( symIte (ssymBool "a") (ssymBool "b") (ssymBool "c"),
+                    symIte (ssymBool "a") (ssymBool "d") (ssymBool "e"),
+                    symIte (ssymBool "a") (ssymBool "f") (ssymBool "g"),
+                    symIte (ssymBool "a") (ssymBool "h") (ssymBool "i"),
+                    symIte (ssymBool "a") (ssymBool "j") (ssymBool "k")
+                  ),
+          testCase "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)" $ do
+            mrgIte
+              (ssymBool "a")
+              ( ssymBool "b",
+                ssymBool "d",
+                ssymBool "f",
+                ssymBool "h",
+                ssymBool "j",
+                ssymBool "l"
+              )
+              ( ssymBool "c",
+                ssymBool "e",
+                ssymBool "g",
+                ssymBool "i",
+                ssymBool "k",
+                ssymBool "m"
+              )
+              @?= ( symIte (ssymBool "a") (ssymBool "b") (ssymBool "c"),
+                    symIte (ssymBool "a") (ssymBool "d") (ssymBool "e"),
+                    symIte (ssymBool "a") (ssymBool "f") (ssymBool "g"),
+                    symIte (ssymBool "a") (ssymBool "h") (ssymBool "i"),
+                    symIte (ssymBool "a") (ssymBool "j") (ssymBool "k"),
+                    symIte (ssymBool "a") (ssymBool "l") (ssymBool "m")
+                  ),
+          testCase
+            "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+            $ do
+              mrgIte
+                (ssymBool "a")
+                ( ssymBool "b",
+                  ssymBool "d",
+                  ssymBool "f",
+                  ssymBool "h",
+                  ssymBool "j",
+                  ssymBool "l",
+                  ssymBool "n"
+                )
+                ( ssymBool "c",
+                  ssymBool "e",
+                  ssymBool "g",
+                  ssymBool "i",
+                  ssymBool "k",
+                  ssymBool "m",
+                  ssymBool "o"
+                )
+                @?= ( symIte (ssymBool "a") (ssymBool "b") (ssymBool "c"),
+                      symIte (ssymBool "a") (ssymBool "d") (ssymBool "e"),
+                      symIte (ssymBool "a") (ssymBool "f") (ssymBool "g"),
+                      symIte (ssymBool "a") (ssymBool "h") (ssymBool "i"),
+                      symIte (ssymBool "a") (ssymBool "j") (ssymBool "k"),
+                      symIte (ssymBool "a") (ssymBool "l") (ssymBool "m"),
+                      symIte (ssymBool "a") (ssymBool "n") (ssymBool "o")
+                    ),
+          testCase
+            "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+            $ do
+              mrgIte
+                (ssymBool "a")
+                ( ssymBool "b",
+                  ssymBool "d",
+                  ssymBool "f",
+                  ssymBool "h",
+                  ssymBool "j",
+                  ssymBool "l",
+                  ssymBool "n",
+                  ssymBool "p"
+                )
+                ( ssymBool "c",
+                  ssymBool "e",
+                  ssymBool "g",
+                  ssymBool "i",
+                  ssymBool "k",
+                  ssymBool "m",
+                  ssymBool "o",
+                  ssymBool "q"
+                )
+                @?= ( symIte (ssymBool "a") (ssymBool "b") (ssymBool "c"),
+                      symIte (ssymBool "a") (ssymBool "d") (ssymBool "e"),
+                      symIte (ssymBool "a") (ssymBool "f") (ssymBool "g"),
+                      symIte (ssymBool "a") (ssymBool "h") (ssymBool "i"),
+                      symIte (ssymBool "a") (ssymBool "j") (ssymBool "k"),
+                      symIte (ssymBool "a") (ssymBool "l") (ssymBool "m"),
+                      symIte (ssymBool "a") (ssymBool "n") (ssymBool "o"),
+                      symIte (ssymBool "a") (ssymBool "p") (ssymBool "q")
+                    ),
+          testCase "SymBool -> SymBool" $ do
+            let f = mrgIte (ssymBool "a") symNot ((ssymBool "b") .&&)
+            f (ssymBool "c")
+              @?= symIte
+                (ssymBool "a")
+                (symNot $ ssymBool "c")
+                ((ssymBool "b") .&& (ssymBool "c")),
+          testCase "MaybeT (UnionM) SymBool" $ do
+            let l :: MaybeT (UnionM) SymBool =
+                  MaybeT
+                    ( mrgIf
+                        (ssymBool "b")
+                        (mrgSingle Nothing)
+                        (mrgSingle $ Just $ ssymBool "c")
+                    )
+            let r :: MaybeT (UnionM) SymBool =
+                  MaybeT
+                    ( mrgIf
+                        (ssymBool "d")
+                        (mrgSingle Nothing)
+                        (mrgSingle $ Just $ ssymBool "e")
+                    )
+            let res :: MaybeT (UnionM) SymBool =
+                  MaybeT
+                    ( mrgIf
+                        (ssymBool "a")
+                        ( mrgIf
+                            (ssymBool "b")
+                            (mrgSingle Nothing)
+                            (mrgSingle $ Just $ ssymBool "c")
+                        )
+                        ( mrgIf
+                            (ssymBool "d")
+                            (mrgSingle Nothing)
+                            (mrgSingle $ Just $ ssymBool "e")
+                        )
+                    )
+            mrgIte (ssymBool "a") l r @?= res
+            mrgIte1 (ssymBool "a") l r @?= res
+            mrgIf (ssymBool "a") l r @?= res,
+          testCase "ExceptT SymBool (UnionM) SymBool" $ do
+            let l :: ExceptT SymBool (UnionM) SymBool =
+                  ExceptT
+                    ( mrgIf
+                        (ssymBool "b")
+                        (mrgSingle $ Left $ ssymBool "c")
+                        (mrgSingle $ Right $ ssymBool "d")
+                    )
+            let r =
+                  ExceptT
+                    ( mrgIf
+                        (ssymBool "e")
+                        (mrgSingle $ Left $ ssymBool "f")
+                        (mrgSingle $ Right $ ssymBool "g")
+                    )
+            let res =
+                  ExceptT
+                    ( mrgIf
+                        (ssymBool "a")
+                        ( mrgIf
+                            (ssymBool "b")
+                            (mrgSingle $ Left $ ssymBool "c")
+                            (mrgSingle $ Right $ ssymBool "d")
+                        )
+                        ( mrgIf
+                            (ssymBool "e")
+                            (mrgSingle $ Left $ ssymBool "f")
+                            (mrgSingle $ Right $ ssymBool "g")
+                        )
+                    )
+            mrgIte (ssymBool "a") l r @?= res
+            mrgIte1 (ssymBool "a") l r @?= res
+            mrgIf (ssymBool "a") l r @?= res,
+          testGroup
+            "StateT Integer (UnionM) SymBool"
+            [ testCase "Lazy" $ do
+                let st1 :: StateLazy.StateT Integer (UnionM) SymBool =
+                      StateLazy.StateT $ \(x :: Integer) ->
+                        mrgSingle (ssymBool "a", x + 2)
+                let st2 :: StateLazy.StateT Integer (UnionM) SymBool =
+                      StateLazy.StateT $ \(x :: Integer) ->
+                        mrgSingle (ssymBool "b", x * 2)
+                let st3 = mrgIte (ssymBool "c") st1 st2
+                let st31 = mrgIte1 (ssymBool "c") st1 st2
+                let st3u1 = mrgIf (ssymBool "c") st1 st2
+                StateLazy.runStateT st3 2
+                  @?= mrgSingle
+                    (symIte (ssymBool "c") (ssymBool "a") (ssymBool "b"), 4)
+                StateLazy.runStateT st3 3
+                  @?= mrgIf
+                    (ssymBool "c")
+                    (mrgSingle (ssymBool "a", 5))
+                    (mrgSingle (ssymBool "b", 6))
+                StateLazy.runStateT st31 2
+                  @?= mrgSingle
+                    (symIte (ssymBool "c") (ssymBool "a") (ssymBool "b"), 4)
+                StateLazy.runStateT st31 3
+                  @?= mrgIf
+                    (ssymBool "c")
+                    (mrgSingle (ssymBool "a", 5))
+                    (mrgSingle (ssymBool "b", 6))
+                StateLazy.runStateT st3u1 2
+                  @?= mrgSingle
+                    (symIte (ssymBool "c") (ssymBool "a") (ssymBool "b"), 4)
+                StateLazy.runStateT st3u1 3
+                  @?= mrgIf
+                    (ssymBool "c")
+                    (mrgSingle (ssymBool "a", 5))
+                    (mrgSingle (ssymBool "b", 6)),
+              testCase "Strict" $ do
+                let st1 :: StateStrict.StateT Integer (UnionM) SymBool =
+                      StateStrict.StateT $ \(x :: Integer) ->
+                        mrgSingle (ssymBool "a", x + 2)
+                let st2 :: StateStrict.StateT Integer (UnionM) SymBool =
+                      StateStrict.StateT $ \(x :: Integer) ->
+                        mrgSingle (ssymBool "b", x * 2)
+                let st3 = mrgIte (ssymBool "c") st1 st2
+                let st31 = mrgIte1 (ssymBool "c") st1 st2
+                let st3u1 = mrgIf (ssymBool "c") st1 st2
+                StateStrict.runStateT st3 2
+                  @?= mrgSingle
+                    (symIte (ssymBool "c") (ssymBool "a") (ssymBool "b"), 4)
+                StateStrict.runStateT st3 3
+                  @?= mrgIf
+                    (ssymBool "c")
+                    (mrgSingle (ssymBool "a", 5))
+                    (mrgSingle (ssymBool "b", 6))
+                StateStrict.runStateT st31 2
+                  @?= mrgSingle
+                    (symIte (ssymBool "c") (ssymBool "a") (ssymBool "b"), 4)
+                StateStrict.runStateT st31 3
+                  @?= mrgIf
+                    (ssymBool "c")
+                    (mrgSingle (ssymBool "a", 5))
+                    (mrgSingle (ssymBool "b", 6))
+                StateStrict.runStateT st3u1 2
+                  @?= mrgSingle
+                    (symIte (ssymBool "c") (ssymBool "a") (ssymBool "b"), 4)
+                StateStrict.runStateT st3u1 3
+                  @?= mrgIf
+                    (ssymBool "c")
+                    (mrgSingle (ssymBool "a", 5))
+                    (mrgSingle (ssymBool "b", 6))
+            ],
+          testCase "ContT (SymBool, Integer) (UnionM) (SymBool, Integer)" $ do
+            let c1 :: ContT (SymBool, Integer) (UnionM) (SymBool, Integer) =
+                  ContT $ \f -> f (ssymBool "a", 2)
+            let c2 :: ContT (SymBool, Integer) (UnionM) (SymBool, Integer) =
+                  ContT $ \f -> f (ssymBool "b", 3)
+            let c3 = mrgIte (ssymBool "c") c1 c2
+            let c3u1 = mrgIf (ssymBool "c") c1 c2
+            let r =
+                  mrgIf
+                    (ssymBool "c")
+                    ( mrgIf
+                        (ssymBool "p")
+                        (mrgSingle (ssymBool "a", 2))
+                        (mrgSingle (symNot $ ssymBool "a", 3))
+                    )
+                    ( mrgIf
+                        (ssymBool "p")
+                        (mrgSingle (ssymBool "b", 3))
+                        (mrgSingle (symNot $ ssymBool "b", 4))
+                    )
+            let f (a, x) =
+                  mrgIf
+                    (ssymBool "p")
+                    (mrgSingle (a, x))
+                    (mrgSingle (symNot a, x + 1))
+            runContT c3 f @?= r
+            runContT c3u1 f @?= r,
+          testGroup
+            "RWST (Integer, SymBool) (Monoid.Sum Integer, AndMonoidSymBool) (Integer, SymBool) (UnionM) (Integer, SymBool)"
+            [ testCase "Lazy" $ do
+                let rws1 ::
+                      RWSTLazy.RWST
+                        (Integer, SymBool)
+                        (Monoid.Sum Integer, AndMonoidSymBool)
+                        (Integer, SymBool)
+                        (UnionM)
+                        (Integer, SymBool) =
+                        RWSTLazy.RWST $ \(ir, br) (is, bs) ->
+                          mrgSingle
+                            ( (ir + is, br .&& bs),
+                              (ir - is, br .|| bs),
+                              ( Monoid.Sum $ ir * is,
+                                AndMonoidSymBool $ bs .&& br
+                              )
+                            )
+                let rws2 ::
+                      RWSTLazy.RWST
+                        (Integer, SymBool)
+                        (Monoid.Sum Integer, AndMonoidSymBool)
+                        (Integer, SymBool)
+                        (UnionM)
+                        (Integer, SymBool) =
+                        RWSTLazy.RWST $ \(ir, br) (is, bs) ->
+                          mrgSingle
+                            ( (ir + is, br .|| bs),
+                              (ir - is, br .&& bs),
+                              ( Monoid.Sum $ ir * is,
+                                AndMonoidSymBool $ bs .|| br
+                              )
+                            )
+                let rws3 = mrgIte (ssymBool "c") rws1 rws2
+                let rws3u1 = mrgIf (ssymBool "c") rws1 rws2
+
+                let res1 ::
+                      UnionM
+                        ( (Integer, SymBool),
+                          (Integer, SymBool),
+                          (Monoid.Sum Integer, AndMonoidSymBool)
+                        ) =
+                        mrgIf
+                          (ssymBool "c")
+                          ( mrgSingle
+                              ( (1, ssymBool "a" .&& ssymBool "b"),
+                                (-1, ssymBool "a" .|| ssymBool "b"),
+                                ( 0,
+                                  AndMonoidSymBool $
+                                    ssymBool "b" .&& ssymBool "a"
+                                )
+                              )
+                          )
+                          ( mrgSingle
+                              ( (1, ssymBool "a" .|| ssymBool "b"),
+                                (-1, ssymBool "a" .&& ssymBool "b"),
+                                ( 0,
+                                  AndMonoidSymBool $
+                                    ssymBool "b" .|| ssymBool "a"
+                                )
+                              )
+                          )
+                RWSTLazy.runRWST rws3 (0, ssymBool "a") (1, ssymBool "b")
+                  @?= res1
+                RWSTLazy.runRWST rws3u1 (0, ssymBool "a") (1, ssymBool "b")
+                  @?= res1,
+              testCase "Strict" $ do
+                let rws1 ::
+                      RWSTStrict.RWST
+                        (Integer, SymBool)
+                        (Monoid.Sum Integer, AndMonoidSymBool)
+                        (Integer, SymBool)
+                        (UnionM)
+                        (Integer, SymBool) =
+                        RWSTStrict.RWST $ \(ir, br) (is, bs) ->
+                          mrgSingle
+                            ( (ir + is, br .&& bs),
+                              (ir - is, br .|| bs),
+                              ( Monoid.Sum $ ir * is,
+                                AndMonoidSymBool $ bs .&& br
+                              )
+                            )
+                let rws2 ::
+                      RWSTStrict.RWST
+                        (Integer, SymBool)
+                        (Monoid.Sum Integer, AndMonoidSymBool)
+                        (Integer, SymBool)
+                        (UnionM)
+                        (Integer, SymBool) =
+                        RWSTStrict.RWST $ \(ir, br) (is, bs) ->
+                          mrgSingle
+                            ( (ir + is, br .|| bs),
+                              (ir - is, br .&& bs),
+                              ( Monoid.Sum $ ir * is,
+                                AndMonoidSymBool $ bs .|| br
+                              )
+                            )
+                let rws3 = mrgIte (ssymBool "c") rws1 rws2
+                let rws3u1 = mrgIf (ssymBool "c") rws1 rws2
+
+                let res1 ::
+                      UnionM
+                        ( (Integer, SymBool),
+                          (Integer, SymBool),
+                          (Monoid.Sum Integer, AndMonoidSymBool)
+                        ) =
+                        mrgIf
+                          (ssymBool "c")
+                          ( mrgSingle
+                              ( (1, ssymBool "a" .&& ssymBool "b"),
+                                (-1, ssymBool "a" .|| ssymBool "b"),
+                                ( 0,
+                                  AndMonoidSymBool $
+                                    ssymBool "b" .&& ssymBool "a"
+                                )
+                              )
+                          )
+                          ( mrgSingle
+                              ( (1, ssymBool "a" .|| ssymBool "b"),
+                                (-1, ssymBool "a" .&& ssymBool "b"),
+                                ( 0,
+                                  AndMonoidSymBool $
+                                    ssymBool "b" .|| ssymBool "a"
+                                )
+                              )
+                          )
+                RWSTStrict.runRWST rws3 (0, ssymBool "a") (1, ssymBool "b")
+                  @?= res1
+                RWSTStrict.runRWST rws3u1 (0, ssymBool "a") (1, ssymBool "b")
+                  @?= res1
+            ],
+          testGroup
+            "WriterT (Monoid.Sum Integer) (UnionM) SymBool"
+            [ testCase "Lazy" $ do
+                let st1 ::
+                      WriterLazy.WriterT
+                        (Monoid.Sum Integer)
+                        (UnionM)
+                        SymBool =
+                        WriterLazy.WriterT $ mrgSingle (ssymBool "a", 1)
+                let st2 ::
+                      WriterLazy.WriterT
+                        (Monoid.Sum Integer)
+                        (UnionM)
+                        SymBool =
+                        WriterLazy.WriterT $ mrgSingle (ssymBool "b", 2)
+                let st3 ::
+                      WriterLazy.WriterT
+                        (Monoid.Sum Integer)
+                        (UnionM)
+                        SymBool =
+                        WriterLazy.WriterT $ mrgSingle (ssymBool "c", 1)
+                let st4 = mrgIte (ssymBool "d") st1 st2
+                let st41 = mrgIte1 (ssymBool "d") st1 st2
+                let st4u1 = mrgIf (ssymBool "d") st1 st2
+                let st5 = mrgIte (ssymBool "d") st1 st3
+                let st51 = mrgIte1 (ssymBool "d") st1 st3
+                let st5u1 = mrgIf (ssymBool "d") st1 st3
+                WriterLazy.runWriterT st4
+                  @?= mrgIf
+                    (ssymBool "d")
+                    (mrgSingle (ssymBool "a", 1))
+                    (mrgSingle (ssymBool "b", 2))
+                WriterLazy.runWriterT st41
+                  @?= mrgIf
+                    (ssymBool "d")
+                    (mrgSingle (ssymBool "a", 1))
+                    (mrgSingle (ssymBool "b", 2))
+                WriterLazy.runWriterT st4u1
+                  @?= mrgIf
+                    (ssymBool "d")
+                    (mrgSingle (ssymBool "a", 1))
+                    (mrgSingle (ssymBool "b", 2))
+                WriterLazy.runWriterT st5
+                  @?= mrgSingle
+                    (symIte (ssymBool "d") (ssymBool "a") (ssymBool "c"), 1)
+                WriterLazy.runWriterT st51
+                  @?= mrgSingle
+                    (symIte (ssymBool "d") (ssymBool "a") (ssymBool "c"), 1)
+                WriterLazy.runWriterT st5u1
+                  @?= mrgSingle
+                    (symIte (ssymBool "d") (ssymBool "a") (ssymBool "c"), 1),
+              testCase "Strict" $ do
+                let st1 ::
+                      WriterStrict.WriterT
+                        (Monoid.Sum Integer)
+                        (UnionM)
+                        SymBool =
+                        WriterStrict.WriterT $ mrgSingle (ssymBool "a", 1)
+                let st2 ::
+                      WriterStrict.WriterT
+                        (Monoid.Sum Integer)
+                        (UnionM)
+                        SymBool =
+                        WriterStrict.WriterT $ mrgSingle (ssymBool "b", 2)
+                let st3 ::
+                      WriterStrict.WriterT
+                        (Monoid.Sum Integer)
+                        (UnionM)
+                        SymBool =
+                        WriterStrict.WriterT $ mrgSingle (ssymBool "c", 1)
+                let st4 = mrgIte (ssymBool "d") st1 st2
+                let st41 = mrgIte1 (ssymBool "d") st1 st2
+                let st4u1 = mrgIf (ssymBool "d") st1 st2
+                let st5 = mrgIte (ssymBool "d") st1 st3
+                let st51 = mrgIte1 (ssymBool "d") st1 st3
+                let st5u1 = mrgIf (ssymBool "d") st1 st3
+                WriterStrict.runWriterT st4
+                  @?= mrgIf
+                    (ssymBool "d")
+                    (mrgSingle (ssymBool "a", 1))
+                    (mrgSingle (ssymBool "b", 2))
+                WriterStrict.runWriterT st41
+                  @?= mrgIf
+                    (ssymBool "d")
+                    (mrgSingle (ssymBool "a", 1))
+                    (mrgSingle (ssymBool "b", 2))
+                WriterStrict.runWriterT st4u1
+                  @?= mrgIf
+                    (ssymBool "d")
+                    (mrgSingle (ssymBool "a", 1))
+                    (mrgSingle (ssymBool "b", 2))
+                WriterStrict.runWriterT st5
+                  @?= mrgSingle
+                    (symIte (ssymBool "d") (ssymBool "a") (ssymBool "c"), 1)
+                WriterStrict.runWriterT st51
+                  @?= mrgSingle
+                    (symIte (ssymBool "d") (ssymBool "a") (ssymBool "c"), 1)
+                WriterStrict.runWriterT st5u1
+                  @?= mrgSingle
+                    (symIte (ssymBool "d") (ssymBool "a") (ssymBool "c"), 1)
+            ],
+          testCase "ReaderT Integer (UnionM) Integer" $ do
+            let r1 :: ReaderT Integer (UnionM) Integer =
+                  ReaderT $ \(x :: Integer) -> mrgSingle $ x + 2
+            let r2 :: ReaderT Integer (UnionM) Integer =
+                  ReaderT $ \(x :: Integer) -> mrgSingle $ x * 2
+            let r3 = mrgIte (ssymBool "c") r1 r2
+            let r3u1 = mrgIf (ssymBool "c") r1 r2
+            runReaderT r3 2 @?= mrgSingle 4
+            runReaderT r3 3 @?= mrgIf (ssymBool "c") (mrgSingle 5) (mrgSingle 6)
+            runReaderT r3u1 2 @?= mrgSingle 4
+            runReaderT r3u1 3
+              @?= mrgIf
+                (ssymBool "c")
+                (mrgSingle 5)
+                (mrgSingle 6)
+
+            let r4 :: ReaderT SymBool (UnionM) SymBool =
+                  ReaderT $ \x -> mrgSingle $ x .&& ssymBool "x"
+            let r5 :: ReaderT SymBool (UnionM) SymBool =
+                  ReaderT $ \x -> mrgSingle $ x .|| ssymBool "y"
+            let r61 = mrgIte1 (ssymBool "c") r4 r5
+            runReaderT r61 (ssymBool "a")
+              @?= mrgSingle
+                ( symIte
+                    (ssymBool "c")
+                    (ssymBool "a" .&& ssymBool "x")
+                    (ssymBool "a" .|| ssymBool "y")
+                ),
+          testCase "Identity SymBool" $ do
+            let i1 :: Identity SymBool = Identity $ ssymBool "a"
+            let i2 :: Identity SymBool = Identity $ ssymBool "b"
+            let i3 = mrgIte (ssymBool "c") i1 i2
+            let i31 = mrgIte1 (ssymBool "c") i1 i2
+            runIdentity i3 @?= symIte (ssymBool "c") (ssymBool "a") (ssymBool "b")
+            runIdentity i31
+              @?= symIte (ssymBool "c") (ssymBool "a") (ssymBool "b"),
+          testCase "IdentityT (UnionM) SymBool" $ do
+            let i1 :: IdentityT (UnionM) SymBool =
+                  IdentityT $ mrgSingle $ ssymBool "a"
+            let i2 :: IdentityT (UnionM) SymBool =
+                  IdentityT $ mrgSingle $ ssymBool "b"
+            let i3 = mrgIte (ssymBool "c") i1 i2
+            let i31 = mrgIte1 (ssymBool "c") i1 i2
+            let i3u1 = mrgIf (ssymBool "c") i1 i2
+            runIdentityT i3
+              @?= mrgSingle (symIte (ssymBool "c") (ssymBool "a") (ssymBool "b"))
+            runIdentityT i31
+              @?= mrgSingle (symIte (ssymBool "c") (ssymBool "a") (ssymBool "b"))
+            runIdentityT i3u1
+              @?= mrgSingle (symIte (ssymBool "c") (ssymBool "a") (ssymBool "b"))
+        ],
+      testGroup
+        "Combinators"
+        [ testCase "simpleMerge" $ do
+            simpleMerge
+              (unionIf "a" (return "b") (return "c") :: UnionM SymBool)
+              @?= symIte (ssymBool "a") (ssymBool "b") (ssymBool "c"),
+          testCase "onUnion" $ do
+            let symAll = foldl (.&&) (conBool True)
+            let symAllU = onUnion symAll
+            symAllU
+              ( unionIf "cond" (return ["a"]) (return ["b", "c"]) ::
+                  UnionM [SymBool]
+              )
+              @?= symIte "cond" "a" ("b" .&& "c"),
+          testCase "(.#)" $ do
+            let symAll = foldl (.&&) (conBool True)
+            symAll
+              .# ( unionIf "cond" (return ["a"]) (return ["b", "c"]) ::
+                     UnionM [SymBool]
+                 )
+              @?= symIte "cond" "a" ("b" .&& "c")
+        ]
+    ]
diff --git a/test/Grisette/Core/Data/Class/SubstituteSymTests.hs b/test/Grisette/Core/Data/Class/SubstituteSymTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/SubstituteSymTests.hs
@@ -0,0 +1,418 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Grisette.Core.Data.Class.SubstituteSymTests (substituteSymTests) where
+
+import Control.Monad.Except (ExceptT (ExceptT))
+import Control.Monad.Identity
+  ( Identity (Identity),
+    IdentityT (IdentityT),
+  )
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import qualified Control.Monad.Writer.Lazy as WriterLazy
+import qualified Control.Monad.Writer.Strict as WriterStrict
+import qualified Data.ByteString as B
+import Data.Functor.Sum (Sum (InL, InR))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.Stack (HasCallStack)
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp ((.||)))
+import Grisette.Core.Data.Class.SubstituteSym (SubstituteSym (substituteSym))
+import Grisette.Core.Data.Class.TestValues (ssymBool, ssymbolBool)
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit (Assertion, (@?=))
+import Test.QuickCheck (ioProperty)
+
+concreteSubstituteSymOkProp ::
+  (HasCallStack, SubstituteSym a, Show a, Eq a) => a -> Assertion
+concreteSubstituteSymOkProp x =
+  substituteSym (ssymbolBool "a") (ssymBool "b") x @?= x
+
+substituteSymTests :: Test
+substituteSymTests =
+  testGroup
+    "SubstituteSym"
+    [ testGroup
+        "SubstituteSym for common types"
+        [ testCase "SymBool" $ do
+            let asym = ssymbolBool "a"
+            let a = ssymBool "a"
+            let b = ssymBool "b"
+            let c = ssymBool "c"
+            let subst = substituteSym asym b
+            subst a @?= b
+            subst c @?= c
+            subst (a .|| c) @?= b .|| c,
+          testProperty "Bool" $ ioProperty . concreteSubstituteSymOkProp @Bool,
+          testProperty "Integer" $
+            ioProperty . concreteSubstituteSymOkProp @Integer,
+          testProperty "Char" $ ioProperty . concreteSubstituteSymOkProp @Char,
+          testProperty "Int" $ ioProperty . concreteSubstituteSymOkProp @Int,
+          testProperty "Int8" $ ioProperty . concreteSubstituteSymOkProp @Int8,
+          testProperty "Int16" $
+            ioProperty . concreteSubstituteSymOkProp @Int16,
+          testProperty "Int32" $
+            ioProperty . concreteSubstituteSymOkProp @Int32,
+          testProperty "Int64" $
+            ioProperty . concreteSubstituteSymOkProp @Int64,
+          testProperty "Word" $ ioProperty . concreteSubstituteSymOkProp @Word,
+          testProperty "Word8" $
+            ioProperty . concreteSubstituteSymOkProp @Word8,
+          testProperty "Word16" $
+            ioProperty . concreteSubstituteSymOkProp @Word16,
+          testProperty "Word32" $
+            ioProperty . concreteSubstituteSymOkProp @Word32,
+          testProperty "Word64" $
+            ioProperty . concreteSubstituteSymOkProp @Word64,
+          testGroup
+            "List"
+            [ testProperty "[Integer]" $
+                ioProperty . concreteSubstituteSymOkProp @[Integer],
+              testCase "[SymBool]" $ do
+                let asym = ssymbolBool "a"
+                let a = ssymBool "a"
+                let b = ssymBool "b"
+                let c = ssymBool "c"
+                let subst = substituteSym asym b
+                subst [a, c] @?= [b, c]
+            ],
+          testGroup
+            "Maybe"
+            [ testProperty "Maybe Integer" $
+                ioProperty . concreteSubstituteSymOkProp @(Maybe Integer),
+              testCase "Maybe SymBool" $ do
+                let asym = ssymbolBool "a"
+                let a = ssymBool "a"
+                let b = ssymBool "b"
+                let c = ssymBool "c"
+                let subst :: Maybe SymBool -> Maybe SymBool
+                    subst = substituteSym asym b
+                subst (Just a) @?= Just b
+                subst (Just c) @?= Just c
+                subst Nothing @?= Nothing
+            ],
+          testGroup
+            "Either"
+            [ testProperty "Either Integer Integer" $
+                ioProperty
+                  . concreteSubstituteSymOkProp @(Either Integer Integer),
+              testCase "Either SymBool SymBool" $ do
+                let asym = ssymbolBool "a"
+                let a = ssymBool "a"
+                let b = ssymBool "b"
+                let c = ssymBool "c"
+                let subst :: Either SymBool SymBool -> Either SymBool SymBool
+                    subst = substituteSym asym b
+                subst (Left a) @?= Left b
+                subst (Left c) @?= Left c
+                subst (Right a) @?= Right b
+                subst (Right c) @?= Right c
+            ],
+          testGroup
+            "MaybeT"
+            [ testProperty "MaybeT Maybe Integer" $
+                ioProperty
+                  . concreteSubstituteSymOkProp @(MaybeT Maybe Integer)
+                  . MaybeT,
+              testCase "MaybeT Maybe SymBool" $ do
+                let asym = ssymbolBool "a"
+                let a = ssymBool "a"
+                let b = ssymBool "b"
+                let c = ssymBool "c"
+                let subst :: MaybeT Maybe SymBool -> MaybeT Maybe SymBool
+                    subst = substituteSym asym b
+                subst (MaybeT Nothing) @?= MaybeT Nothing
+                subst (MaybeT (Just Nothing)) @?= MaybeT (Just Nothing)
+                subst (MaybeT (Just (Just a))) @?= MaybeT (Just (Just b))
+                subst (MaybeT (Just (Just c))) @?= MaybeT (Just (Just c))
+            ],
+          testGroup
+            "ExceptT"
+            [ testProperty "ExceptT Maybe Integer" $
+                ioProperty
+                  . concreteSubstituteSymOkProp @(ExceptT Integer Maybe Integer)
+                  . ExceptT,
+              testCase "ExceptT SymBool Maybe SymBool" $ do
+                let asym = ssymbolBool "a"
+                let a = ssymBool "a"
+                let b = ssymBool "b"
+                let c = ssymBool "c"
+                let subst ::
+                      ExceptT SymBool Maybe SymBool ->
+                      ExceptT SymBool Maybe SymBool
+                    subst = substituteSym asym b
+                subst (ExceptT Nothing) @?= ExceptT Nothing
+                subst (ExceptT $ Just $ Left a) @?= ExceptT (Just $ Left b)
+                subst (ExceptT $ Just $ Left c) @?= ExceptT (Just $ Left c)
+                subst (ExceptT $ Just $ Right a) @?= ExceptT (Just $ Right b)
+                subst (ExceptT $ Just $ Right c) @?= ExceptT (Just $ Right c)
+            ],
+          testProperty "()" (ioProperty . concreteSubstituteSymOkProp @()),
+          testGroup
+            "(,)"
+            [ testProperty "(Integer, Integer)" $
+                ioProperty . concreteSubstituteSymOkProp @(Integer, Integer),
+              testCase "(SymBool, SymBool)" $ do
+                let asym = ssymbolBool "a"
+                let a = ssymBool "a"
+                let b = ssymBool "b"
+                let c = ssymBool "c"
+                substituteSym asym b (a, c) @?= (b, c)
+            ],
+          testGroup
+            "(,,)"
+            [ testProperty "(Integer, Integer, Integer)" $
+                ioProperty
+                  . concreteSubstituteSymOkProp @(Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool)" $ do
+                let asym = ssymbolBool "a"
+                let a = ssymBool "a"
+                let b = ssymBool "b"
+                let c = ssymBool "c"
+                substituteSym asym b (a, c, a) @?= (b, c, b)
+            ],
+          testGroup
+            "(,,,)"
+            [ testProperty "(Integer, Integer, Integer, Integer)" $
+                ioProperty
+                  . concreteSubstituteSymOkProp
+                    @(Integer, Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool, SymBool)" $ do
+                let asym = ssymbolBool "a"
+                let a = ssymBool "a"
+                let b = ssymBool "b"
+                let c = ssymBool "c"
+                substituteSym asym b (a, c, a, c) @?= (b, c, b, c)
+            ],
+          testGroup
+            "(,,,,)"
+            [ testProperty "(Integer, Integer, Integer, Integer, Integer)" $
+                ioProperty
+                  . concreteSubstituteSymOkProp
+                    @(Integer, Integer, Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool, SymBool, SymBool)" $ do
+                let asym = ssymbolBool "a"
+                let a = ssymBool "a"
+                let b = ssymBool "b"
+                let c = ssymBool "c"
+                substituteSym asym b (a, c, a, c, a) @?= (b, c, b, c, b)
+            ],
+          testGroup
+            "(,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteSubstituteSymOkProp
+                    @(Integer, Integer, Integer, Integer, Integer, Integer),
+              testCase
+                "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                $ do
+                  let asym = ssymbolBool "a"
+                  let a = ssymBool "a"
+                  let b = ssymBool "b"
+                  let c = ssymBool "c"
+                  substituteSym asym b (a, c, a, c, a, c) @?= (b, c, b, c, b, c)
+            ],
+          testGroup
+            "(,,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteSubstituteSymOkProp
+                    @( Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer
+                     ),
+              testCase
+                "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                $ do
+                  let asym = ssymbolBool "a"
+                  let a = ssymBool "a"
+                  let b = ssymBool "b"
+                  let c = ssymBool "c"
+                  substituteSym asym b (a, c, a, c, a, c, a)
+                    @?= (b, c, b, c, b, c, b)
+            ],
+          testGroup
+            "(,,,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . concreteSubstituteSymOkProp
+                    @( Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer
+                     ),
+              testCase
+                "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                $ do
+                  let asym = ssymbolBool "a"
+                  let a = ssymBool "a"
+                  let b = ssymBool "b"
+                  let c = ssymBool "c"
+                  substituteSym asym b (a, c, a, c, a, c, a, c)
+                    @?= (b, c, b, c, b, c, b, c)
+            ],
+          testProperty "ByteString" $
+            ioProperty
+              . concreteSubstituteSymOkProp @B.ByteString
+              . B.pack,
+          testGroup
+            "Sum"
+            [ testProperty
+                "Sum Maybe Maybe Integer"
+                ( ioProperty
+                    . concreteSubstituteSymOkProp @(Sum Maybe Maybe Integer)
+                    . ( \case
+                          Left x -> InL x
+                          Right x -> InL x
+                      )
+                ),
+              testCase
+                "Sum Maybe Maybe SymBool"
+                ( do
+                    let asym = ssymbolBool "a"
+                    let a = ssymBool "a"
+                    let b = ssymBool "b"
+                    let c = ssymBool "c"
+                    let subst ::
+                          Sum Maybe Maybe SymBool ->
+                          Sum Maybe Maybe SymBool
+                        subst = substituteSym asym b
+                    subst (InL Nothing) @?= InL Nothing
+                    subst (InL (Just a)) @?= InL (Just b)
+                    subst (InL (Just c)) @?= InL (Just c)
+                    subst (InR Nothing) @?= InR Nothing
+                    subst (InR (Just a)) @?= InR (Just b)
+                    subst (InR (Just c)) @?= InR (Just c)
+                )
+            ],
+          testGroup
+            "WriterT"
+            [ testGroup
+                "Lazy"
+                [ testProperty
+                    "WriterT Integer (Either Integer) Integer"
+                    ( ioProperty
+                        . concreteSubstituteSymOkProp
+                          @(WriterLazy.WriterT Integer (Either Integer) Integer)
+                        . WriterLazy.WriterT
+                    ),
+                  testCase "WriterT SymBool (Either SymBool) SymBool" $ do
+                    let asym = ssymbolBool "a"
+                    let a = ssymBool "a"
+                    let b = ssymBool "b"
+                    let c = ssymBool "c"
+                    let subst ::
+                          WriterLazy.WriterT SymBool (Either SymBool) SymBool ->
+                          WriterLazy.WriterT SymBool (Either SymBool) SymBool
+                        subst = substituteSym asym b
+                    subst
+                      (WriterLazy.WriterT (Left a))
+                      @?= WriterLazy.WriterT (Left b)
+                    subst
+                      (WriterLazy.WriterT (Left c))
+                      @?= WriterLazy.WriterT (Left c)
+                    subst
+                      (WriterLazy.WriterT (Right (a, a)))
+                      @?= WriterLazy.WriterT (Right (b, b))
+                    subst
+                      (WriterLazy.WriterT (Right (c, c)))
+                      @?= WriterLazy.WriterT (Right (c, c))
+                ],
+              testGroup
+                "Strict"
+                [ testProperty
+                    "WriterT Integer (Either Integer) Integer"
+                    ( ioProperty
+                        . concreteSubstituteSymOkProp
+                          @( WriterStrict.WriterT
+                               Integer
+                               (Either Integer)
+                               Integer
+                           )
+                        . WriterStrict.WriterT
+                    ),
+                  testCase "WriterT SymBool (Either SymBool) SymBool" $ do
+                    let asym = ssymbolBool "a"
+                    let a = ssymBool "a"
+                    let b = ssymBool "b"
+                    let c = ssymBool "c"
+                    let subst ::
+                          WriterStrict.WriterT
+                            SymBool
+                            (Either SymBool)
+                            SymBool ->
+                          WriterStrict.WriterT
+                            SymBool
+                            (Either SymBool)
+                            SymBool
+                        subst = substituteSym asym b
+                    subst
+                      (WriterStrict.WriterT (Left a))
+                      @?= WriterStrict.WriterT (Left b)
+                    subst
+                      (WriterStrict.WriterT (Left c))
+                      @?= WriterStrict.WriterT (Left c)
+                    subst
+                      (WriterStrict.WriterT (Right (a, a)))
+                      @?= WriterStrict.WriterT (Right (b, b))
+                    subst
+                      (WriterStrict.WriterT (Right (c, c)))
+                      @?= WriterStrict.WriterT (Right (c, c))
+                ]
+            ],
+          testGroup
+            "Identity"
+            [ testProperty
+                "Identity Integer"
+                (ioProperty . concreteSubstituteSymOkProp @(Identity Integer)),
+              testCase "Identity SymBool" $ do
+                let asym = ssymbolBool "a"
+                let a = ssymBool "a"
+                let b = ssymBool "b"
+                let c = ssymBool "c"
+                let subst :: Identity SymBool -> Identity SymBool
+                    subst = substituteSym asym b
+                subst (Identity a) @?= Identity b
+                subst (Identity c) @?= Identity c
+            ],
+          testGroup
+            "IdentityT"
+            [ testProperty
+                "IdentityT (Either Integer) Integer"
+                $ ioProperty
+                  . concreteSubstituteSymOkProp
+                    @(IdentityT (Either Integer) Integer)
+                  . IdentityT,
+              testCase "IdentityT (Either SymBool) SymBool" $ do
+                let asym = ssymbolBool "a"
+                let a = ssymBool "a"
+                let b = ssymBool "b"
+                let c = ssymBool "c"
+                let subst ::
+                      IdentityT (Either SymBool) SymBool ->
+                      IdentityT (Either SymBool) SymBool
+                    subst = substituteSym asym b
+                subst (IdentityT (Left a)) @?= IdentityT (Left b)
+                subst (IdentityT (Left c)) @?= IdentityT (Left c)
+                subst (IdentityT (Right a)) @?= IdentityT (Right b)
+                subst (IdentityT (Right c)) @?= IdentityT (Right c)
+            ]
+        ]
+    ]
diff --git a/test/Grisette/Core/Data/Class/SymRotateTests.hs b/test/Grisette/Core/Data/Class/SymRotateTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/SymRotateTests.hs
@@ -0,0 +1,168 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Grisette.Core.Data.Class.SymRotateTests (symRotateTests) where
+
+import Data.Bits (Bits (rotate), FiniteBits (finiteBitSize))
+import Data.Data (Proxy (Proxy), Typeable, typeRep)
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+import Grisette (IntN, LinkedRep, Solvable, SymIntN, SymWordN)
+import Grisette.Core.Data.BV (WordN)
+import Grisette.Core.Data.Class.Solvable (Solvable (con))
+import Grisette.Core.Data.Class.SymRotate (SymRotate (symRotate))
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit (Assertion, (@?=))
+import Test.QuickCheck (Arbitrary, chooseInt, forAll, ioProperty)
+
+concreteRotateIsCorrect ::
+  (SymRotate a, Show a, Integral a, FiniteBits a) =>
+  a ->
+  a ->
+  Assertion
+concreteRotateIsCorrect a s =
+  symRotate a s
+    @?= rotate
+      a
+      ( fromIntegral $
+          (fromIntegral s :: Integer) `mod` fromIntegral (finiteBitSize a)
+      )
+
+concreteUnsignedTypeSymRotateTests ::
+  forall proxy a.
+  ( Arbitrary a,
+    Show a,
+    Num a,
+    Eq a,
+    SymRotate a,
+    FiniteBits a,
+    Bounded a,
+    Typeable a,
+    Integral a
+  ) =>
+  proxy a ->
+  Test
+concreteUnsignedTypeSymRotateTests p =
+  testGroup
+    (show $ typeRep p)
+    [ testGroup
+        "SymRotate"
+        [ testProperty "symRotate" $ \(x :: a) ->
+            forAll (chooseInt (0, finiteBitSize x)) $
+              \(s :: Int) ->
+                ioProperty $ concreteRotateIsCorrect x (fromIntegral s),
+          testProperty "symRotate max" $ \(x :: a) ->
+            ioProperty $ concreteRotateIsCorrect x maxBound
+        ]
+    ]
+
+concreteSignedTypeSymRotateTests ::
+  forall proxy a.
+  ( Arbitrary a,
+    Show a,
+    Num a,
+    Eq a,
+    SymRotate a,
+    FiniteBits a,
+    Bounded a,
+    Typeable a,
+    Integral a
+  ) =>
+  proxy a ->
+  Test
+concreteSignedTypeSymRotateTests p =
+  testGroup
+    (show $ typeRep p)
+    [ testGroup
+        "SymRotate"
+        [ testProperty "symRotate" $ \(x :: a) ->
+            forAll (chooseInt (-finiteBitSize x, finiteBitSize x)) $
+              \(s :: Int) ->
+                ioProperty $ concreteRotateIsCorrect x (fromIntegral s),
+          testProperty "symRotate max" $ \(x :: a) ->
+            ioProperty $ concreteRotateIsCorrect x maxBound,
+          testProperty "symRotate min" $ \(x :: a) ->
+            ioProperty $ concreteRotateIsCorrect x minBound
+        ]
+    ]
+
+symbolicTypeSymRotateTests ::
+  forall proxy c s.
+  ( Arbitrary c,
+    Show s,
+    Num s,
+    Eq s,
+    SymRotate c,
+    SymRotate s,
+    FiniteBits c,
+    FiniteBits s,
+    Bounded c,
+    Typeable s,
+    Integral c,
+    LinkedRep c s,
+    Solvable c s
+  ) =>
+  proxy s ->
+  Test
+symbolicTypeSymRotateTests p =
+  testGroup
+    (show $ typeRep p)
+    [ testGroup
+        "SymRotate"
+        [ testProperty "concrete/concrete symRotate" $ \(x :: c) ->
+            forAll (chooseInt (-finiteBitSize x, finiteBitSize x)) $
+              \(s :: Int) ->
+                ioProperty $
+                  symRotate (con x :: s) (fromIntegral s)
+                    @?= con (symRotate x (fromIntegral s)),
+          testProperty "symRotate max" $ \(x :: c) ->
+            ioProperty $
+              symRotate (con x :: s) (con maxBound)
+                @?= con (symRotate x maxBound),
+          testProperty "symRotate min" $ \(x :: c) ->
+            ioProperty $ do
+              symRotate (con x :: s) (con minBound)
+                @?= con (symRotate x minBound)
+        ]
+    ]
+
+symRotateTests :: Test
+symRotateTests =
+  testGroup
+    "SymRotate"
+    [ concreteUnsignedTypeSymRotateTests (Proxy :: Proxy Word8),
+      concreteUnsignedTypeSymRotateTests (Proxy :: Proxy Word16),
+      concreteUnsignedTypeSymRotateTests (Proxy :: Proxy Word32),
+      concreteUnsignedTypeSymRotateTests (Proxy :: Proxy Word64),
+      concreteUnsignedTypeSymRotateTests (Proxy :: Proxy Word),
+      concreteUnsignedTypeSymRotateTests (Proxy :: Proxy (WordN 1)),
+      concreteUnsignedTypeSymRotateTests (Proxy :: Proxy (WordN 2)),
+      concreteUnsignedTypeSymRotateTests (Proxy :: Proxy (WordN 63)),
+      concreteUnsignedTypeSymRotateTests (Proxy :: Proxy (WordN 64)),
+      concreteUnsignedTypeSymRotateTests (Proxy :: Proxy (WordN 65)),
+      concreteUnsignedTypeSymRotateTests (Proxy :: Proxy (WordN 128)),
+      concreteSignedTypeSymRotateTests (Proxy :: Proxy Int8),
+      concreteSignedTypeSymRotateTests (Proxy :: Proxy Int16),
+      concreteSignedTypeSymRotateTests (Proxy :: Proxy Int32),
+      concreteSignedTypeSymRotateTests (Proxy :: Proxy Int64),
+      concreteSignedTypeSymRotateTests (Proxy :: Proxy Int),
+      concreteSignedTypeSymRotateTests (Proxy :: Proxy (IntN 1)),
+      concreteSignedTypeSymRotateTests (Proxy :: Proxy (IntN 2)),
+      concreteSignedTypeSymRotateTests (Proxy :: Proxy (IntN 63)),
+      concreteSignedTypeSymRotateTests (Proxy :: Proxy (IntN 64)),
+      concreteSignedTypeSymRotateTests (Proxy :: Proxy (IntN 65)),
+      concreteSignedTypeSymRotateTests (Proxy :: Proxy (IntN 128)),
+      symbolicTypeSymRotateTests (Proxy :: Proxy (SymWordN 1)),
+      symbolicTypeSymRotateTests (Proxy :: Proxy (SymWordN 2)),
+      symbolicTypeSymRotateTests (Proxy :: Proxy (SymWordN 63)),
+      symbolicTypeSymRotateTests (Proxy :: Proxy (SymWordN 64)),
+      symbolicTypeSymRotateTests (Proxy :: Proxy (SymWordN 65)),
+      symbolicTypeSymRotateTests (Proxy :: Proxy (SymWordN 128)),
+      symbolicTypeSymRotateTests (Proxy :: Proxy (SymIntN 1)),
+      symbolicTypeSymRotateTests (Proxy :: Proxy (SymIntN 2)),
+      symbolicTypeSymRotateTests (Proxy :: Proxy (SymIntN 63)),
+      symbolicTypeSymRotateTests (Proxy :: Proxy (SymIntN 64)),
+      symbolicTypeSymRotateTests (Proxy :: Proxy (SymIntN 65)),
+      symbolicTypeSymRotateTests (Proxy :: Proxy (SymIntN 128))
+    ]
diff --git a/test/Grisette/Core/Data/Class/SymShiftTests.hs b/test/Grisette/Core/Data/Class/SymShiftTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/SymShiftTests.hs
@@ -0,0 +1,168 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Grisette.Core.Data.Class.SymShiftTests (symShiftTests) where
+
+import Data.Bits (Bits (shift), FiniteBits (finiteBitSize))
+import Data.Data (Proxy (Proxy), Typeable, typeRep)
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+import Grisette (IntN, LinkedRep, Solvable, SymIntN, SymWordN)
+import Grisette.Core.Data.BV (WordN)
+import Grisette.Core.Data.Class.Solvable (Solvable (con))
+import Grisette.Core.Data.Class.SymShift (SymShift (symShift))
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit ((@?=))
+import Test.QuickCheck (Arbitrary, chooseInt, forAll, ioProperty)
+
+concreteUnsignedTypeSymShiftTests ::
+  forall proxy a.
+  ( Arbitrary a,
+    Show a,
+    Num a,
+    Eq a,
+    SymShift a,
+    FiniteBits a,
+    Bounded a,
+    Typeable a,
+    Integral a
+  ) =>
+  proxy a ->
+  Test
+concreteUnsignedTypeSymShiftTests p =
+  testGroup
+    (show $ typeRep p)
+    [ testGroup
+        "SymShift"
+        [ testProperty "symShift" $ \(x :: a) ->
+            forAll (chooseInt (0, finiteBitSize x)) $
+              \(s :: Int) ->
+                ioProperty $
+                  symShift x (fromIntegral s) @?= shift x s,
+          testProperty "symShift max" $ \(x :: a) ->
+            ioProperty $ symShift x maxBound @?= 0
+        ]
+    ]
+
+concreteSignedTypeSymShiftTests ::
+  forall proxy a.
+  ( Arbitrary a,
+    Show a,
+    Num a,
+    Eq a,
+    SymShift a,
+    FiniteBits a,
+    Bounded a,
+    Typeable a,
+    Integral a
+  ) =>
+  proxy a ->
+  Test
+concreteSignedTypeSymShiftTests p =
+  testGroup
+    (show $ typeRep p)
+    [ testGroup
+        "SymShift"
+        [ testProperty "symShift" $ \(x :: a) ->
+            forAll (chooseInt (-finiteBitSize x, finiteBitSize x)) $
+              \(s :: Int) -> ioProperty $ do
+                symShift x (fromIntegral s)
+                  @?= shift x (fromIntegral (fromIntegral s :: a)),
+          testProperty "symShift max" $ \(x :: a) ->
+            ioProperty $ do
+              case finiteBitSize x of
+                1 -> symShift x maxBound @?= x
+                2 -> symShift x maxBound @?= shift x 1
+                _ -> symShift x maxBound @?= 0,
+          testProperty "symShift min" $ \(x :: a) ->
+            ioProperty $ do
+              case finiteBitSize x of
+                1 ->
+                  symShift x minBound @?= shift x (-1)
+                2 ->
+                  symShift x minBound @?= shift x (-2)
+                _ ->
+                  symShift x minBound @?= if x >= 0 then 0 else -1
+        ]
+    ]
+
+symbolicTypeSymShiftTests ::
+  forall proxy c s.
+  ( Arbitrary c,
+    Show s,
+    Num s,
+    Eq s,
+    SymShift c,
+    SymShift s,
+    FiniteBits c,
+    FiniteBits s,
+    Bounded c,
+    Typeable s,
+    Integral c,
+    LinkedRep c s,
+    Solvable c s
+  ) =>
+  proxy s ->
+  Test
+symbolicTypeSymShiftTests p =
+  testGroup
+    (show $ typeRep p)
+    [ testGroup
+        "SymShift"
+        [ testProperty "concrete/concrete symShift" $ \(x :: c) ->
+            forAll (chooseInt (-finiteBitSize x, finiteBitSize x)) $
+              \(s :: Int) ->
+                ioProperty $
+                  symShift (con x :: s) (fromIntegral s)
+                    @?= con (symShift x (fromIntegral s)),
+          testProperty "symShift max" $ \(x :: c) ->
+            ioProperty $
+              symShift (con x :: s) (con maxBound)
+                @?= con (symShift x maxBound),
+          testProperty "symShift min" $ \(x :: c) ->
+            ioProperty $ do
+              symShift (con x :: s) (con minBound)
+                @?= con (symShift x minBound)
+        ]
+    ]
+
+symShiftTests :: Test
+symShiftTests =
+  testGroup
+    "SymShift"
+    [ concreteUnsignedTypeSymShiftTests (Proxy :: Proxy Word8),
+      concreteUnsignedTypeSymShiftTests (Proxy :: Proxy Word16),
+      concreteUnsignedTypeSymShiftTests (Proxy :: Proxy Word32),
+      concreteUnsignedTypeSymShiftTests (Proxy :: Proxy Word64),
+      concreteUnsignedTypeSymShiftTests (Proxy :: Proxy Word),
+      concreteUnsignedTypeSymShiftTests (Proxy :: Proxy (WordN 1)),
+      concreteUnsignedTypeSymShiftTests (Proxy :: Proxy (WordN 2)),
+      concreteUnsignedTypeSymShiftTests (Proxy :: Proxy (WordN 63)),
+      concreteUnsignedTypeSymShiftTests (Proxy :: Proxy (WordN 64)),
+      concreteUnsignedTypeSymShiftTests (Proxy :: Proxy (WordN 65)),
+      concreteUnsignedTypeSymShiftTests (Proxy :: Proxy (WordN 128)),
+      concreteSignedTypeSymShiftTests (Proxy :: Proxy Int8),
+      concreteSignedTypeSymShiftTests (Proxy :: Proxy Int16),
+      concreteSignedTypeSymShiftTests (Proxy :: Proxy Int32),
+      concreteSignedTypeSymShiftTests (Proxy :: Proxy Int64),
+      concreteSignedTypeSymShiftTests (Proxy :: Proxy Int),
+      concreteSignedTypeSymShiftTests (Proxy :: Proxy (IntN 1)),
+      concreteSignedTypeSymShiftTests (Proxy :: Proxy (IntN 2)),
+      concreteSignedTypeSymShiftTests (Proxy :: Proxy (IntN 63)),
+      concreteSignedTypeSymShiftTests (Proxy :: Proxy (IntN 64)),
+      concreteSignedTypeSymShiftTests (Proxy :: Proxy (IntN 65)),
+      concreteSignedTypeSymShiftTests (Proxy :: Proxy (IntN 128)),
+      symbolicTypeSymShiftTests (Proxy :: Proxy (SymWordN 1)),
+      symbolicTypeSymShiftTests (Proxy :: Proxy (SymWordN 2)),
+      symbolicTypeSymShiftTests (Proxy :: Proxy (SymWordN 63)),
+      symbolicTypeSymShiftTests (Proxy :: Proxy (SymWordN 64)),
+      symbolicTypeSymShiftTests (Proxy :: Proxy (SymWordN 65)),
+      symbolicTypeSymShiftTests (Proxy :: Proxy (SymWordN 128)),
+      symbolicTypeSymShiftTests (Proxy :: Proxy (SymIntN 1)),
+      symbolicTypeSymShiftTests (Proxy :: Proxy (SymIntN 2)),
+      symbolicTypeSymShiftTests (Proxy :: Proxy (SymIntN 63)),
+      symbolicTypeSymShiftTests (Proxy :: Proxy (SymIntN 64)),
+      symbolicTypeSymShiftTests (Proxy :: Proxy (SymIntN 65)),
+      symbolicTypeSymShiftTests (Proxy :: Proxy (SymIntN 128))
+    ]
diff --git a/test/Grisette/Core/Data/Class/TestValues.hs b/test/Grisette/Core/Data/Class/TestValues.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/TestValues.hs
@@ -0,0 +1,39 @@
+module Grisette.Core.Data.Class.TestValues
+  ( conBool,
+    symTrue,
+    symFalse,
+    ssymBool,
+    isymBool,
+    ssymbolBool,
+    isymbolBool,
+  )
+where
+
+import qualified Data.Text as T
+import Grisette
+  ( Solvable (isym),
+    TypedSymbol (IndexedSymbol, SimpleSymbol),
+  )
+import Grisette.Core.Data.Class.Solvable (Solvable (con, ssym))
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+
+conBool :: Bool -> SymBool
+conBool = con
+
+symTrue :: SymBool
+symTrue = conBool True
+
+symFalse :: SymBool
+symFalse = conBool False
+
+ssymBool :: T.Text -> SymBool
+ssymBool = ssym
+
+isymBool :: T.Text -> Int -> SymBool
+isymBool = isym
+
+ssymbolBool :: T.Text -> TypedSymbol Bool
+ssymbolBool = SimpleSymbol
+
+isymbolBool :: T.Text -> Int -> TypedSymbol Bool
+isymbolBool = IndexedSymbol
diff --git a/test/Grisette/Core/Data/Class/ToConTests.hs b/test/Grisette/Core/Data/Class/ToConTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/ToConTests.hs
@@ -0,0 +1,482 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Grisette.Core.Data.Class.ToConTests (toConTests) where
+
+import Control.Monad.Except (ExceptT (ExceptT))
+import Control.Monad.Identity
+  ( Identity (Identity),
+    IdentityT (IdentityT),
+  )
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import qualified Control.Monad.Writer.Lazy as WriterLazy
+import qualified Control.Monad.Writer.Strict as WriterStrict
+import qualified Data.ByteString.Char8 as C
+import Data.Foldable (traverse_)
+import Data.Functor.Sum (Sum (InL, InR))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.Stack (HasCallStack)
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&), (.||)))
+import Grisette.Core.Data.Class.SEq (SEq ((.==)))
+import Grisette.Core.Data.Class.TestValues
+  ( conBool,
+    isymBool,
+    ssymBool,
+    symFalse,
+    symTrue,
+  )
+import Grisette.Core.Data.Class.ToCon (ToCon (toCon))
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit (Assertion, (@?=))
+import Test.QuickCheck (ioProperty)
+
+toConForConcreteOkProp ::
+  (HasCallStack, ToCon v v, Show v, Eq v) => v -> Assertion
+toConForConcreteOkProp v = toCon v @?= Just v
+
+toConTests :: Test
+toConTests =
+  testGroup
+    "ToCon"
+    [ testGroup
+        "ToCon for common types"
+        [ testGroup
+            "SymBool"
+            [ testGroup
+                "To Bool"
+                [ testCase "con" $ do
+                    let bools :: [Bool] = [True, False]
+                    traverse_ (\v -> toCon (conBool v) @?= Just v) bools,
+                  testCase "Symbolic SymBools" $ do
+                    let sbools :: [SymBool] =
+                          [ ssymBool "a",
+                            isymBool "a" 1,
+                            ssymBool "a" .&& ssymBool "b",
+                            ssymBool "a" .|| ssymBool "b",
+                            symNot $ ssymBool "a",
+                            ssymBool "a" .== ssymBool "b",
+                            symIte (ssymBool "a") (ssymBool "b") (ssymBool "c")
+                          ]
+                    traverse_ (\v -> toCon v @?= (Nothing :: Maybe Bool)) sbools
+                ],
+              testCase "To SymBool" $ do
+                let sbools :: [SymBool] =
+                      [ symTrue,
+                        ssymBool "a",
+                        isymBool "a" 1,
+                        ssymBool "a" .&& ssymBool "b",
+                        ssymBool "a" .|| ssymBool "b",
+                        symNot $ ssymBool "a",
+                        ssymBool "a" .== ssymBool "b",
+                        symIte (ssymBool "a") (ssymBool "b") (ssymBool "c")
+                      ]
+                traverse_ (\v -> toCon v @?= Just v) sbools
+            ],
+          testProperty "Bool" $ ioProperty . toConForConcreteOkProp @Bool,
+          testProperty "Integer" $ ioProperty . toConForConcreteOkProp @Integer,
+          testProperty "Char" $ ioProperty . toConForConcreteOkProp @Char,
+          testProperty "Int" $ ioProperty . toConForConcreteOkProp @Int,
+          testProperty "Int8" $ ioProperty . toConForConcreteOkProp @Int8,
+          testProperty "Int16" $ ioProperty . toConForConcreteOkProp @Int16,
+          testProperty "Int32" $ ioProperty . toConForConcreteOkProp @Int32,
+          testProperty "Int64" $ ioProperty . toConForConcreteOkProp @Int64,
+          testProperty "Word" $ ioProperty . toConForConcreteOkProp @Word,
+          testProperty "Word8" $ ioProperty . toConForConcreteOkProp @Word8,
+          testProperty "Word16" $ ioProperty . toConForConcreteOkProp @Word16,
+          testProperty "Word32" $ ioProperty . toConForConcreteOkProp @Word32,
+          testProperty "Word64" $ ioProperty . toConForConcreteOkProp @Word64,
+          testProperty "()" $ ioProperty . toConForConcreteOkProp @(),
+          testProperty "ByteString" $
+            ioProperty
+              . \(v :: String) -> toConForConcreteOkProp (C.pack v),
+          testGroup
+            "List"
+            [ testProperty "[Integer]" $
+                ioProperty . toConForConcreteOkProp @[Integer],
+              testCase "[SymBool]" $ do
+                toCon ([] :: [SymBool]) @?= (Just [] :: Maybe [Bool])
+                toCon ([symTrue] :: [SymBool]) @?= (Just [True] :: Maybe [Bool])
+                toCon ([ssymBool "a"] :: [SymBool])
+                  @?= (Nothing :: Maybe [Bool])
+                toCon ([symTrue, symFalse] :: [SymBool])
+                  @?= (Just [True, False] :: Maybe [Bool])
+                toCon ([symTrue, ssymBool "a"] :: [SymBool])
+                  @?= (Nothing :: Maybe [Bool])
+            ],
+          testGroup
+            "Maybe"
+            [ testProperty "Maybe Integer" $
+                ioProperty . toConForConcreteOkProp @(Maybe Integer),
+              testCase "Maybe SymBool" $ do
+                let toConMaybe :: Maybe SymBool -> Maybe (Maybe Bool)
+                    toConMaybe = toCon
+                toConMaybe Nothing @?= (Just Nothing)
+                toConMaybe (Just symTrue) @?= (Just (Just True))
+                toConMaybe (Just $ ssymBool "a") @?= Nothing
+            ],
+          testGroup
+            "Either"
+            [ testProperty "Either Integer Integer" $
+                ioProperty . toConForConcreteOkProp @(Either Integer Integer),
+              testCase "Either SymBool SymBool" $ do
+                let toConEither ::
+                      Either SymBool SymBool ->
+                      Maybe (Either Bool Bool)
+                    toConEither = toCon
+                toConEither (Left symTrue) @?= (Just (Left True))
+                toConEither (Right symTrue) @?= (Just (Right True))
+                toConEither (Left $ ssymBool "a") @?= Nothing
+                toConEither (Right $ ssymBool "a") @?= Nothing
+            ],
+          testGroup
+            "MaybeT"
+            [ testProperty "MaybeT Maybe Integer" $
+                ioProperty . \(v :: Maybe (Maybe Integer)) ->
+                  toConForConcreteOkProp (MaybeT v),
+              testCase "MaybeT Maybe SymBool" $ do
+                toCon (MaybeT Nothing :: MaybeT Maybe SymBool)
+                  @?= (Just $ MaybeT Nothing :: Maybe (MaybeT Maybe Bool))
+                toCon (MaybeT $ Just Nothing :: MaybeT Maybe SymBool)
+                  @?= ( Just $ MaybeT $ Just Nothing ::
+                          Maybe (MaybeT Maybe Bool)
+                      )
+                toCon
+                  ( MaybeT $ Just $ Just symTrue ::
+                      MaybeT Maybe SymBool
+                  )
+                  @?= ( Just $ MaybeT $ Just $ Just True ::
+                          Maybe (MaybeT Maybe Bool)
+                      )
+                toCon
+                  ( MaybeT $ Just $ Just $ ssymBool "a" ::
+                      MaybeT Maybe SymBool
+                  )
+                  @?= (Nothing :: Maybe (MaybeT Maybe Bool))
+            ],
+          testGroup
+            "ExceptT"
+            [ testProperty "ExceptT Integer Maybe Integer" $
+                ioProperty . \(v :: Maybe (Either Integer Integer)) ->
+                  toConForConcreteOkProp (ExceptT v),
+              testCase "ExceptT SymBool Maybe SymBool" $ do
+                let toConExceptT ::
+                      ExceptT SymBool Maybe SymBool ->
+                      Maybe (ExceptT Bool Maybe Bool)
+                    toConExceptT = toCon
+                toConExceptT (ExceptT Nothing) @?= Just (ExceptT Nothing)
+                toConExceptT (ExceptT $ Just $ Left symTrue)
+                  @?= Just (ExceptT $ Just $ Left True)
+                toConExceptT (ExceptT $ Just $ Left $ ssymBool "a") @?= Nothing
+                toConExceptT (ExceptT $ Just $ Right symTrue)
+                  @?= Just (ExceptT $ Just $ Right True)
+                toConExceptT (ExceptT $ Just $ Right $ ssymBool "a") @?= Nothing
+            ],
+          testGroup
+            "(,)"
+            [ testProperty "(Integer, Integer)" $
+                ioProperty . toConForConcreteOkProp @(Integer, Integer),
+              testCase "(SymBool, SymBool)" $ do
+                let toConTuple2 :: (SymBool, SymBool) -> Maybe (Bool, Bool)
+                    toConTuple2 = toCon
+                toConTuple2 (symTrue, symFalse) @?= Just (True, False)
+                toConTuple2 (symTrue, ssymBool "a") @?= Nothing
+            ],
+          testGroup
+            "(,,)"
+            [ testProperty "(Integer, Integer, Integer)" $
+                ioProperty
+                  . toConForConcreteOkProp @(Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool)" $ do
+                let toConTuple3 ::
+                      (SymBool, SymBool, SymBool) ->
+                      Maybe (Bool, Bool, Bool)
+                    toConTuple3 = toCon
+                toConTuple3 (symFalse, symTrue, symFalse)
+                  @?= Just (False, True, False)
+                toConTuple3 (symFalse, symTrue, ssymBool "a")
+                  @?= Nothing
+            ],
+          testGroup
+            "(,,,)"
+            [ testProperty "(Integer, Integer, Integer, Integer)" $
+                ioProperty
+                  . toConForConcreteOkProp
+                    @(Integer, Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool, SymBool)" $ do
+                let toConTuple4 ::
+                      (SymBool, SymBool, SymBool, SymBool) ->
+                      Maybe (Bool, Bool, Bool, Bool)
+                    toConTuple4 = toCon
+                toConTuple4 (symTrue, symFalse, symTrue, symFalse)
+                  @?= Just (True, False, True, False)
+                toConTuple4 (symTrue, symFalse, symTrue, ssymBool "a")
+                  @?= Nothing
+            ],
+          testGroup
+            "(,,,,)"
+            [ testProperty "(Integer, Integer, Integer, Integer, Integer)" $
+                ioProperty
+                  . toConForConcreteOkProp
+                    @(Integer, Integer, Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool, SymBool, SymBool)" $ do
+                let toConTuple5 ::
+                      (SymBool, SymBool, SymBool, SymBool, SymBool) ->
+                      Maybe (Bool, Bool, Bool, Bool, Bool)
+                    toConTuple5 = toCon
+                toConTuple5 (symFalse, symTrue, symFalse, symTrue, symFalse)
+                  @?= Just (False, True, False, True, False)
+                toConTuple5 (symFalse, symTrue, symFalse, symTrue, ssymBool "a")
+                  @?= Nothing
+            ],
+          testGroup
+            "(,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . toConForConcreteOkProp
+                    @(Integer, Integer, Integer, Integer, Integer, Integer),
+              testCase
+                "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                $ do
+                  let toConTuple6 ::
+                        ( SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool
+                        ) ->
+                        Maybe (Bool, Bool, Bool, Bool, Bool, Bool)
+                      toConTuple6 = toCon
+                  toConTuple6
+                    (symTrue, symFalse, symTrue, symFalse, symTrue, symFalse)
+                    @?= Just (True, False, True, False, True, False)
+                  toConTuple6
+                    (symTrue, symFalse, symTrue, symFalse, symTrue, ssymBool "a")
+                    @?= Nothing
+            ],
+          testGroup
+            "(,,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . toConForConcreteOkProp
+                    @( Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer
+                     ),
+              testCase
+                "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                $ do
+                  let toConTuple7 ::
+                        ( SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool
+                        ) ->
+                        Maybe (Bool, Bool, Bool, Bool, Bool, Bool, Bool)
+                      toConTuple7 = toCon
+                  toConTuple7
+                    ( symFalse,
+                      symTrue,
+                      symFalse,
+                      symTrue,
+                      symFalse,
+                      symTrue,
+                      symFalse
+                    )
+                    @?= Just (False, True, False, True, False, True, False)
+                  toConTuple7
+                    ( symFalse,
+                      symTrue,
+                      symFalse,
+                      symTrue,
+                      symFalse,
+                      symTrue,
+                      ssymBool "a"
+                    )
+                    @?= Nothing
+            ],
+          testGroup
+            "(,,,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . toConForConcreteOkProp
+                    @( Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer
+                     ),
+              testCase
+                "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                $ do
+                  let toConTuple8 ::
+                        ( SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool,
+                          SymBool
+                        ) ->
+                        Maybe (Bool, Bool, Bool, Bool, Bool, Bool, Bool, Bool)
+                      toConTuple8 = toCon
+                  toConTuple8
+                    ( symTrue,
+                      symFalse,
+                      symTrue,
+                      symFalse,
+                      symTrue,
+                      symFalse,
+                      symTrue,
+                      symFalse
+                    )
+                    @?= Just
+                      ( True,
+                        False,
+                        True,
+                        False,
+                        True,
+                        False,
+                        True,
+                        False
+                      )
+                  toConTuple8
+                    ( symTrue,
+                      symFalse,
+                      symTrue,
+                      symFalse,
+                      symTrue,
+                      symFalse,
+                      symTrue,
+                      ssymBool "a"
+                    )
+                    @?= Nothing
+            ],
+          testGroup
+            "Sum"
+            [ testProperty "Sum Maybe Maybe Integer" $
+                ioProperty . \(v :: Either (Maybe Integer) (Maybe Integer)) ->
+                  toConForConcreteOkProp $ case v of
+                    Left x -> InL x
+                    Right x -> InR x,
+              testCase "Sum Maybe (Either SymBool) SymBool" $ do
+                let toConSum ::
+                      Sum Maybe (Either SymBool) SymBool ->
+                      Maybe (Sum Maybe (Either Bool) Bool)
+                    toConSum = toCon
+                toConSum (InL (Just symTrue)) @?= Just (InL (Just True))
+                toConSum (InL (Just $ ssymBool "a")) @?= Nothing
+                toConSum (InR (Left symTrue)) @?= Just (InR (Left True))
+                toConSum (InR (Right symTrue)) @?= Just (InR (Right True))
+                toConSum (InR (Left $ ssymBool "a")) @?= Nothing
+                toConSum (InR (Right $ ssymBool "a")) @?= Nothing
+            ],
+          testGroup
+            "WriterT"
+            [ testGroup
+                "Lazy"
+                [ testProperty "WriterT Integer (Either Integer) Integer" $
+                    ioProperty . \(v :: Either Integer (Integer, Integer)) ->
+                      toConForConcreteOkProp $ WriterLazy.WriterT v,
+                  testCase "WriterT SymBool (Either SymBool) SymBool" $ do
+                    let toConWriterT ::
+                          WriterLazy.WriterT SymBool (Either SymBool) SymBool ->
+                          Maybe (WriterLazy.WriterT Bool (Either Bool) Bool)
+                        toConWriterT = toCon
+                    toConWriterT (WriterLazy.WriterT $ Left symTrue)
+                      @?= Just (WriterLazy.WriterT $ Left True)
+                    toConWriterT (WriterLazy.WriterT $ Left $ ssymBool "a")
+                      @?= Nothing
+                    toConWriterT (WriterLazy.WriterT $ Right (symTrue, symTrue))
+                      @?= Just (WriterLazy.WriterT $ Right (True, True))
+                    toConWriterT
+                      (WriterLazy.WriterT $ Right (ssymBool "a", symTrue))
+                      @?= Nothing
+                    toConWriterT
+                      (WriterLazy.WriterT $ Right (symTrue, ssymBool "a"))
+                      @?= Nothing
+                    toConWriterT
+                      (WriterLazy.WriterT $ Right (ssymBool "a", ssymBool "b"))
+                      @?= Nothing
+                ],
+              testGroup
+                "Strict"
+                [ testProperty "WriterT Integer (Either Integer) Integer" $
+                    ioProperty . \(v :: Either Integer (Integer, Integer)) ->
+                      toConForConcreteOkProp $ WriterStrict.WriterT v,
+                  testCase "WriterT SymBool (Either SymBool) SymBool" $ do
+                    let toConWriterT ::
+                          WriterStrict.WriterT
+                            SymBool
+                            (Either SymBool)
+                            SymBool ->
+                          Maybe (WriterStrict.WriterT Bool (Either Bool) Bool)
+                        toConWriterT = toCon
+                    toConWriterT (WriterStrict.WriterT $ Left symTrue)
+                      @?= Just (WriterStrict.WriterT $ Left True)
+                    toConWriterT (WriterStrict.WriterT $ Left $ ssymBool "a")
+                      @?= Nothing
+                    toConWriterT
+                      (WriterStrict.WriterT $ Right (symTrue, symTrue))
+                      @?= Just (WriterStrict.WriterT $ Right (True, True))
+                    toConWriterT
+                      (WriterStrict.WriterT $ Right (ssymBool "a", symTrue))
+                      @?= Nothing
+                    toConWriterT
+                      (WriterStrict.WriterT $ Right (symTrue, ssymBool "a"))
+                      @?= Nothing
+                    toConWriterT
+                      (WriterStrict.WriterT $ Right (ssymBool "a", ssymBool "b"))
+                      @?= Nothing
+                ]
+            ],
+          testGroup
+            "Identity"
+            [ testProperty "Identity Integer" $
+                ioProperty . \(v :: Integer) ->
+                  toConForConcreteOkProp $ Identity v,
+              testCase "Identity SymBool" $ do
+                toCon (Identity symTrue) @?= Just (Identity True)
+                toCon (Identity $ ssymBool "a") @?= (Nothing :: Maybe (Identity Bool))
+            ],
+          testGroup
+            "IdentityT"
+            [ testProperty "IdentityT (Either Integer) Integer" $
+                ioProperty . \(v :: Either Integer Integer) ->
+                  toConForConcreteOkProp $ IdentityT v,
+              testCase "IdentityT (Either SymBool) SymBool" $ do
+                let toConIdentityT ::
+                      IdentityT (Either SymBool) SymBool ->
+                      Maybe (IdentityT (Either Bool) Bool)
+                    toConIdentityT = toCon
+                toConIdentityT (IdentityT $ Left symTrue)
+                  @?= Just (IdentityT $ Left True)
+                toConIdentityT (IdentityT $ Left $ ssymBool "a")
+                  @?= Nothing
+                toConIdentityT (IdentityT $ Right symTrue)
+                  @?= Just (IdentityT $ Right True)
+                toConIdentityT (IdentityT $ Right $ ssymBool "a")
+                  @?= Nothing
+            ]
+        ]
+    ]
diff --git a/test/Grisette/Core/Data/Class/ToSymTests.hs b/test/Grisette/Core/Data/Class/ToSymTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/ToSymTests.hs
@@ -0,0 +1,380 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Grisette.Core.Data.Class.ToSymTests (toSymTests) where
+
+import Control.Monad.Except (ExceptT (ExceptT))
+import Control.Monad.Identity
+  ( Identity (Identity),
+    IdentityT (IdentityT),
+  )
+import Control.Monad.Reader (ReaderT (ReaderT, runReaderT))
+import qualified Control.Monad.State.Lazy as StateLazy
+import qualified Control.Monad.State.Strict as StateStrict
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import qualified Control.Monad.Writer.Lazy as WriterLazy
+import qualified Control.Monad.Writer.Strict as WriterStrict
+import qualified Data.ByteString.Char8 as C
+import Data.Foldable (traverse_)
+import Data.Functor.Sum (Sum (InL, InR))
+import Data.Int (Int16, Int32, Int64, Int8)
+import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.Stack (HasCallStack)
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot, (.&&), (.||)))
+import Grisette.Core.Data.Class.SEq (SEq ((.==)))
+import Grisette.Core.Data.Class.Solvable (Solvable (con, isym, ssym))
+import Grisette.Core.Data.Class.ToSym (ToSym (toSym))
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit (Assertion, (@?=))
+import Test.QuickCheck (ioProperty)
+
+toSymForConcreteOkProp ::
+  (HasCallStack, ToSym v v, Show v, Eq v) => v -> Assertion
+toSymForConcreteOkProp v = toSym v @?= v
+
+toSymTests :: Test
+toSymTests =
+  testGroup
+    "ToSym"
+    [ testGroup
+        "ToSym for common types"
+        [ testGroup
+            "SymBool"
+            [ testCase "From Bool" $ do
+                let bools = [True, False]
+                traverse_ (\v -> toSym v @?= (con v :: SymBool)) bools,
+              testCase "From SymBool" $ do
+                let sbools :: [SymBool] =
+                      [ con True,
+                        ssym "a",
+                        isym "a" 1,
+                        ssym "a" .&& ssym "b",
+                        ssym "a" .|| ssym "b",
+                        symNot (ssym "a"),
+                        (ssym "a" :: SymBool) .== ssym "b",
+                        symIte (ssym "a") (ssym "b") (ssym "c")
+                      ]
+                traverse_ (\v -> toSym v @?= v) sbools
+            ],
+          testProperty "Bool" $ ioProperty . toSymForConcreteOkProp @Bool,
+          testProperty "Integer" $ ioProperty . toSymForConcreteOkProp @Integer,
+          testProperty "Char" $ ioProperty . toSymForConcreteOkProp @Char,
+          testProperty "Int" $ ioProperty . toSymForConcreteOkProp @Int,
+          testProperty "Int8" $ ioProperty . toSymForConcreteOkProp @Int8,
+          testProperty "Int16" $ ioProperty . toSymForConcreteOkProp @Int16,
+          testProperty "Int32" $ ioProperty . toSymForConcreteOkProp @Int32,
+          testProperty "Int64" $ ioProperty . toSymForConcreteOkProp @Int64,
+          testProperty "Word" $ ioProperty . toSymForConcreteOkProp @Word,
+          testProperty "Word8" $ ioProperty . toSymForConcreteOkProp @Word8,
+          testProperty "Word16" $ ioProperty . toSymForConcreteOkProp @Word16,
+          testProperty "Word32" $ ioProperty . toSymForConcreteOkProp @Word32,
+          testProperty "Word64" $ ioProperty . toSymForConcreteOkProp @Word64,
+          testProperty "()" $ ioProperty . toSymForConcreteOkProp @(),
+          testProperty "ByteString" $
+            ioProperty . \(v :: String) ->
+              toSymForConcreteOkProp (C.pack v),
+          testGroup
+            "List"
+            [ testProperty "[Integer]" $
+                ioProperty
+                  . toSymForConcreteOkProp @[Integer],
+              testCase "[SymBool]" $ do
+                toSym ([] :: [Bool]) @?= ([] :: [SymBool])
+                toSym ([True, False] :: [Bool])
+                  @?= ([con True, con False] :: [SymBool])
+            ],
+          testGroup
+            "Maybe"
+            [ testProperty "Maybe Integer" $
+                ioProperty
+                  . toSymForConcreteOkProp @(Maybe Integer),
+              testCase "Maybe SymBool" $ do
+                toSym (Nothing :: Maybe Bool) @?= (Nothing :: Maybe SymBool)
+                toSym (Just True :: Maybe Bool)
+                  @?= (Just $ con True :: Maybe SymBool)
+            ],
+          testGroup
+            "Either"
+            [ testProperty "Either Integer Integer" $
+                ioProperty . toSymForConcreteOkProp @(Either Integer Integer),
+              testCase "Eithe SymBool SymBool" $ do
+                toSym (Left True :: Either Bool Bool)
+                  @?= (Left $ con True :: Either SymBool SymBool)
+                toSym (Right True :: Either Bool Bool)
+                  @?= (Right $ con True :: Either SymBool SymBool)
+            ],
+          testGroup
+            "MaybeT"
+            [ testProperty "MaybeT Maybe Integer" $
+                ioProperty . \(v :: Maybe (Maybe Integer)) ->
+                  toSymForConcreteOkProp $ MaybeT v,
+              testCase "MaybeT Maybe SymBool" $ do
+                toSym (MaybeT Nothing :: MaybeT Maybe Bool)
+                  @?= (MaybeT Nothing :: MaybeT Maybe SymBool)
+                toSym (MaybeT $ Just Nothing :: MaybeT Maybe Bool)
+                  @?= (MaybeT $ Just Nothing :: MaybeT Maybe SymBool)
+                toSym (MaybeT $ Just $ Just True :: MaybeT Maybe Bool)
+                  @?= (MaybeT $ Just $ Just $ con True :: MaybeT Maybe SymBool)
+            ],
+          testGroup
+            "ExceptT"
+            [ testProperty "ExceptT Integer Maybe Integer" $
+                ioProperty . \(v :: Maybe (Either Integer Integer)) ->
+                  toSymForConcreteOkProp $ ExceptT v,
+              testCase "ExceptT SymBool Maybe SymBool" $ do
+                toSym (ExceptT Nothing :: ExceptT Bool Maybe Bool)
+                  @?= (ExceptT Nothing :: ExceptT SymBool Maybe SymBool)
+                toSym (ExceptT $ Just $ Left True :: ExceptT Bool Maybe Bool)
+                  @?= ( ExceptT $ Just $ Left $ con True ::
+                          ExceptT SymBool Maybe SymBool
+                      )
+                toSym (ExceptT $ Just $ Right False :: ExceptT Bool Maybe Bool)
+                  @?= ( ExceptT $ Just $ Right $ con False ::
+                          ExceptT SymBool Maybe SymBool
+                      )
+            ],
+          testGroup
+            "(,)"
+            [ testProperty "(Integer, Integer)" $
+                ioProperty . toSymForConcreteOkProp @(Integer, Integer),
+              testCase "(SymBool, SymBool)" $
+                toSym (True, False)
+                  @?= (con True :: SymBool, con False :: SymBool)
+            ],
+          testGroup
+            "(,,)"
+            [ testProperty "(Integer, Integer, Integer)" $
+                ioProperty
+                  . toSymForConcreteOkProp
+                    @(Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool)" $
+                toSym (True, False, True)
+                  @?= ( con True :: SymBool,
+                        con False :: SymBool,
+                        con True :: SymBool
+                      )
+            ],
+          testGroup
+            "(,,,)"
+            [ testProperty "(Integer, Integer, Integer, Integer)" $
+                ioProperty
+                  . toSymForConcreteOkProp
+                    @(Integer, Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool, SymBool)" $
+                toSym (True, False, True, False)
+                  @?= ( con True :: SymBool,
+                        con False :: SymBool,
+                        con True :: SymBool,
+                        con False :: SymBool
+                      )
+            ],
+          testGroup
+            "(,,,,)"
+            [ testProperty "(Integer, Integer, Integer, Integer, Integer)" $
+                ioProperty
+                  . toSymForConcreteOkProp
+                    @(Integer, Integer, Integer, Integer, Integer),
+              testCase "(SymBool, SymBool, SymBool, SymBool, SymBool)" $
+                toSym (True, False, True, False, True)
+                  @?= ( con True :: SymBool,
+                        con False :: SymBool,
+                        con True :: SymBool,
+                        con False :: SymBool,
+                        con True :: SymBool
+                      )
+            ],
+          testGroup
+            "(,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . toSymForConcreteOkProp
+                    @(Integer, Integer, Integer, Integer, Integer, Integer),
+              testCase
+                "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                $ toSym (True, False, True, False, True, False)
+                  @?= ( con True :: SymBool,
+                        con False :: SymBool,
+                        con True :: SymBool,
+                        con False :: SymBool,
+                        con True :: SymBool,
+                        con False :: SymBool
+                      )
+            ],
+          testGroup
+            "(,,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . toSymForConcreteOkProp
+                    @( Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer
+                     ),
+              testCase "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)" $
+                toSym (True, False, True, False, True, False, True)
+                  @?= ( con True :: SymBool,
+                        con False :: SymBool,
+                        con True :: SymBool,
+                        con False :: SymBool,
+                        con True :: SymBool,
+                        con False :: SymBool,
+                        con True :: SymBool
+                      )
+            ],
+          testGroup
+            "(,,,,,,,)"
+            [ testProperty
+                "(Integer, Integer, Integer, Integer, Integer, Integer, Integer, Integer)"
+                $ ioProperty
+                  . toSymForConcreteOkProp
+                    @( Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer,
+                       Integer
+                     ),
+              testCase
+                "(SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool, SymBool)"
+                $ toSym (True, False, True, False, True, False, True, False)
+                  @?= ( con True :: SymBool,
+                        con False :: SymBool,
+                        con True :: SymBool,
+                        con False :: SymBool,
+                        con True :: SymBool,
+                        con False :: SymBool,
+                        con True :: SymBool,
+                        con False :: SymBool
+                      )
+            ],
+          testGroup
+            "Sum"
+            [ testProperty "Sum Maybe (Either Integer) Integer" $
+                ioProperty
+                  . \(x :: Either (Maybe Integer) (Either Integer Integer)) ->
+                    case x of
+                      Left v ->
+                        toSymForConcreteOkProp
+                          @(Sum Maybe (Either Integer) Integer)
+                          (InL v)
+                      Right v ->
+                        toSymForConcreteOkProp
+                          @(Sum Maybe (Either Integer) Integer)
+                          (InR v),
+              testCase "Sum Maybe (Either SymBool) SymBool" $ do
+                toSym (InL $ Just True :: Sum Maybe (Either Bool) Bool)
+                  @?= ( InL $ Just $ con True ::
+                          Sum Maybe (Either SymBool) SymBool
+                      )
+                toSym (InR $ Left True :: Sum Maybe (Either Bool) Bool)
+                  @?= ( InR $ Left $ con True ::
+                          Sum Maybe (Either SymBool) SymBool
+                      )
+                toSym (InR $ Right False :: Sum Maybe (Either Bool) Bool)
+                  @?= ( InR $ Right $ con False ::
+                          Sum Maybe (Either SymBool) SymBool
+                      )
+            ],
+          testProperty "functions" $
+            ioProperty
+              . \( f :: [(Either Bool Bool, Either Bool Bool)],
+                   x :: Either Bool Bool
+                   ) ->
+                  let func [] _ = Left False
+                      func ((fk, fv) : _) xv | fk == xv = fv
+                      func (_ : fs) xv = func fs xv
+                   in (toSym (func f x) :: Either SymBool SymBool)
+                        @?= toSym (func f) x,
+          testGroup
+            "StateT"
+            [ testProperty "Lazy" $
+                ioProperty
+                  . \( f :: [(Bool, Either Bool (Bool, Bool))],
+                       x :: Bool
+                       ) ->
+                      let func [] _ = Left False
+                          func ((fk, fv) : _) xv | fk == xv = fv
+                          func (_ : fs) xv = func fs xv
+                          st :: StateLazy.StateT Bool (Either Bool) Bool =
+                            StateLazy.StateT (func f)
+                       in ( StateLazy.runStateT (toSym st) x ::
+                              Either SymBool (SymBool, Bool)
+                          )
+                            @?= toSym (func f) x,
+              testProperty "Strict" $
+                ioProperty
+                  . \( f :: [(Bool, Either Bool (Bool, Bool))],
+                       x :: Bool
+                       ) ->
+                      let func [] _ = Left False
+                          func ((fk, fv) : _) xv | fk == xv = fv
+                          func (_ : fs) xv = func fs xv
+                          st :: StateStrict.StateT Bool (Either Bool) Bool =
+                            StateStrict.StateT (func f)
+                       in ( StateStrict.runStateT (toSym st) x ::
+                              Either SymBool (SymBool, Bool)
+                          )
+                            @?= toSym (func f) x
+            ],
+          testGroup
+            "WriterT"
+            [ testProperty "Lazy" $
+                ioProperty . \(f :: Either Bool (Bool, Integer)) ->
+                  let w :: WriterLazy.WriterT Integer (Either Bool) Bool =
+                        WriterLazy.WriterT f
+                   in ( WriterLazy.runWriterT (toSym w) ::
+                          Either SymBool (SymBool, Integer)
+                      )
+                        @?= toSym f,
+              testProperty "Strict" $
+                ioProperty . \(f :: Either Bool (Bool, Integer)) ->
+                  let w :: WriterStrict.WriterT Integer (Either Bool) Bool =
+                        WriterStrict.WriterT f
+                   in ( WriterStrict.runWriterT (toSym w) ::
+                          Either SymBool (SymBool, Integer)
+                      )
+                        @?= toSym f
+            ],
+          testProperty "ReaderT" $
+            ioProperty . \(f :: [(Bool, Either Bool Bool)], x :: Bool) ->
+              let func [] _ = Left False
+                  func ((fk, fv) : _) xv | fk == xv = fv
+                  func (_ : fs) xv = func fs xv
+                  st :: ReaderT Bool (Either Bool) Bool = ReaderT (func f)
+               in (runReaderT (toSym st) x :: Either SymBool SymBool)
+                    @?= toSym (func f) x,
+          testGroup
+            "Identity"
+            [ testProperty "Identity Integer" $
+                ioProperty
+                  . toSymForConcreteOkProp @(Identity Integer),
+              testCase "Identity SymBool" $ do
+                toSym (Identity True :: Identity Bool)
+                  @?= (Identity $ con True :: Identity SymBool)
+            ],
+          testGroup
+            "IdentityT"
+            [ testProperty "IdentityT Maybe Integer" $
+                ioProperty . \x ->
+                  toSymForConcreteOkProp @(IdentityT Maybe Integer)
+                    (IdentityT x),
+              testCase "IdentityT Maybe SymBool" $ do
+                toSym (IdentityT (Just True) :: IdentityT Maybe Bool)
+                  @?= (IdentityT $ Just $ con True :: IdentityT Maybe SymBool)
+                toSym (IdentityT Nothing :: IdentityT Maybe Bool)
+                  @?= (IdentityT Nothing :: IdentityT Maybe SymBool)
+            ]
+        ]
+    ]
diff --git a/test/Grisette/Core/Data/Class/UnionLikeTests.hs b/test/Grisette/Core/Data/Class/UnionLikeTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Core/Data/Class/UnionLikeTests.hs
@@ -0,0 +1,298 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Grisette.Core.Data.Class.UnionLikeTests (unionLikeTests) where
+
+import Control.Monad.Except (ExceptT (ExceptT))
+import Control.Monad.Identity (IdentityT (IdentityT, runIdentityT))
+import Control.Monad.Reader (ReaderT (ReaderT, runReaderT))
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import qualified Control.Monad.Trans.State.Lazy as StateLazy
+import qualified Control.Monad.Trans.State.Strict as StateStrict
+import qualified Control.Monad.Trans.Writer.Lazy as WriterLazy
+import qualified Control.Monad.Trans.Writer.Strict as WriterStrict
+import Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot))
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( UnionLike (single, unionIf),
+    merge,
+    mrgIf,
+    mrgSingle,
+    simpleMerge,
+  )
+import Grisette.Core.Data.Class.Solvable (Solvable (ssym))
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit ((@?=))
+
+unionLikeTests :: Test
+unionLikeTests =
+  testGroup
+    "UnionLike"
+    [ testCase "simpleMerge" $
+        simpleMerge
+          ( unionIf
+              (ssym "a")
+              (single $ ssym "b")
+              (single $ ssym "c") ::
+              UnionM SymBool
+          )
+          @?= symIte (ssym "a") (ssym "b") (ssym "c"),
+      testGroup
+        "UnionLike"
+        [ testGroup
+            "MaybeT"
+            [ testCase "merge" $ do
+                merge
+                  ( MaybeT
+                      ( unionIf
+                          (ssym "a")
+                          (single $ Just $ ssym "b")
+                          (single $ Just $ ssym "c") ::
+                          UnionM (Maybe SymBool)
+                      )
+                  )
+                  @?= MaybeT
+                    (mrgSingle $ Just $ symIte (ssym "a") (ssym "b") (ssym "c")),
+              testCase "mrgSingle" $ do
+                (mrgSingle 1 :: MaybeT UnionM Integer)
+                  @?= MaybeT (mrgSingle $ Just 1),
+              testCase "mrgIf" $
+                do
+                  mrgIf (ssym "a") (mrgSingle $ ssym "b") (mrgSingle $ ssym "c")
+                  @?= MaybeT
+                    ( mrgSingle $
+                        Just $
+                          symIte (ssym "a") (ssym "b") (ssym "c") ::
+                        UnionM (Maybe SymBool)
+                    )
+            ],
+          testGroup
+            "ExceptT"
+            [ testCase "merge" $ do
+                merge
+                  ( ExceptT
+                      ( unionIf
+                          (ssym "a")
+                          (single $ Left $ ssym "b")
+                          (single $ Left $ ssym "c") ::
+                          UnionM (Either SymBool SymBool)
+                      )
+                  )
+                  @?= ExceptT
+                    (mrgSingle $ Left $ symIte (ssym "a") (ssym "b") (ssym "c")),
+              testCase "mrgSingle" $ do
+                (mrgSingle 1 :: ExceptT SymBool UnionM Integer)
+                  @?= ExceptT (mrgSingle $ Right 1),
+              testCase "mrgIf" $
+                do
+                  mrgIf (ssym "a") (mrgSingle $ ssym "b") (mrgSingle $ ssym "c")
+                  @?= ExceptT
+                    ( mrgSingle $
+                        Right $
+                          symIte (ssym "a") (ssym "b") (ssym "c") ::
+                        UnionM (Either SymBool SymBool)
+                    )
+            ],
+          testGroup
+            "StateT"
+            [ testGroup
+                "Lazy"
+                [ testCase "merge" $ do
+                    let s :: StateLazy.StateT SymBool UnionM SymBool =
+                          merge $ StateLazy.StateT $ \(x :: SymBool) ->
+                            unionIf
+                              (ssym "a")
+                              (single (x, symNot x))
+                              (single (symNot x, x))
+                    StateLazy.runStateT s (ssym "b")
+                      @?= mrgSingle
+                        ( symIte (ssym "a") (ssym "b") (symNot $ ssym "b"),
+                          symIte (ssym "a") (symNot $ ssym "b") (ssym "b")
+                        ),
+                  testCase "mrgSingle" $ do
+                    let s :: StateLazy.StateT SymBool UnionM SymBool =
+                          mrgSingle (ssym "x")
+                    StateLazy.runStateT s (ssym "b")
+                      @?= mrgSingle (ssym "x", ssym "b"),
+                  testCase "mrgIf" $ do
+                    let s :: StateLazy.StateT SymBool UnionM SymBool =
+                          mrgIf
+                            (ssym "a")
+                            ( StateLazy.StateT $ \(x :: SymBool) ->
+                                single (x, symNot x)
+                            )
+                            ( StateLazy.StateT $ \(x :: SymBool) ->
+                                single (symNot x, x)
+                            )
+                    StateLazy.runStateT s (ssym "b")
+                      @?= mrgSingle
+                        ( symIte (ssym "a") (ssym "b") (symNot $ ssym "b"),
+                          symIte (ssym "a") (symNot $ ssym "b") (ssym "b")
+                        )
+                ],
+              testGroup
+                "Strict"
+                [ testCase "merge" $ do
+                    let s :: StateStrict.StateT SymBool UnionM SymBool =
+                          merge $ StateStrict.StateT $ \(x :: SymBool) ->
+                            unionIf
+                              (ssym "a")
+                              (single (x, symNot x))
+                              (single (symNot x, x))
+                    StateStrict.runStateT s (ssym "b")
+                      @?= mrgSingle
+                        ( symIte (ssym "a") (ssym "b") (symNot $ ssym "b"),
+                          symIte (ssym "a") (symNot $ ssym "b") (ssym "b")
+                        ),
+                  testCase "mrgSingle" $ do
+                    let s :: StateStrict.StateT SymBool UnionM SymBool =
+                          mrgSingle (ssym "x")
+                    StateStrict.runStateT s (ssym "b")
+                      @?= mrgSingle (ssym "x", ssym "b"),
+                  testCase "mrgIf" $ do
+                    let s :: StateStrict.StateT SymBool UnionM SymBool =
+                          mrgIf
+                            (ssym "a")
+                            ( StateStrict.StateT $ \(x :: SymBool) ->
+                                single (x, symNot x)
+                            )
+                            ( StateStrict.StateT $ \(x :: SymBool) ->
+                                single (symNot x, x)
+                            )
+                    StateStrict.runStateT s (ssym "b")
+                      @?= mrgSingle
+                        ( symIte (ssym "a") (ssym "b") (symNot $ ssym "b"),
+                          symIte (ssym "a") (symNot $ ssym "b") (ssym "b")
+                        )
+                ]
+            ],
+          testGroup
+            "WriterT"
+            [ testGroup
+                "Lazy"
+                [ testCase "merge" $ do
+                    let s :: WriterLazy.WriterT [SymBool] UnionM SymBool =
+                          merge $
+                            WriterLazy.WriterT $
+                              unionIf
+                                (ssym "a")
+                                (single (ssym "b", [ssym "c"]))
+                                (single (ssym "d", [ssym "e"]))
+                    WriterLazy.runWriterT s
+                      @?= mrgSingle
+                        ( symIte (ssym "a") (ssym "b") (ssym "d"),
+                          [symIte (ssym "a") (ssym "c") (ssym "e")]
+                        ),
+                  testCase "mrgSingle" $ do
+                    let s :: WriterLazy.WriterT [SymBool] UnionM SymBool =
+                          mrgSingle (ssym "x")
+                    WriterLazy.runWriterT s @?= mrgSingle (ssym "x", []),
+                  testCase "mrgIf" $ do
+                    let s :: WriterLazy.WriterT [SymBool] UnionM SymBool =
+                          mrgIf
+                            (ssym "a")
+                            (WriterLazy.WriterT $ single (ssym "b", [ssym "c"]))
+                            (WriterLazy.WriterT $ single (ssym "d", [ssym "e"]))
+                    WriterLazy.runWriterT s
+                      @?= mrgSingle
+                        ( symIte (ssym "a") (ssym "b") (ssym "d"),
+                          [symIte (ssym "a") (ssym "c") (ssym "e")]
+                        )
+                ],
+              testGroup
+                "Strict"
+                [ testCase "merge" $ do
+                    let s :: WriterStrict.WriterT [SymBool] UnionM SymBool =
+                          merge $
+                            WriterStrict.WriterT $
+                              unionIf
+                                (ssym "a")
+                                (single (ssym "b", [ssym "c"]))
+                                (single (ssym "d", [ssym "e"]))
+                    WriterStrict.runWriterT s
+                      @?= mrgSingle
+                        ( symIte (ssym "a") (ssym "b") (ssym "d"),
+                          [symIte (ssym "a") (ssym "c") (ssym "e")]
+                        ),
+                  testCase "mrgSingle" $ do
+                    let s :: WriterStrict.WriterT [SymBool] UnionM SymBool =
+                          mrgSingle (ssym "x")
+                    WriterStrict.runWriterT s @?= mrgSingle (ssym "x", []),
+                  testCase "mrgIf" $ do
+                    let s :: WriterStrict.WriterT [SymBool] UnionM SymBool =
+                          mrgIf
+                            (ssym "a")
+                            ( WriterStrict.WriterT $
+                                single (ssym "b", [ssym "c"])
+                            )
+                            ( WriterStrict.WriterT $
+                                single (ssym "d", [ssym "e"])
+                            )
+                    WriterStrict.runWriterT s
+                      @?= mrgSingle
+                        ( symIte (ssym "a") (ssym "b") (ssym "d"),
+                          [symIte (ssym "a") (ssym "c") (ssym "e")]
+                        )
+                ]
+            ],
+          testGroup
+            "ReaderT"
+            [ testCase "merge" $
+                do
+                  let s :: ReaderT SymBool UnionM SymBool =
+                        merge $ ReaderT $ \(x :: SymBool) ->
+                          unionIf (ssym "a") (single x) (single $ symNot x)
+                  runReaderT s (ssym "b")
+                    @?= mrgSingle
+                      (symIte (ssym "a") (ssym "b") (symNot $ ssym "b")),
+              testCase
+                "mrgSingle"
+                $ do
+                  let s :: ReaderT SymBool UnionM SymBool = mrgSingle (ssym "x")
+                  runReaderT s (ssym "b") @?= mrgSingle (ssym "x"),
+              testCase
+                "mrgIf"
+                $ do
+                  let s :: ReaderT SymBool UnionM SymBool =
+                        mrgIf
+                          (ssym "a")
+                          (ReaderT $ \(x :: SymBool) -> single x)
+                          (ReaderT $ \(x :: SymBool) -> single $ symNot x)
+                  runReaderT s (ssym "b")
+                    @?= mrgSingle
+                      (symIte (ssym "a") (ssym "b") (symNot $ ssym "b"))
+            ],
+          testGroup
+            "IdentityT"
+            [ testCase "merge" $
+                do
+                  let s :: IdentityT UnionM SymBool =
+                        merge $
+                          IdentityT $
+                            unionIf
+                              (ssym "a")
+                              (single $ ssym "b")
+                              (single $ ssym "c")
+                  runIdentityT s
+                    @?= mrgSingle (symIte (ssym "a") (ssym "b") (ssym "c")),
+              testCase
+                "mrgSingle"
+                $ do
+                  let s :: IdentityT UnionM SymBool = mrgSingle (ssym "x")
+                  runIdentityT s @?= mrgSingle (ssym "x"),
+              testCase
+                "mrgIf"
+                $ do
+                  let s :: IdentityT UnionM SymBool =
+                        mrgIf
+                          (ssym "a")
+                          (IdentityT $ single (ssym "b"))
+                          (IdentityT $ single (ssym "c"))
+                  runIdentityT s
+                    @?= mrgSingle (symIte (ssym "a") (ssym "b") (ssym "c"))
+            ]
+        ]
+    ]
diff --git a/test/Grisette/IR/SymPrim/Data/Prim/BVTests.hs b/test/Grisette/IR/SymPrim/Data/Prim/BVTests.hs
--- a/test/Grisette/IR/SymPrim/Data/Prim/BVTests.hs
+++ b/test/Grisette/IR/SymPrim/Data/Prim/BVTests.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -27,7 +28,7 @@
 bvTests :: Test
 bvTests =
   testGroup
-    "BVTests"
+    "BV"
     [ testGroup
         "pevalBVSelectTerm"
         [ testCase "On concrete" $ do
diff --git a/test/Grisette/IR/SymPrim/Data/Prim/BitsTests.hs b/test/Grisette/IR/SymPrim/Data/Prim/BitsTests.hs
--- a/test/Grisette/IR/SymPrim/Data/Prim/BitsTests.hs
+++ b/test/Grisette/IR/SymPrim/Data/Prim/BitsTests.hs
@@ -1,16 +1,24 @@
+{-# LANGUAGE BinaryLiterals #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Grisette.IR.SymPrim.Data.Prim.BitsTests (bitsTests) where
 
+import Data.Bits (Bits (rotateL, rotateR), FiniteBits)
 import Grisette.Core.Data.BV (IntN, WordN)
+import Grisette.Core.Data.Class.SymRotate (SymRotate)
+import Grisette.IR.SymPrim (SupportedPrim)
 import Grisette.IR.SymPrim.Data.Prim.InternedTerm.InternedCtors
   ( andBitsTerm,
     complementBitsTerm,
     conTerm,
     orBitsTerm,
-    rotateBitsTerm,
-    shiftBitsTerm,
+    rotateLeftTerm,
+    rotateRightTerm,
+    shiftLeftTerm,
+    shiftRightTerm,
     ssymTerm,
     xorBitsTerm,
   )
@@ -19,18 +27,22 @@
   ( pevalAndBitsTerm,
     pevalComplementBitsTerm,
     pevalOrBitsTerm,
-    pevalRotateBitsTerm,
-    pevalShiftBitsTerm,
+    pevalRotateLeftTerm,
+    pevalRotateRightTerm,
+    pevalShiftLeftTerm,
+    pevalShiftRightTerm,
     pevalXorBitsTerm,
   )
 import Test.Framework (Test, testGroup)
 import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Test.HUnit ((@=?))
+import Test.QuickCheck (Property, discard, ioProperty)
 
 bitsTests :: Test
 bitsTests =
   testGroup
-    "BitsTests"
+    "Bits"
     [ testGroup
         "AndBits"
         [ testCase "On both concrete" $ do
@@ -155,73 +167,146 @@
               @=? complementBitsTerm (ssymTerm "a" :: Term (WordN 4))
         ],
       testGroup
-        "ShiftBits"
+        "ShiftLeft"
         [ testCase "On concrete" $ do
-            pevalShiftBitsTerm (conTerm 15 :: Term (WordN 4)) (-5) @=? conTerm 0
-            pevalShiftBitsTerm (conTerm 15 :: Term (WordN 4)) (-4) @=? conTerm 0
-            pevalShiftBitsTerm (conTerm 15 :: Term (WordN 4)) (-3) @=? conTerm 1
-            pevalShiftBitsTerm (conTerm 15 :: Term (WordN 4)) (-2) @=? conTerm 3
-            pevalShiftBitsTerm (conTerm 15 :: Term (WordN 4)) (-1) @=? conTerm 7
-            pevalShiftBitsTerm (conTerm 15 :: Term (WordN 4)) 0 @=? conTerm 15
-            pevalShiftBitsTerm (conTerm 15 :: Term (WordN 4)) 1 @=? conTerm 14
-            pevalShiftBitsTerm (conTerm 15 :: Term (WordN 4)) 2 @=? conTerm 12
-            pevalShiftBitsTerm (conTerm 15 :: Term (WordN 4)) 3 @=? conTerm 8
-            pevalShiftBitsTerm (conTerm 15 :: Term (WordN 4)) 4 @=? conTerm 0
-            pevalShiftBitsTerm (conTerm 15 :: Term (WordN 4)) 5 @=? conTerm 0
-
-            pevalShiftBitsTerm (conTerm 15 :: Term (IntN 4)) (-5) @=? conTerm 15
-            pevalShiftBitsTerm (conTerm 15 :: Term (IntN 4)) (-4) @=? conTerm 15
-            pevalShiftBitsTerm (conTerm 15 :: Term (IntN 4)) (-3) @=? conTerm 15
-            pevalShiftBitsTerm (conTerm 15 :: Term (IntN 4)) (-2) @=? conTerm 15
-            pevalShiftBitsTerm (conTerm 15 :: Term (IntN 4)) (-1) @=? conTerm 15
-            pevalShiftBitsTerm (conTerm 15 :: Term (IntN 4)) 0 @=? conTerm 15
-            pevalShiftBitsTerm (conTerm 15 :: Term (IntN 4)) 1 @=? conTerm 14
-            pevalShiftBitsTerm (conTerm 15 :: Term (IntN 4)) 2 @=? conTerm 12
-            pevalShiftBitsTerm (conTerm 15 :: Term (IntN 4)) 3 @=? conTerm 8
-            pevalShiftBitsTerm (conTerm 15 :: Term (IntN 4)) 4 @=? conTerm 0
-            pevalShiftBitsTerm (conTerm 15 :: Term (IntN 4)) 5 @=? conTerm 0,
+            pevalShiftLeftTerm (conTerm 15 :: Term (WordN 4)) (conTerm 2) @=? conTerm 12
+            pevalShiftLeftTerm (conTerm 15 :: Term (IntN 4)) (conTerm 2) @=? conTerm 12,
           testCase "shift 0" $ do
-            pevalShiftBitsTerm (ssymTerm "a" :: Term (WordN 4)) 0 @=? ssymTerm "a"
-            pevalShiftBitsTerm (ssymTerm "a" :: Term (IntN 4)) 0 @=? ssymTerm "a",
-          testCase "shift left bitsize" $ do
-            pevalShiftBitsTerm (ssymTerm "a" :: Term (WordN 4)) 4 @=? conTerm 0
-            pevalShiftBitsTerm (ssymTerm "a" :: Term (IntN 4)) 4 @=? conTerm 0
-            pevalShiftBitsTerm (ssymTerm "a" :: Term (WordN 4)) 5 @=? conTerm 0
-            pevalShiftBitsTerm (ssymTerm "a" :: Term (IntN 4)) 5 @=? conTerm 0,
-          testCase "shift same direction twice" $ do
-            pevalShiftBitsTerm (pevalShiftBitsTerm (ssymTerm "a" :: Term (WordN 4)) 1) 2
-              @=? pevalShiftBitsTerm (ssymTerm "a" :: Term (WordN 4)) 3
-            pevalShiftBitsTerm (pevalShiftBitsTerm (ssymTerm "a" :: Term (WordN 4)) (-1)) (-2)
-              @=? pevalShiftBitsTerm (ssymTerm "a" :: Term (WordN 4)) (-3),
+            pevalShiftLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 0) @=? ssymTerm "a"
+            pevalShiftLeftTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 0) @=? ssymTerm "a",
+          testCase "shift greater or equal to left bitsize" $ do
+            pevalShiftLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 4) @=? conTerm 0
+            pevalShiftLeftTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 4) @=? conTerm 0
+            pevalShiftLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 5) @=? conTerm 0
+            pevalShiftLeftTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 5) @=? conTerm 0,
+          testCase "shift negative amount is undefined on for IntN" $ do
+            pevalShiftLeftTerm (conTerm 15 :: Term (IntN 4)) (conTerm $ -1)
+              @=? shiftLeftTerm (conTerm 15) (conTerm $ -1)
+            pevalShiftLeftTerm (conTerm 15 :: Term (IntN 4)) (conTerm $ -8)
+              @=? shiftLeftTerm (conTerm 15) (conTerm $ -8),
           testCase "shift symbolic" $ do
-            pevalShiftBitsTerm (ssymTerm "a" :: Term (WordN 4)) 2
-              @=? shiftBitsTerm (ssymTerm "a" :: Term (WordN 4)) 2
+            pevalShiftLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 2)
+              @=? shiftLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 2),
+          testCase "Regression: shift by very large number" $ do
+            pevalShiftLeftTerm (conTerm 15 :: Term (IntN 128)) (conTerm maxBound) @=? conTerm 0
+            pevalShiftLeftTerm (conTerm 15 :: Term (WordN 128)) (conTerm maxBound) @=? conTerm 0
         ],
       testGroup
-        "Rotate"
+        "ShiftRight"
+        [ testCase "On concrete, should perform arithmetic shifting on IntN" $ do
+            pevalShiftRightTerm (conTerm 7 :: Term (IntN 4)) (conTerm 2) @=? conTerm 1
+            pevalShiftRightTerm (conTerm 15 :: Term (IntN 4)) (conTerm 2) @=? conTerm 15,
+          testCase "On concrete, should perform logical shifting on WordN" $ do
+            pevalShiftRightTerm (conTerm 7 :: Term (WordN 4)) (conTerm 2) @=? conTerm 1
+            pevalShiftRightTerm (conTerm 15 :: Term (WordN 4)) (conTerm 2) @=? conTerm 3,
+          testCase "shift 0" $ do
+            pevalShiftRightTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 0) @=? ssymTerm "a"
+            pevalShiftRightTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 0) @=? ssymTerm "a",
+          testCase "shift greater or equal to left bitsize on WordN" $ do
+            pevalShiftRightTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 4) @=? conTerm 0
+            pevalShiftRightTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 5) @=? conTerm 0,
+          testCase "shift greater or equal to left bitsize on IntN will not be reduced" $ do
+            pevalShiftRightTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 5)
+              @=? shiftRightTerm (ssymTerm "a") (conTerm 5)
+            pevalShiftRightTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 4)
+              @=? shiftRightTerm (ssymTerm "a") (conTerm 4),
+          testCase "shift negative amount is undefined on for IntN" $ do
+            pevalShiftRightTerm (conTerm 15 :: Term (IntN 4)) (conTerm $ -1)
+              @=? shiftRightTerm (conTerm 15) (conTerm $ -1)
+            pevalShiftRightTerm (conTerm 15 :: Term (IntN 4)) (conTerm $ -8)
+              @=? shiftRightTerm (conTerm 15) (conTerm $ -8),
+          testCase "shift symbolic" $ do
+            pevalShiftRightTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 2)
+              @=? shiftRightTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 2),
+          testCase "Regression: shift by very large number" $ do
+            pevalShiftRightTerm (conTerm 15 :: Term (IntN 128)) (conTerm maxBound) @=? conTerm 0
+            pevalShiftRightTerm (conTerm 15 :: Term (WordN 128)) (conTerm maxBound) @=? conTerm 0
+        ],
+      testGroup
+        "RotateLeft"
         [ testCase "On concrete" $ do
-            pevalRotateBitsTerm (conTerm 3 :: Term (WordN 4)) (-4) @=? conTerm 3
-            pevalRotateBitsTerm (conTerm 3 :: Term (WordN 4)) (-3) @=? conTerm 6
-            pevalRotateBitsTerm (conTerm 3 :: Term (WordN 4)) (-2) @=? conTerm 12
-            pevalRotateBitsTerm (conTerm 3 :: Term (WordN 4)) (-1) @=? conTerm 9
-            pevalRotateBitsTerm (conTerm 3 :: Term (WordN 4)) 0 @=? conTerm 3
-            pevalRotateBitsTerm (conTerm 3 :: Term (WordN 4)) 1 @=? conTerm 6
-            pevalRotateBitsTerm (conTerm 3 :: Term (WordN 4)) 2 @=? conTerm 12
-            pevalRotateBitsTerm (conTerm 3 :: Term (WordN 4)) 3 @=? conTerm 9
-            pevalRotateBitsTerm (conTerm 3 :: Term (WordN 4)) 4 @=? conTerm 3,
+            pevalRotateLeftTerm (conTerm 0b10100101 :: Term (WordN 8)) (conTerm 2) @=? conTerm 0b10010110
+            pevalRotateLeftTerm (conTerm 0b10100101 :: Term (IntN 8)) (conTerm 2) @=? conTerm 0b10010110,
           testCase "rotate 0" $ do
-            pevalRotateBitsTerm (ssymTerm "a" :: Term (WordN 4)) 0 @=? ssymTerm "a",
-          testCase "rotate extra bits" $ do
-            pevalRotateBitsTerm (ssymTerm "a" :: Term (WordN 4)) 4 @=? ssymTerm "a"
-            pevalRotateBitsTerm (ssymTerm "a" :: Term (WordN 4)) 5
-              @=? pevalRotateBitsTerm (ssymTerm "a") 1
-            pevalRotateBitsTerm (ssymTerm "a" :: Term (WordN 4)) (-1)
-              @=? pevalRotateBitsTerm (ssymTerm "a") 3,
-          testCase "rotate twice" $ do
-            pevalRotateBitsTerm (pevalRotateBitsTerm (ssymTerm "a" :: Term (WordN 4)) 1) 2
-              @=? pevalRotateBitsTerm (ssymTerm "a") 3,
+            pevalRotateLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 0) @=? ssymTerm "a"
+            pevalRotateLeftTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 0) @=? ssymTerm "a",
+          testCase "rotate bitsize" $ do
+            pevalRotateLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 4)
+              @=? ssymTerm "a"
+            pevalRotateLeftTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 4)
+              @=? ssymTerm "a",
+          testCase "rotate greater than left bitsize" $ do
+            pevalRotateLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 5)
+              @=? rotateLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 1)
+            pevalRotateLeftTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 5)
+              @=? rotateLeftTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 1),
+          testCase "rotate negative amount is undefined on for IntN" $ do
+            pevalRotateLeftTerm (conTerm 15 :: Term (IntN 4)) (conTerm $ -1)
+              @=? rotateLeftTerm (conTerm 15) (conTerm $ -1)
+            pevalRotateLeftTerm (conTerm 15 :: Term (IntN 4)) (conTerm $ -8)
+              @=? rotateLeftTerm (conTerm 15) (conTerm $ -8),
           testCase "rotate symbolic" $ do
-            pevalRotateBitsTerm (ssymTerm "a" :: Term (WordN 4)) 2
-              @=? rotateBitsTerm (ssymTerm "a" :: Term (WordN 4)) 2
+            pevalRotateLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 2)
+              @=? rotateLeftTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 2),
+          testCase "Regression: rotate by very large number" $ do
+            pevalRotateLeftTerm (conTerm 15 :: Term (IntN 128)) (conTerm maxBound) @=? conTerm (rotateR 15 1)
+            pevalRotateLeftTerm (conTerm 15 :: Term (WordN 128)) (conTerm maxBound) @=? conTerm (rotateR 15 1)
+        ],
+      testGroup
+        "RotateRight"
+        [ testProperty "On concrete WordN 1" $
+            concreteSmallRotateRightCorrect @(WordN 1),
+          testProperty "On concrete WordN 2" $
+            concreteSmallRotateRightCorrect @(WordN 2),
+          testProperty "On concrete WordN 3" $
+            concreteSmallRotateRightCorrect @(WordN 3),
+          testProperty "On concrete WordN 4" $
+            concreteSmallRotateRightCorrect @(WordN 4),
+          testProperty "On concrete WordN 8" $
+            concreteSmallRotateRightCorrect @(WordN 8),
+          testProperty "On concrete IntN 1" $
+            concreteSmallRotateRightCorrect @(IntN 1),
+          testProperty "On concrete IntN 2" $
+            concreteSmallRotateRightCorrect @(IntN 2),
+          testProperty "On concrete IntN 3" $
+            concreteSmallRotateRightCorrect @(IntN 3),
+          testProperty "On concrete IntN 4" $
+            concreteSmallRotateRightCorrect @(IntN 4),
+          testProperty "On concrete IntN 8" $
+            concreteSmallRotateRightCorrect @(IntN 8),
+          testCase "rotate 0" $ do
+            pevalRotateRightTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 0) @=? ssymTerm "a"
+            pevalRotateRightTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 0) @=? ssymTerm "a",
+          testCase "rotate bitsize" $ do
+            pevalRotateRightTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 4)
+              @=? ssymTerm "a"
+            pevalRotateRightTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 4)
+              @=? ssymTerm "a",
+          testCase "rotate greater than left bitsize" $ do
+            pevalRotateRightTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 5)
+              @=? rotateRightTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 1)
+            pevalRotateRightTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 5)
+              @=? rotateRightTerm (ssymTerm "a" :: Term (IntN 4)) (conTerm 1),
+          testCase "rotate negative amount is undefined on for IntN" $ do
+            pevalRotateRightTerm (conTerm 15 :: Term (IntN 4)) (conTerm $ -1)
+              @=? rotateRightTerm (conTerm 15) (conTerm $ -1)
+            pevalRotateRightTerm (conTerm 15 :: Term (IntN 4)) (conTerm $ -8)
+              @=? rotateRightTerm (conTerm 15) (conTerm $ -8),
+          testCase "rotate symbolic" $ do
+            pevalRotateRightTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 2)
+              @=? rotateRightTerm (ssymTerm "a" :: Term (WordN 4)) (conTerm 2),
+          testCase "Regression: rotate by very large number" $ do
+            pevalRotateRightTerm (conTerm 15 :: Term (IntN 128)) (conTerm maxBound) @=? conTerm (rotateL 15 1)
+            pevalRotateRightTerm (conTerm 15 :: Term (WordN 128)) (conTerm maxBound) @=? conTerm (rotateL 15 1)
         ]
     ]
+
+concreteSmallRotateRightCorrect ::
+  (SupportedPrim a, Integral a, FiniteBits a, SymRotate a) =>
+  a ->
+  a ->
+  Property
+concreteSmallRotateRightCorrect _ b | b < 0 = discard
+concreteSmallRotateRightCorrect a b = ioProperty $ do
+  pevalRotateRightTerm (conTerm a) (conTerm b)
+    @=? conTerm (rotateR a (fromIntegral b))
diff --git a/test/Grisette/IR/SymPrim/Data/Prim/BoolTests.hs b/test/Grisette/IR/SymPrim/Data/Prim/BoolTests.hs
--- a/test/Grisette/IR/SymPrim/Data/Prim/BoolTests.hs
+++ b/test/Grisette/IR/SymPrim/Data/Prim/BoolTests.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Grisette.IR.SymPrim.Data.Prim.BoolTests (boolTests) where
@@ -34,7 +35,7 @@
 boolTests :: Test
 boolTests =
   testGroup
-    "BoolTests"
+    "Bool"
     [ testGroup
         "Not"
         [ testCase "On concrete" $ do
diff --git a/test/Grisette/IR/SymPrim/Data/Prim/IntegralTests.hs b/test/Grisette/IR/SymPrim/Data/Prim/IntegralTests.hs
--- a/test/Grisette/IR/SymPrim/Data/Prim/IntegralTests.hs
+++ b/test/Grisette/IR/SymPrim/Data/Prim/IntegralTests.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -180,7 +181,7 @@
 integralTests :: Test
 integralTests =
   testGroup
-    "IntegralTests"
+    "Integral"
     [ divisionPevalUnboundedTestGroup "Div unbounded" pevalDivIntegralTerm div divIntegralTerm,
       divisionPevalUnboundedTestGroup "Quot unbounded" pevalQuotIntegralTerm quot quotIntegralTerm,
       divisionPevalBoundedTestGroup "Div bounded" pevalDivBoundedIntegralTerm div divBoundedIntegralTerm,
diff --git a/test/Grisette/IR/SymPrim/Data/Prim/ModelTests.hs b/test/Grisette/IR/SymPrim/Data/Prim/ModelTests.hs
--- a/test/Grisette/IR/SymPrim/Data/Prim/ModelTests.hs
+++ b/test/Grisette/IR/SymPrim/Data/Prim/ModelTests.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Grisette.IR.SymPrim.Data.Prim.ModelTests (modelTests) where
@@ -61,7 +62,7 @@
       m2 = insertValue asymbol 1 m1
       m3 = insertValue bsymbol True m2
    in testGroup
-        "ModelTests"
+        "Model"
         [ testCase "empty model is really empty" $ do
             emptyModel @=? Model M.empty,
           testCase "inserting to model" $ do
diff --git a/test/Grisette/IR/SymPrim/Data/Prim/NumTests.hs b/test/Grisette/IR/SymPrim/Data/Prim/NumTests.hs
--- a/test/Grisette/IR/SymPrim/Data/Prim/NumTests.hs
+++ b/test/Grisette/IR/SymPrim/Data/Prim/NumTests.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Grisette.IR.SymPrim.Data.Prim.NumTests (numTests) where
@@ -38,7 +39,7 @@
 numTests :: Test
 numTests =
   testGroup
-    "NumTests"
+    "Num"
     [ testGroup
         "Add"
         [ testCase "On concrete" $ do
@@ -206,10 +207,16 @@
         [ testCase "On concrete" $ do
             pevalAbsNumTerm (conTerm 10 :: Term Integer) @=? conTerm 10
             pevalAbsNumTerm (conTerm $ -10 :: Term Integer) @=? conTerm 10,
-          testCase "On UMinus" $ do
+          testCase "On UMinus Integer" $ do
             pevalAbsNumTerm (pevalUMinusNumTerm $ ssymTerm "a" :: Term Integer) @=? pevalAbsNumTerm (ssymTerm "a"),
-          testCase "On Abs" $ do
+          testCase "On UMinus BV" $ do
+            pevalAbsNumTerm (pevalUMinusNumTerm $ ssymTerm "a" :: Term (IntN 5)) @=? pevalAbsNumTerm (ssymTerm "a")
+            pevalAbsNumTerm (pevalUMinusNumTerm $ ssymTerm "a" :: Term (WordN 5)) @=? uminusNumTerm (ssymTerm "a"),
+          testCase "On Abs Integer" $ do
             pevalAbsNumTerm (pevalAbsNumTerm $ ssymTerm "a" :: Term Integer) @=? pevalAbsNumTerm (ssymTerm "a"),
+          testCase "On Abs BV" $ do
+            pevalAbsNumTerm (pevalAbsNumTerm $ ssymTerm "a" :: Term (IntN 5)) @=? pevalAbsNumTerm (ssymTerm "a")
+            pevalAbsNumTerm (pevalAbsNumTerm $ ssymTerm "a" :: Term (WordN 5)) @=? ssymTerm "a",
           testCase "On Times Integer" $ do
             pevalAbsNumTerm (pevalTimesNumTerm (ssymTerm "a") (ssymTerm "b") :: Term Integer)
               @=? pevalTimesNumTerm (pevalAbsNumTerm (ssymTerm "a")) (pevalAbsNumTerm (ssymTerm "b")),
@@ -217,10 +224,13 @@
             pevalAbsNumTerm (pevalTimesNumTerm (ssymTerm "a") (ssymTerm "b") :: Term (IntN 5))
               @=? absNumTerm (pevalTimesNumTerm (ssymTerm "a") (ssymTerm "b") :: Term (IntN 5))
             pevalAbsNumTerm (pevalTimesNumTerm (ssymTerm "a") (ssymTerm "b") :: Term (WordN 5))
-              @=? absNumTerm (pevalTimesNumTerm (ssymTerm "a") (ssymTerm "b") :: Term (WordN 5)),
-          testCase "On symbolic" $ do
+              @=? pevalTimesNumTerm (ssymTerm "a") (ssymTerm "b"),
+          testCase "On symbolic Integer" $ do
             pevalAbsNumTerm (ssymTerm "a" :: Term Integer)
-              @=? absNumTerm (ssymTerm "a")
+              @=? absNumTerm (ssymTerm "a"),
+          testCase "On symbolic BV" $ do
+            pevalAbsNumTerm (ssymTerm "a" :: Term (IntN 5)) @=? absNumTerm (ssymTerm "a")
+            pevalAbsNumTerm (ssymTerm "a" :: Term (WordN 5)) @=? ssymTerm "a"
         ],
       testGroup
         "Signum"
diff --git a/test/Grisette/IR/SymPrim/Data/Prim/TabularFunTests.hs b/test/Grisette/IR/SymPrim/Data/Prim/TabularFunTests.hs
--- a/test/Grisette/IR/SymPrim/Data/Prim/TabularFunTests.hs
+++ b/test/Grisette/IR/SymPrim/Data/Prim/TabularFunTests.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators #-}
 
@@ -26,7 +27,7 @@
 tabularFunTests :: Test
 tabularFunTests =
   testGroup
-    "TabularFunTests"
+    "TabularFun"
     [ testGroup
         "ApplyF"
         [ testCase "On concrete" $ do
diff --git a/test/Grisette/IR/SymPrim/Data/SymPrimTests.hs b/test/Grisette/IR/SymPrim/Data/SymPrimTests.hs
--- a/test/Grisette/IR/SymPrim/Data/SymPrimTests.hs
+++ b/test/Grisette/IR/SymPrim/Data/SymPrimTests.hs
@@ -48,23 +48,22 @@
         sizedBVZext
       ),
   )
-import Grisette.Core.Data.Class.Bool
-  ( ITEOp (ites),
-    LogicalOp (implies, nots, xors, (&&~), (||~)),
-    SEq ((/=~), (==~)),
-  )
-import Grisette.Core.Data.Class.Evaluate
+import Grisette.Core.Data.Class.EvaluateSym
   ( EvaluateSym (evaluateSym),
   )
 import Grisette.Core.Data.Class.ExtractSymbolics
   ( ExtractSymbolics (extractSymbolics),
   )
-import Grisette.Core.Data.Class.Function (Function ((#)))
+import Grisette.Core.Data.Class.Function (Apply (apply), Function ((#)))
 import Grisette.Core.Data.Class.GenSym
   ( genSym,
     genSymSimple,
     nameWithInfo,
   )
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.LogicalOp
+  ( LogicalOp (symImplies, symNot, symXor, (.&&), (.||)),
+  )
 import Grisette.Core.Data.Class.Mergeable
   ( Mergeable (rootStrategy),
     MergingStrategy (SimpleStrategy),
@@ -73,10 +72,11 @@
   ( ModelOps (emptyModel, insertValue),
     ModelRep (buildModel),
   )
+import Grisette.Core.Data.Class.SEq (SEq ((./=), (.==)))
 import Grisette.Core.Data.Class.SOrd
-  ( SOrd (symCompare, (<=~), (<~), (>=~), (>~)),
+  ( SOrd (symCompare, (.<), (.<=), (.>), (.>=)),
   )
-import Grisette.Core.Data.Class.SafeArith
+import Grisette.Core.Data.Class.SafeDivision
   ( SafeDivision
       ( safeDiv,
         safeDiv',
@@ -91,7 +91,9 @@
         safeRem,
         safeRem'
       ),
-    SafeLinearArith
+  )
+import Grisette.Core.Data.Class.SafeLinearArith
+  ( SafeLinearArith
       ( safeAdd,
         safeAdd',
         safeMinus,
@@ -138,8 +140,10 @@
   ( pevalAndBitsTerm,
     pevalComplementBitsTerm,
     pevalOrBitsTerm,
-    pevalRotateBitsTerm,
-    pevalShiftBitsTerm,
+    pevalRotateLeftTerm,
+    pevalRotateRightTerm,
+    pevalShiftLeftTerm,
+    pevalShiftRightTerm,
     pevalXorBitsTerm,
   )
 import Grisette.IR.SymPrim.Data.Prim.PartialEval.Bool
@@ -302,10 +306,10 @@
     testCase "on symbolic" $ do
       f (ssym "a" :: s) (ssym "b")
         @=? ( mrgIf
-                ((ssym "b" :: s) ==~ con (0 :: c) :: SymBool)
+                ((ssym "b" :: s) .== con (0 :: c) :: SymBool)
                 (throwError DivideByZero)
                 ( mrgIf
-                    ((ssym "b" :: s) ==~ con (-1) &&~ (ssym "a" :: s) ==~ con (minBound :: c) :: SymBool)
+                    ((ssym "b" :: s) .== con (-1) .&& (ssym "a" :: s) .== con (minBound :: c) :: SymBool)
                     (throwError Overflow)
                     (mrgSingle $ wrapTerm $ pf (ssymTerm "a") (ssymTerm "b"))
                 ) ::
@@ -313,10 +317,10 @@
             )
       f' (const ()) (ssym "a" :: s) (ssym "b")
         @=? ( mrgIf
-                ((ssym "b" :: s) ==~ con (0 :: c) :: SymBool)
+                ((ssym "b" :: s) .== con (0 :: c) :: SymBool)
                 (throwError ())
                 ( mrgIf
-                    ((ssym "b" :: s) ==~ con (-1) &&~ (ssym "a" :: s) ==~ con (minBound :: c) :: SymBool)
+                    ((ssym "b" :: s) .== con (-1) .&& (ssym "a" :: s) .== con (minBound :: c) :: SymBool)
                     (throwError ())
                     (mrgSingle $ wrapTerm $ pf (ssymTerm "a") (ssymTerm "b"))
                 ) ::
@@ -335,14 +339,14 @@
   [ testCase "on symbolic" $ do
       f (ssym "a" :: s) (ssym "b")
         @=? ( mrgIf
-                ((ssym "b" :: s) ==~ con (0 :: c) :: SymBool)
+                ((ssym "b" :: s) .== con (0 :: c) :: SymBool)
                 (throwError DivideByZero)
                 (mrgSingle $ wrapTerm $ pf (ssymTerm "a") (ssymTerm "b")) ::
                 ExceptT ArithException UnionM s
             )
       f' (const ()) (ssym "a" :: s) (ssym "b")
         @=? ( mrgIf
-                ((ssym "b" :: s) ==~ con (0 :: c) :: SymBool)
+                ((ssym "b" :: s) .== con (0 :: c) :: SymBool)
                 (throwError ())
                 (mrgSingle $ wrapTerm $ pf (ssymTerm "a") (ssymTerm "b")) ::
                 ExceptT () UnionM s
@@ -429,10 +433,10 @@
     testCase "on symbolic" $ do
       f (ssym "a" :: s) (ssym "b")
         @=? ( mrgIf
-                ((ssym "b" :: s) ==~ con (0 :: c) :: SymBool)
+                ((ssym "b" :: s) .== con (0 :: c) :: SymBool)
                 (throwError DivideByZero)
                 ( mrgIf
-                    ((ssym "b" :: s) ==~ con (-1) &&~ (ssym "a" :: s) ==~ con (minBound :: c) :: SymBool)
+                    ((ssym "b" :: s) .== con (-1) .&& (ssym "a" :: s) .== con (minBound :: c) :: SymBool)
                     (throwError Overflow)
                     ( mrgSingle
                         ( wrapTerm $ pf1 (ssymTerm "a") (ssymTerm "b"),
@@ -444,10 +448,10 @@
             )
       f' (const ()) (ssym "a" :: s) (ssym "b")
         @=? ( mrgIf
-                ((ssym "b" :: s) ==~ con (0 :: c) :: SymBool)
+                ((ssym "b" :: s) .== con (0 :: c) :: SymBool)
                 (throwError ())
                 ( mrgIf
-                    ((ssym "b" :: s) ==~ con (-1) &&~ (ssym "a" :: s) ==~ con (minBound :: c) :: SymBool)
+                    ((ssym "b" :: s) .== con (-1) .&& (ssym "a" :: s) .== con (minBound :: c) :: SymBool)
                     (throwError ())
                     ( mrgSingle
                         ( wrapTerm $ pf1 (ssymTerm "a") (ssymTerm "b"),
@@ -478,7 +482,7 @@
   [ testCase "on symbolic" $ do
       f (ssym "a" :: s) (ssym "b")
         @=? ( mrgIf
-                ((ssym "b" :: s) ==~ con (0 :: c) :: SymBool)
+                ((ssym "b" :: s) .== con (0 :: c) :: SymBool)
                 (throwError DivideByZero)
                 ( mrgSingle
                     ( wrapTerm $ pf1 (ssymTerm "a") (ssymTerm "b"),
@@ -489,7 +493,7 @@
             )
       f' (const ()) (ssym "a" :: s) (ssym "b")
         @=? ( mrgIf
-                ((ssym "b" :: s) ==~ con (0 :: c) :: SymBool)
+                ((ssym "b" :: s) .== con (0 :: c) :: SymBool)
                 (throwError ())
                 ( mrgSingle
                     ( wrapTerm $ pf1 (ssymTerm "a") (ssymTerm "b"),
@@ -583,7 +587,7 @@
 symPrimTests :: Test
 symPrimTests =
   testGroup
-    "SymPrimTests"
+    "SymPrim"
     [ testGroup
         "General SymPrim"
         [ testGroup
@@ -603,17 +607,17 @@
             ],
           testGroup
             "ITEOp"
-            [ testCase "ites" $
-                ites (ssym "a" :: SymBool) (ssym "b" :: SymInteger) (ssym "c")
+            [ testCase "symIte" $
+                symIte (ssym "a" :: SymBool) (ssym "b" :: SymInteger) (ssym "c")
                   @=? SymInteger (pevalITETerm (ssymTerm "a") (ssymTerm "b") (ssymTerm "c"))
             ],
           testCase "Mergeable" $ do
             let SimpleStrategy s = rootStrategy :: MergingStrategy SymInteger
             s (ssym "a") (ssym "b") (ssym "c")
-              @=? ites (ssym "a" :: SymBool) (ssym "b" :: SymInteger) (ssym "c"),
+              @=? symIte (ssym "a" :: SymBool) (ssym "b" :: SymInteger) (ssym "c"),
           testCase "SimpleMergeable" $
             mrgIte (ssym "a" :: SymBool) (ssym "b") (ssym "c")
-              @=? ites (ssym "a" :: SymBool) (ssym "b" :: SymInteger) (ssym "c"),
+              @=? symIte (ssym "a" :: SymBool) (ssym "b" :: SymInteger) (ssym "c"),
           testCase "IsString" $ ("a" :: SymBool) @=? SymBool (ssymTerm "a"),
           testGroup
             "ToSym"
@@ -629,11 +633,11 @@
             let m1 = emptyModel :: Model
             let m2 = insertValue (SimpleSymbol "a") (1 :: Integer) m1
             let m3 = insertValue (SimpleSymbol "b") True m2
-            evaluateSym False m3 (ites ("c" :: SymBool) "a" ("a" + "a" :: SymInteger))
-              @=? ites ("c" :: SymBool) 1 2
-            evaluateSym True m3 (ites ("c" :: SymBool) "a" ("a" + "a" :: SymInteger)) @=? 2,
+            evaluateSym False m3 (symIte ("c" :: SymBool) "a" ("a" + "a" :: SymInteger))
+              @=? symIte ("c" :: SymBool) 1 2
+            evaluateSym True m3 (symIte ("c" :: SymBool) "a" ("a" + "a" :: SymInteger)) @=? 2,
           testCase "ExtractSymbolics" $
-            extractSymbolics (ites ("c" :: SymBool) ("a" :: SymInteger) ("b" :: SymInteger))
+            extractSymbolics (symIte ("c" :: SymBool) ("a" :: SymInteger) ("b" :: SymInteger))
               @=? SymbolSet
                 ( S.fromList
                     [ someTypedSymbol (SimpleSymbol "c" :: TypedSymbol Bool),
@@ -649,18 +653,18 @@
             (genSym () (nameWithInfo "a" True) :: UnionM SymBool) @=? mrgSingle (iinfosym "a" 0 True)
             (genSymSimple () (nameWithInfo "a" True) :: SymBool) @=? iinfosym "a" 0 True,
           testCase "SEq" $ do
-            (ssym "a" :: SymBool) ==~ ssym "b" @=? SymBool (pevalEqvTerm (ssymTerm "a" :: Term Bool) (ssymTerm "b"))
-            (ssym "a" :: SymBool) /=~ ssym "b" @=? SymBool (pevalNotTerm $ pevalEqvTerm (ssymTerm "a" :: Term Bool) (ssymTerm "b"))
+            (ssym "a" :: SymBool) .== ssym "b" @=? SymBool (pevalEqvTerm (ssymTerm "a" :: Term Bool) (ssymTerm "b"))
+            (ssym "a" :: SymBool) ./= ssym "b" @=? SymBool (pevalNotTerm $ pevalEqvTerm (ssymTerm "a" :: Term Bool) (ssymTerm "b"))
         ],
       testGroup
         "SymBool"
         [ testGroup
             "LogicalOp"
-            [ testCase "||~" $ ssym "a" ||~ ssym "b" @=? SymBool (pevalOrTerm (ssymTerm "a") (ssymTerm "b")),
-              testCase "&&~" $ ssym "a" &&~ ssym "b" @=? SymBool (pevalAndTerm (ssymTerm "a") (ssymTerm "b")),
-              testCase "nots" $ nots (ssym "a") @=? SymBool (pevalNotTerm (ssymTerm "a")),
-              testCase "xors" $ xors (ssym "a") (ssym "b") @=? SymBool (pevalXorTerm (ssymTerm "a") (ssymTerm "b")),
-              testCase "implies" $ implies (ssym "a") (ssym "b") @=? SymBool (pevalImplyTerm (ssymTerm "a") (ssymTerm "b"))
+            [ testCase ".||" $ ssym "a" .|| ssym "b" @=? SymBool (pevalOrTerm (ssymTerm "a") (ssymTerm "b")),
+              testCase ".&&" $ ssym "a" .&& ssym "b" @=? SymBool (pevalAndTerm (ssymTerm "a") (ssymTerm "b")),
+              testCase "symNot" $ symNot (ssym "a") @=? SymBool (pevalNotTerm (ssymTerm "a")),
+              testCase "symXor" $ symXor (ssym "a") (ssym "b") @=? SymBool (pevalXorTerm (ssymTerm "a") (ssymTerm "b")),
+              testCase "symImplies" $ symImplies (ssym "a") (ssym "b") @=? SymBool (pevalImplyTerm (ssymTerm "a") (ssymTerm "b"))
             ]
         ],
       testGroup
@@ -723,10 +727,10 @@
           testGroup
             "SOrd"
             [ testProperty "SOrd on concrete" $ \(i :: Integer, j :: Integer) -> ioProperty $ do
-                (con i :: SymInteger) <=~ con j @=? (con (i <= j) :: SymBool)
-                (con i :: SymInteger) <~ con j @=? (con (i < j) :: SymBool)
-                (con i :: SymInteger) >=~ con j @=? (con (i >= j) :: SymBool)
-                (con i :: SymInteger) >~ con j @=? (con (i > j) :: SymBool)
+                (con i :: SymInteger) .<= con j @=? (con (i <= j) :: SymBool)
+                (con i :: SymInteger) .< con j @=? (con (i < j) :: SymBool)
+                (con i :: SymInteger) .>= con j @=? (con (i >= j) :: SymBool)
+                (con i :: SymInteger) .> con j @=? (con (i > j) :: SymBool)
                 (con i :: SymInteger)
                   `symCompare` con j
                   @=? (i `symCompare` j :: UnionM Ordering),
@@ -735,12 +739,12 @@
                 let b :: SymInteger = ssym "b"
                 let at :: Term Integer = ssymTerm "a"
                 let bt :: Term Integer = ssymTerm "b"
-                a <=~ b @=? SymBool (pevalLeNumTerm at bt)
-                a <~ b @=? SymBool (pevalLtNumTerm at bt)
-                a >=~ b @=? SymBool (pevalGeNumTerm at bt)
-                a >~ b @=? SymBool (pevalGtNumTerm at bt)
+                a .<= b @=? SymBool (pevalLeNumTerm at bt)
+                a .< b @=? SymBool (pevalLtNumTerm at bt)
+                a .>= b @=? SymBool (pevalGeNumTerm at bt)
+                a .> b @=? SymBool (pevalGtNumTerm at bt)
                 (a `symCompare` ssym "b" :: UnionM Ordering)
-                  @=? mrgIf (a <~ b) (mrgSingle LT) (mrgIf (a ==~ b) (mrgSingle EQ) (mrgSingle GT))
+                  @=? mrgIf (a .< b) (mrgSingle LT) (mrgIf (a .== b) (mrgSingle EQ) (mrgSingle GT))
             ]
         ],
       let au :: SymWordN 4 = ssym "a"
@@ -808,10 +812,10 @@
                               jint = fromIntegral j
                            in safeAdd (toSym i :: SymIntN 8) (toSym j)
                                 @=? mrgIf
-                                  (iint + jint <~ fromIntegral (i + j))
+                                  (iint + jint .< fromIntegral (i + j))
                                   (throwError Underflow)
                                   ( mrgIf
-                                      (iint + jint >~ fromIntegral (i + j))
+                                      (iint + jint .> fromIntegral (i + j))
                                       (throwError Overflow)
                                       (mrgSingle $ toSym $ i + j :: ExceptT ArithException UnionM (SymIntN 8))
                                   ),
@@ -821,10 +825,10 @@
                               jint = fromIntegral j
                            in safeMinus (toSym i :: SymIntN 8) (toSym j)
                                 @=? mrgIf
-                                  (iint - jint <~ fromIntegral (i - j))
+                                  (iint - jint .< fromIntegral (i - j))
                                   (throwError Underflow)
                                   ( mrgIf
-                                      (iint - jint >~ fromIntegral (i - j))
+                                      (iint - jint .> fromIntegral (i - j))
                                       (throwError Overflow)
                                       (mrgSingle $ toSym $ i - j :: ExceptT ArithException UnionM (SymIntN 8))
                                   ),
@@ -833,10 +837,10 @@
                           let iint = fromIntegral i :: Integer
                            in safeNeg (toSym i :: SymIntN 8)
                                 @=? mrgIf
-                                  (-iint <~ fromIntegral (-i))
+                                  (-iint .< fromIntegral (-i))
                                   (throwError Underflow)
                                   ( mrgIf
-                                      (-iint >~ fromIntegral (-i))
+                                      (-iint .> fromIntegral (-i))
                                       (throwError Overflow)
                                       (mrgSingle $ toSym $ -i :: ExceptT ArithException UnionM (SymIntN 8))
                                   )
@@ -849,10 +853,10 @@
                               jint = fromIntegral j
                            in safeAdd (toSym i :: SymWordN 8) (toSym j)
                                 @=? mrgIf
-                                  (iint + jint <~ fromIntegral (i + j))
+                                  (iint + jint .< fromIntegral (i + j))
                                   (throwError Underflow)
                                   ( mrgIf
-                                      (iint + jint >~ fromIntegral (i + j))
+                                      (iint + jint .> fromIntegral (i + j))
                                       (throwError Overflow)
                                       (mrgSingle $ toSym $ i + j :: ExceptT ArithException UnionM (SymWordN 8))
                                   ),
@@ -862,10 +866,10 @@
                               jint = fromIntegral j
                            in safeMinus (toSym i :: SymWordN 8) (toSym j)
                                 @=? mrgIf
-                                  (iint - jint <~ fromIntegral (i - j))
+                                  (iint - jint .< fromIntegral (i - j))
                                   (throwError Underflow)
                                   ( mrgIf
-                                      (iint - jint >~ fromIntegral (i - j))
+                                      (iint - jint .> fromIntegral (i - j))
                                       (throwError Overflow)
                                       (mrgSingle $ toSym $ i - j :: ExceptT ArithException UnionM (SymWordN 8))
                                   ),
@@ -874,10 +878,10 @@
                           let iint = fromIntegral i :: Integer
                            in safeNeg (toSym i :: SymWordN 8)
                                 @=? mrgIf
-                                  (-iint <~ fromIntegral (-i))
+                                  (-iint .< fromIntegral (-i))
                                   (throwError Underflow)
                                   ( mrgIf
-                                      (-iint >~ fromIntegral (-i))
+                                      (-iint .> fromIntegral (-i))
                                       (throwError Overflow)
                                       (mrgSingle $ toSym $ -i :: ExceptT ArithException UnionM (SymWordN 8))
                                   )
@@ -892,34 +896,34 @@
                     let js :: IntN 4 = fromInteger j
                     let normalizeu k = k - k `div` 16 * 16
                     let normalizes k = if normalizeu k >= 8 then normalizeu k - 16 else normalizeu k
-                    (con iu :: SymWordN 4) <=~ con ju @=? (con (normalizeu i <= normalizeu j) :: SymBool)
-                    (con iu :: SymWordN 4) <~ con ju @=? (con (normalizeu i < normalizeu j) :: SymBool)
-                    (con iu :: SymWordN 4) >=~ con ju @=? (con (normalizeu i >= normalizeu j) :: SymBool)
-                    (con iu :: SymWordN 4) >~ con ju @=? (con (normalizeu i > normalizeu j) :: SymBool)
+                    (con iu :: SymWordN 4) .<= con ju @=? (con (normalizeu i <= normalizeu j) :: SymBool)
+                    (con iu :: SymWordN 4) .< con ju @=? (con (normalizeu i < normalizeu j) :: SymBool)
+                    (con iu :: SymWordN 4) .>= con ju @=? (con (normalizeu i >= normalizeu j) :: SymBool)
+                    (con iu :: SymWordN 4) .> con ju @=? (con (normalizeu i > normalizeu j) :: SymBool)
                     (con iu :: SymWordN 4)
                       `symCompare` con ju
                       @=? (normalizeu i `symCompare` normalizeu j :: UnionM Ordering)
-                    (con is :: SymIntN 4) <=~ con js @=? (con (normalizes i <= normalizes j) :: SymBool)
-                    (con is :: SymIntN 4) <~ con js @=? (con (normalizes i < normalizes j) :: SymBool)
-                    (con is :: SymIntN 4) >=~ con js @=? (con (normalizes i >= normalizes j) :: SymBool)
-                    (con is :: SymIntN 4) >~ con js @=? (con (normalizes i > normalizes j) :: SymBool)
+                    (con is :: SymIntN 4) .<= con js @=? (con (normalizes i <= normalizes j) :: SymBool)
+                    (con is :: SymIntN 4) .< con js @=? (con (normalizes i < normalizes j) :: SymBool)
+                    (con is :: SymIntN 4) .>= con js @=? (con (normalizes i >= normalizes j) :: SymBool)
+                    (con is :: SymIntN 4) .> con js @=? (con (normalizes i > normalizes j) :: SymBool)
                     (con is :: SymIntN 4)
                       `symCompare` con js
                       @=? (normalizes i `symCompare` normalizes j :: UnionM Ordering),
                   testCase "SOrd on symbolic" $ do
-                    au <=~ bu @=? SymBool (pevalLeNumTerm aut but)
-                    au <~ bu @=? SymBool (pevalLtNumTerm aut but)
-                    au >=~ bu @=? SymBool (pevalGeNumTerm aut but)
-                    au >~ bu @=? SymBool (pevalGtNumTerm aut but)
+                    au .<= bu @=? SymBool (pevalLeNumTerm aut but)
+                    au .< bu @=? SymBool (pevalLtNumTerm aut but)
+                    au .>= bu @=? SymBool (pevalGeNumTerm aut but)
+                    au .> bu @=? SymBool (pevalGtNumTerm aut but)
                     (au `symCompare` bu :: UnionM Ordering)
-                      @=? mrgIf (au <~ bu) (mrgSingle LT) (mrgIf (au ==~ bu) (mrgSingle EQ) (mrgSingle GT))
+                      @=? mrgIf (au .< bu) (mrgSingle LT) (mrgIf (au .== bu) (mrgSingle EQ) (mrgSingle GT))
 
-                    as <=~ bs @=? SymBool (pevalLeNumTerm ast bst)
-                    as <~ bs @=? SymBool (pevalLtNumTerm ast bst)
-                    as >=~ bs @=? SymBool (pevalGeNumTerm ast bst)
-                    as >~ bs @=? SymBool (pevalGtNumTerm ast bst)
+                    as .<= bs @=? SymBool (pevalLeNumTerm ast bst)
+                    as .< bs @=? SymBool (pevalLtNumTerm ast bst)
+                    as .>= bs @=? SymBool (pevalGeNumTerm ast bst)
+                    as .> bs @=? SymBool (pevalGtNumTerm ast bst)
                     (as `symCompare` bs :: UnionM Ordering)
-                      @=? mrgIf (as <~ bs) (mrgSingle LT) (mrgIf (as ==~ bs) (mrgSingle EQ) (mrgSingle GT))
+                      @=? mrgIf (as .< bs) (mrgSingle LT) (mrgIf (as .== bs) (mrgSingle EQ) (mrgSingle GT))
                 ],
               testGroup
                 "Bits"
@@ -936,11 +940,15 @@
                     complement au @=? SymWordN (pevalComplementBitsTerm aut)
                     complement as @=? SymIntN (pevalComplementBitsTerm ast),
                   testCase "shift" $ do
-                    shift au 1 @=? SymWordN (pevalShiftBitsTerm aut 1)
-                    shift as 1 @=? SymIntN (pevalShiftBitsTerm ast 1),
+                    shift au 1 @=? SymWordN (pevalShiftLeftTerm aut $ conTerm 1)
+                    shift as 1 @=? SymIntN (pevalShiftLeftTerm ast $ conTerm 1)
+                    shift au (-1) @=? SymWordN (pevalShiftRightTerm aut $ conTerm 1)
+                    shift as (-1) @=? SymIntN (pevalShiftRightTerm ast $ conTerm 1),
                   testCase "rotate" $ do
-                    rotate au 1 @=? SymWordN (pevalRotateBitsTerm aut 1)
-                    rotate as 1 @=? SymIntN (pevalRotateBitsTerm ast 1),
+                    rotate au 1 @=? SymWordN (pevalRotateLeftTerm aut $ conTerm 1)
+                    rotate as 1 @=? SymIntN (pevalRotateLeftTerm ast $ conTerm 1)
+                    rotate au (-1) @=? SymWordN (pevalRotateRightTerm aut $ conTerm 1)
+                    rotate as (-1) @=? SymIntN (pevalRotateRightTerm ast $ conTerm 1),
                   testCase "bitSize" $ do
                     bitSizeMaybe au @=? Just 4
                     bitSizeMaybe as @=? Just 4,
@@ -1020,10 +1028,23 @@
             ],
       testGroup
         "TabularFun"
-        [ testCase "apply" $
+        [ testCase "#" $
             (ssym "a" :: SymInteger =~> SymInteger)
               # ssym "b"
-              @=? SymInteger (pevalTabularFunApplyTerm (ssymTerm "a" :: Term (Integer =-> Integer)) (ssymTerm "b"))
+              @=? SymInteger (pevalTabularFunApplyTerm (ssymTerm "a" :: Term (Integer =-> Integer)) (ssymTerm "b")),
+          testCase "apply" $
+            apply
+              (ssym "f" :: SymInteger =~> SymInteger =~> SymInteger)
+              (ssym "a")
+              (ssym "b")
+              @=? SymInteger
+                ( pevalTabularFunApplyTerm
+                    ( pevalTabularFunApplyTerm
+                        (ssymTerm "f" :: Term (Integer =-> Integer =-> Integer))
+                        (ssymTerm "a")
+                    )
+                    (ssymTerm "b")
+                )
         ],
       testGroup
         "GeneralFun"
@@ -1037,7 +1058,15 @@
               False
               (buildModel ("a" := (1 :: Integer), "b" := (2 :: Integer), "c" := (3 :: Integer)))
               (con ("a" --> con ("b" --> "a" + "b" + "c")) :: SymInteger -~> SymInteger -~> SymInteger)
-              @=? con ("a" --> con ("b" --> "a" + "b" + 3) :: Integer --> Integer --> Integer)
+              @=? con ("a" --> con ("b" --> "a" + "b" + 3) :: Integer --> Integer --> Integer),
+          testCase "#" $ do
+            let f :: SymInteger -~> SymInteger -~> SymInteger =
+                  con ("a" --> con ("b" --> "a" + "b"))
+            f # ssym "x" @=? con ("b" --> "x" + "b"),
+          testCase "apply" $ do
+            let f :: SymInteger -~> SymInteger -~> SymInteger =
+                  con ("a" --> con ("b" --> "a" + "b"))
+            apply f "x" "y" @=? "x" + "y"
         ],
       testGroup
         "Symbolic size"
@@ -1047,7 +1076,7 @@
             symSize (con 1 + ssym "a" :: SymInteger) @=? 3
             symSize (ssym "a" + ssym "a" :: SymInteger) @=? 2
             symSize (-(ssym "a") :: SymInteger) @=? 2
-            symSize (ites (ssym "a" :: SymBool) (ssym "b") (ssym "c") :: SymInteger) @=? 4,
+            symSize (symIte (ssym "a" :: SymBool) (ssym "b") (ssym "c") :: SymInteger) @=? 4,
           testCase "symsSize" $ symsSize [ssym "a" :: SymInteger, ssym "a" + ssym "a"] @=? 2
         ],
       let asymbol :: TypedSymbol Integer = "a"
diff --git a/test/Grisette/IR/SymPrim/Data/TabularFunTests.hs b/test/Grisette/IR/SymPrim/Data/TabularFunTests.hs
--- a/test/Grisette/IR/SymPrim/Data/TabularFunTests.hs
+++ b/test/Grisette/IR/SymPrim/Data/TabularFunTests.hs
@@ -14,7 +14,7 @@
 tabularFunTests :: Test
 tabularFunTests =
   testGroup
-    "TabularFunTests"
+    "TabularFun"
     [ testCase "Tabular application" $ do
         let f :: Integer =-> Integer = TabularFun [(1, 2), (3, 4)] 5
         (f # 0) @=? 5
diff --git a/test/Grisette/Lib/Control/Monad/ExceptTests.hs b/test/Grisette/Lib/Control/Monad/ExceptTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Lib/Control/Monad/ExceptTests.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Grisette.Lib.Control.Monad.ExceptTests (monadExceptFunctionTests) where
+
+import Control.Monad.Trans.Except (ExceptT (ExceptT), runExceptT)
+import Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( UnionLike (unionIf),
+    mrgSingle,
+  )
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Grisette.Lib.Control.Monad.Except
+  ( mrgCatchError,
+    mrgThrowError,
+  )
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit ((@?=))
+
+monadExceptFunctionTests :: Test
+monadExceptFunctionTests =
+  testGroup
+    "Except"
+    [ testCase "mrgThrowError" $
+        runExceptT (mrgThrowError 1 :: ExceptT Integer UnionM ())
+          @?= mrgSingle (Left 1),
+      testCase "mrgCatchError" $
+        ( ExceptT (unionIf "a" (return $ Left "b") (return $ Right "c")) ::
+            ExceptT SymBool UnionM SymBool
+        )
+          `mrgCatchError` return
+          @?= mrgSingle (symIte "a" "b" "c")
+    ]
diff --git a/test/Grisette/Lib/Control/Monad/State/ClassTests.hs b/test/Grisette/Lib/Control/Monad/State/ClassTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Lib/Control/Monad/State/ClassTests.hs
@@ -0,0 +1,36 @@
+module Grisette.Lib.Control.Monad.State.ClassTests
+  ( monadStateClassTests,
+  )
+where
+
+import Control.Monad.State.Lazy (state)
+import Control.Monad.Trans.State.Lazy (runStateT)
+import Grisette.Lib.Control.Monad.State.Class
+  ( mrgGet,
+    mrgGets,
+    mrgModify,
+    mrgModify',
+    mrgPut,
+    mrgState,
+  )
+import Grisette.Lib.Control.Monad.Trans.State.Common
+  ( mrgGetTest,
+    mrgGetsTest,
+    mrgModifyTest,
+    mrgPutTest,
+    mrgStateTest,
+  )
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+
+monadStateClassTests :: Test
+monadStateClassTests =
+  testGroup
+    "Class"
+    [ testCase "mrgState" $ mrgStateTest mrgState runStateT,
+      testCase "mrgGet" $ mrgGetTest state runStateT mrgGet,
+      testCase "mrgPut" $ mrgPutTest state runStateT mrgPut,
+      testCase "mrgModify" $ mrgModifyTest state runStateT mrgModify,
+      testCase "mrgModify'" $ mrgModifyTest state runStateT mrgModify',
+      testCase "mrgGets" $ mrgGetsTest state runStateT mrgGets
+    ]
diff --git a/test/Grisette/Lib/Control/Monad/Trans/ClassTests.hs b/test/Grisette/Lib/Control/Monad/Trans/ClassTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Lib/Control/Monad/Trans/ClassTests.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Grisette.Lib.Control.Monad.Trans.ClassTests
+  ( monadTransClassTests,
+  )
+where
+
+import Control.Monad.Except (ExceptT)
+import Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Data.Class.ITEOp (ITEOp (symIte))
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( UnionLike (single, unionIf),
+    mrgSingle,
+  )
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Grisette.Lib.Control.Monad.Trans (mrgLift)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit ((@?=))
+
+monadTransClassTests :: Test
+monadTransClassTests =
+  testGroup
+    "Class"
+    [ testCase "mrgLift" $ do
+        ( mrgLift
+            ( unionIf "a" (single "b") (single "c") ::
+                UnionM SymBool
+            ) ::
+            ExceptT SymBool UnionM SymBool
+          )
+          @?= mrgSingle (symIte "a" "b" "c")
+    ]
diff --git a/test/Grisette/Lib/Control/Monad/Trans/State/Common.hs b/test/Grisette/Lib/Control/Monad/Trans/State/Common.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Lib/Control/Monad/Trans/State/Common.hs
@@ -0,0 +1,288 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Grisette.Lib.Control.Monad.Trans.State.Common
+  ( mrgStateTest,
+    mrgRunStateTTest,
+    mrgEvalStateTTest,
+    mrgExecStateTTest,
+    mrgMapStateTTest,
+    mrgWithStateTTest,
+    mrgGetTest,
+    mrgPutTest,
+    mrgModifyTest,
+    mrgGetsTest,
+  )
+where
+
+import Grisette.Core.Control.Monad.UnionM (UnionM, unionSize)
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp ((.&&)))
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( SimpleMergeable (mrgIte),
+    UnionLike (unionIf),
+    mrgSingle,
+  )
+import Grisette.Core.Data.Class.TestValues (ssymBool)
+import Grisette.IR.SymPrim.Data.SymPrim (SymBool)
+import Grisette.TestUtil.SymbolicAssertion ((@?=~))
+import Test.HUnit (Assertion, (@?=))
+
+type StateFunc stateT s a = (s -> (a, s)) -> stateT s UnionM a
+
+type RunStateFunc stateT s a = stateT s UnionM a -> s -> UnionM (a, s)
+
+type EvalStateFunc stateT s a = stateT s UnionM a -> s -> UnionM a
+
+type ExecStateFunc stateT s a = stateT s UnionM a -> s -> UnionM s
+
+type MapStateFunc stateT s a =
+  (UnionM (a, s) -> UnionM (a, s)) ->
+  stateT s UnionM a ->
+  stateT s UnionM a
+
+type WithStateFunc stateT s a =
+  (s -> s) ->
+  stateT s UnionM a ->
+  stateT s UnionM a
+
+type GetFunc stateT s a = stateT s UnionM s
+
+type PutFunc stateT s a = s -> stateT s UnionM ()
+
+type ModifyFunc stateT s a = (s -> s) -> stateT s UnionM ()
+
+type GetsFunc stateT s a = (s -> a) -> stateT s UnionM a
+
+stateA ::
+  StateFunc stateT SymBool SymBool -> stateT SymBool UnionM SymBool
+stateA state = state (\s -> (s .&& ssymBool "av", s .&& ssymBool "as"))
+
+stateB ::
+  StateFunc stateT SymBool SymBool -> stateT SymBool UnionM SymBool
+stateB state = state (\s -> (s .&& ssymBool "bv", s .&& ssymBool "bs"))
+
+stateAB ::
+  (UnionLike (stateT SymBool UnionM)) =>
+  StateFunc stateT SymBool SymBool ->
+  stateT SymBool UnionM SymBool
+stateAB state =
+  unionIf
+    (ssymBool "c")
+    (stateA state)
+    (stateB state)
+
+mrgStateTest ::
+  (UnionLike (stateT SymBool UnionM)) =>
+  StateFunc stateT SymBool SymBool ->
+  RunStateFunc stateT SymBool SymBool ->
+  Assertion
+mrgStateTest mrgState runStateT = do
+  let a =
+        mrgState (\s -> (s .&& ssymBool "av", s .&& ssymBool "as"))
+  let b =
+        mrgState (\s -> (s .&& ssymBool "bv", s .&& ssymBool "bs"))
+  let actual = runStateT (unionIf (ssymBool "c") a b) (ssymBool "d")
+  let expected =
+        mrgSingle
+          ( mrgIte
+              (ssymBool "c")
+              ( ssymBool "d" .&& ssymBool "av",
+                ssymBool "d" .&& ssymBool "as"
+              )
+              ( ssymBool "d" .&& ssymBool "bv",
+                ssymBool "d" .&& ssymBool "bs"
+              )
+          )
+  unionSize actual @?= 1
+  actual @?=~ expected
+
+mrgRunStateTTest ::
+  (UnionLike (stateT SymBool UnionM)) =>
+  StateFunc stateT SymBool SymBool ->
+  RunStateFunc stateT SymBool SymBool ->
+  Assertion
+mrgRunStateTTest state mrgRunStateT = do
+  let actual = mrgRunStateT (stateAB state) (ssymBool "d")
+  let expected =
+        mrgSingle
+          ( mrgIte
+              (ssymBool "c")
+              ( ssymBool "d" .&& ssymBool "av",
+                ssymBool "d" .&& ssymBool "as"
+              )
+              ( ssymBool "d" .&& ssymBool "bv",
+                ssymBool "d" .&& ssymBool "bs"
+              )
+          )
+  unionSize actual @?= 1
+  actual @?=~ expected
+
+mrgEvalStateTTest ::
+  (UnionLike (stateT SymBool UnionM)) =>
+  StateFunc stateT SymBool SymBool ->
+  EvalStateFunc stateT SymBool SymBool ->
+  Assertion
+mrgEvalStateTTest state mrgEvalStateT = do
+  let actual = mrgEvalStateT (stateAB state) (ssymBool "d")
+  let expected =
+        mrgSingle
+          ( mrgIte
+              (ssymBool "c")
+              (ssymBool "d" .&& ssymBool "av")
+              (ssymBool "d" .&& ssymBool "bv")
+          )
+  unionSize actual @?= 1
+  actual @?=~ expected
+
+mrgExecStateTTest ::
+  (UnionLike (stateT SymBool UnionM)) =>
+  StateFunc stateT SymBool SymBool ->
+  ExecStateFunc stateT SymBool SymBool ->
+  Assertion
+mrgExecStateTTest state mrgExecStateT = do
+  let actual = mrgExecStateT (stateAB state) (ssymBool "d")
+  let expected =
+        mrgSingle
+          ( mrgIte
+              (ssymBool "c")
+              (ssymBool "d" .&& ssymBool "as")
+              (ssymBool "d" .&& ssymBool "bs")
+          )
+  unionSize actual @?= 1
+  actual @?=~ expected
+
+mrgMapStateTTest ::
+  (UnionLike (stateT SymBool UnionM)) =>
+  StateFunc stateT SymBool SymBool ->
+  RunStateFunc stateT SymBool SymBool ->
+  MapStateFunc stateT SymBool SymBool ->
+  Assertion
+mrgMapStateTTest state runStateT mrgMapStateT = do
+  let a = mrgMapStateT id (stateA state)
+  let b = mrgMapStateT id (stateB state)
+  let actual = runStateT (unionIf (ssymBool "c") a b) (ssymBool "d")
+  let expected =
+        mrgSingle
+          ( mrgIte
+              (ssymBool "c")
+              ( ssymBool "d" .&& ssymBool "av",
+                ssymBool "d" .&& ssymBool "as"
+              )
+              ( ssymBool "d" .&& ssymBool "bv",
+                ssymBool "d" .&& ssymBool "bs"
+              )
+          )
+  unionSize actual @?= 1
+  actual @?=~ expected
+
+mrgWithStateTTest ::
+  (UnionLike (stateT SymBool UnionM)) =>
+  StateFunc stateT SymBool SymBool ->
+  RunStateFunc stateT SymBool SymBool ->
+  WithStateFunc stateT SymBool SymBool ->
+  Assertion
+mrgWithStateTTest state runStateT mrgWithStateT = do
+  let a = mrgWithStateT (.&& ssymBool "x") (stateA state)
+  let b = mrgWithStateT (.&& ssymBool "y") (stateB state)
+  let actual = runStateT (unionIf (ssymBool "c") a b) (ssymBool "d")
+  let expected =
+        mrgSingle
+          ( mrgIte
+              (ssymBool "c")
+              ( ssymBool "d" .&& ssymBool "av" .&& ssymBool "x",
+                ssymBool "d" .&& ssymBool "as" .&& ssymBool "x"
+              )
+              ( ssymBool "d" .&& ssymBool "bv" .&& ssymBool "y",
+                ssymBool "d" .&& ssymBool "bs" .&& ssymBool "y"
+              )
+          )
+  unionSize actual @?= 1
+  actual @?=~ expected
+
+mrgGetTest ::
+  (UnionLike (stateT SymBool UnionM), Monad (stateT SymBool UnionM)) =>
+  StateFunc stateT SymBool SymBool ->
+  RunStateFunc stateT SymBool SymBool ->
+  GetFunc stateT SymBool SymBool ->
+  Assertion
+mrgGetTest state runStateT mrgGet = do
+  let a = do stateA state; mrgGet
+  let b = do stateB state; mrgGet
+  let actual = runStateT (unionIf (ssymBool "c") a b) (ssymBool "d")
+  let expected =
+        mrgSingle
+          ( mrgIte
+              (ssymBool "c")
+              ( ssymBool "d" .&& ssymBool "as",
+                ssymBool "d" .&& ssymBool "as"
+              )
+              ( ssymBool "d" .&& ssymBool "bs",
+                ssymBool "d" .&& ssymBool "bs"
+              )
+          )
+  unionSize actual @?= 1
+  actual @?=~ expected
+
+mrgPutTest ::
+  (UnionLike (stateT SymBool UnionM), Monad (stateT SymBool UnionM)) =>
+  StateFunc stateT SymBool SymBool ->
+  RunStateFunc stateT SymBool () ->
+  PutFunc stateT SymBool SymBool ->
+  Assertion
+mrgPutTest state runStateT mrgPut = do
+  let a = do stateA state; mrgPut (ssymBool "x")
+  let b = do stateB state; mrgPut (ssymBool "y")
+  let actual = runStateT (unionIf (ssymBool "c") a b) (ssymBool "d")
+  let expected =
+        mrgSingle
+          ( mrgIte (ssymBool "c") ((), ssymBool "x") ((), ssymBool "y")
+          )
+  unionSize actual @?= 1
+  actual @?=~ expected
+
+mrgModifyTest ::
+  (UnionLike (stateT SymBool UnionM), Monad (stateT SymBool UnionM)) =>
+  StateFunc stateT SymBool SymBool ->
+  RunStateFunc stateT SymBool () ->
+  ModifyFunc stateT SymBool SymBool ->
+  Assertion
+mrgModifyTest state runStateT mrgModify = do
+  let a = do stateA state; mrgModify (.&& ssymBool "x")
+  let b = do stateB state; mrgModify (.&& ssymBool "y")
+  let actual = runStateT (unionIf (ssymBool "c") a b) (ssymBool "d")
+  let expected =
+        mrgSingle
+          ( mrgIte
+              (ssymBool "c")
+              ( (),
+                ssymBool "d" .&& ssymBool "as" .&& ssymBool "x"
+              )
+              ( (),
+                ssymBool "d" .&& ssymBool "bs" .&& ssymBool "y"
+              )
+          )
+  unionSize actual @?= 1
+  actual @?=~ expected
+
+mrgGetsTest ::
+  (UnionLike (stateT SymBool UnionM), Monad (stateT SymBool UnionM)) =>
+  StateFunc stateT SymBool SymBool ->
+  RunStateFunc stateT SymBool SymBool ->
+  GetsFunc stateT SymBool SymBool ->
+  Assertion
+mrgGetsTest state runStateT mrgGets = do
+  let a = do stateA state; mrgGets (.&& ssymBool "x")
+  let b = do stateB state; mrgGets (.&& ssymBool "y")
+  let actual = runStateT (unionIf (ssymBool "c") a b) (ssymBool "d")
+  let expected =
+        mrgSingle
+          ( mrgIte
+              (ssymBool "c")
+              ( ssymBool "d" .&& ssymBool "as" .&& ssymBool "x",
+                ssymBool "d" .&& ssymBool "as"
+              )
+              ( ssymBool "d" .&& ssymBool "bs" .&& ssymBool "y",
+                ssymBool "d" .&& ssymBool "bs"
+              )
+          )
+  unionSize actual @?= 1
+  actual @?=~ expected
diff --git a/test/Grisette/Lib/Control/Monad/Trans/State/LazyTests.hs b/test/Grisette/Lib/Control/Monad/Trans/State/LazyTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Lib/Control/Monad/Trans/State/LazyTests.hs
@@ -0,0 +1,52 @@
+module Grisette.Lib.Control.Monad.Trans.State.LazyTests
+  ( monadTransStateLazyTests,
+  )
+where
+
+import Control.Monad.State.Lazy (state)
+import Control.Monad.Trans.State.Lazy (runStateT)
+import Grisette.Lib.Control.Monad.Trans.State.Common
+  ( mrgEvalStateTTest,
+    mrgExecStateTTest,
+    mrgGetTest,
+    mrgGetsTest,
+    mrgMapStateTTest,
+    mrgModifyTest,
+    mrgPutTest,
+    mrgRunStateTTest,
+    mrgStateTest,
+    mrgWithStateTTest,
+  )
+import Grisette.Lib.Control.Monad.Trans.State.Lazy
+  ( mrgEvalStateT,
+    mrgExecStateT,
+    mrgGet,
+    mrgGets,
+    mrgMapStateT,
+    mrgModify,
+    mrgModify',
+    mrgPut,
+    mrgRunStateT,
+    mrgState,
+    mrgWithStateT,
+  )
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+
+monadTransStateLazyTests :: Test
+monadTransStateLazyTests =
+  testGroup
+    "Lazy"
+    [ testCase "mrgState" $ mrgStateTest mrgState runStateT,
+      testCase "mrgRunStateT" $ mrgRunStateTTest state mrgRunStateT,
+      testCase "mrgEvalStateT" $ mrgEvalStateTTest state mrgEvalStateT,
+      testCase "mrgExecStateT" $ mrgExecStateTTest state mrgExecStateT,
+      testCase "mrgMapStateT" $ mrgMapStateTTest state runStateT mrgMapStateT,
+      testCase "mrgWithStateT" $
+        mrgWithStateTTest state runStateT mrgWithStateT,
+      testCase "mrgGet" $ mrgGetTest state runStateT mrgGet,
+      testCase "mrgPut" $ mrgPutTest state runStateT mrgPut,
+      testCase "mrgModify" $ mrgModifyTest state runStateT mrgModify,
+      testCase "mrgModify'" $ mrgModifyTest state runStateT mrgModify',
+      testCase "mrgGets" $ mrgGetsTest state runStateT mrgGets
+    ]
diff --git a/test/Grisette/Lib/Control/Monad/Trans/State/StrictTests.hs b/test/Grisette/Lib/Control/Monad/Trans/State/StrictTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Lib/Control/Monad/Trans/State/StrictTests.hs
@@ -0,0 +1,52 @@
+module Grisette.Lib.Control.Monad.Trans.State.StrictTests
+  ( monadTransStateStrictTests,
+  )
+where
+
+import Control.Monad.State.Strict (state)
+import Control.Monad.Trans.State.Strict (runStateT)
+import Grisette.Lib.Control.Monad.Trans.State.Common
+  ( mrgEvalStateTTest,
+    mrgExecStateTTest,
+    mrgGetTest,
+    mrgGetsTest,
+    mrgMapStateTTest,
+    mrgModifyTest,
+    mrgPutTest,
+    mrgRunStateTTest,
+    mrgStateTest,
+    mrgWithStateTTest,
+  )
+import Grisette.Lib.Control.Monad.Trans.State.Strict
+  ( mrgEvalStateT,
+    mrgExecStateT,
+    mrgGet,
+    mrgGets,
+    mrgMapStateT,
+    mrgModify,
+    mrgModify',
+    mrgPut,
+    mrgRunStateT,
+    mrgState,
+    mrgWithStateT,
+  )
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+
+monadTransStateStrictTests :: Test
+monadTransStateStrictTests =
+  testGroup
+    "Strict"
+    [ testCase "mrgState" $ mrgStateTest mrgState runStateT,
+      testCase "mrgRunStateT" $ mrgRunStateTTest state mrgRunStateT,
+      testCase "mrgEvalStateT" $ mrgEvalStateTTest state mrgEvalStateT,
+      testCase "mrgExecStateT" $ mrgExecStateTTest state mrgExecStateT,
+      testCase "mrgMapStateT" $ mrgMapStateTTest state runStateT mrgMapStateT,
+      testCase "mrgWithStateT" $
+        mrgWithStateTTest state runStateT mrgWithStateT,
+      testCase "mrgGet" $ mrgGetTest state runStateT mrgGet,
+      testCase "mrgPut" $ mrgPutTest state runStateT mrgPut,
+      testCase "mrgModify" $ mrgModifyTest state runStateT mrgModify,
+      testCase "mrgModify'" $ mrgModifyTest state runStateT mrgModify',
+      testCase "mrgGets" $ mrgGetsTest state runStateT mrgGets
+    ]
diff --git a/test/Grisette/Lib/Control/MonadTests.hs b/test/Grisette/Lib/Control/MonadTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Lib/Control/MonadTests.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Grisette.Lib.Control.MonadTests (monadFunctionTests) where
+
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
+import Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( UnionLike (single, unionIf),
+    mrgIf,
+    mrgSingle,
+  )
+import Grisette.Lib.Control.Monad
+  ( mrgFmap,
+    mrgFoldM,
+    mrgMplus,
+    mrgMzero,
+    mrgReturn,
+    (.>>),
+    (.>>=),
+  )
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit ((@?=))
+
+monadFunctionTests :: Test
+monadFunctionTests =
+  testGroup
+    "Monad"
+    [ testCase "mrgReturn" $ do
+        (mrgReturn 1 :: UnionM Integer) @?= mrgSingle 1,
+      testCase "mrgFoldM" $ do
+        ( mrgFoldM
+            (\acc (c, v) -> unionIf c (single $ acc + v) (single $ acc * v))
+            10
+            [("a", 2), ("b", 3)] ::
+            UnionM Integer
+          )
+          @?= mrgIf
+            "a"
+            (mrgIf "b" (mrgReturn 15) (mrgReturn 36))
+            (mrgIf "b" (mrgReturn 23) (mrgReturn 60)),
+      testCase "mrgMzero" $ do
+        (mrgMzero :: MaybeT UnionM Integer) @?= MaybeT (mrgReturn Nothing),
+      testCase "mrgMplus" $ do
+        (mrgMzero `mrgMplus` mrgMzero :: MaybeT UnionM Integer) @?= MaybeT (mrgReturn Nothing)
+        (mrgReturn 1 `mrgMplus` mrgMzero :: MaybeT UnionM Integer)
+          @?= mrgReturn 1
+        (mrgMzero `mrgMplus` mrgReturn 1 :: MaybeT UnionM Integer)
+          @?= mrgReturn 1
+        (mrgReturn 2 `mrgMplus` mrgReturn 1 :: MaybeT UnionM Integer)
+          @?= mrgReturn 2,
+      testCase "mrgFmap" $ do
+        mrgFmap (\x -> x * x) (mrgIf "a" (mrgReturn $ -1) (mrgReturn 1) :: UnionM Integer)
+          @?= mrgReturn 1,
+      testCase ".>>" $ do
+        (unionIf "a" (single $ -1) (single 1) :: UnionM Integer)
+          .>> unionIf "a" (single $ -1) (single 1)
+          @?= (mrgIf "a" (mrgReturn $ -1) (mrgReturn 1) :: UnionM Integer),
+      testCase ".>>=" $ do
+        unionIf "a" (single $ -1) (single 1)
+          .>>= (\x -> return $ x * x)
+          @?= (mrgSingle 1 :: UnionM Integer)
+    ]
diff --git a/test/Grisette/Lib/Data/FoldableTests.hs b/test/Grisette/Lib/Data/FoldableTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Lib/Data/FoldableTests.hs
@@ -0,0 +1,130 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Grisette.Lib.Data.FoldableTests (foldableFunctionTests) where
+
+import Control.Monad.Except
+  ( ExceptT (ExceptT),
+    MonadError (throwError),
+    runExceptT,
+  )
+import Control.Monad.Trans.Maybe (MaybeT)
+import Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( UnionLike (single, unionIf),
+    mrgIf,
+  )
+import Grisette.Lib.Control.Monad (mrgMzero, mrgReturn)
+import Grisette.Lib.Data.Foldable
+  ( mrgFoldlM,
+    mrgFoldrM,
+    mrgForM_,
+    mrgFor_,
+    mrgMapM_,
+    mrgMsum,
+    mrgSequence_,
+    mrgTraverse_,
+  )
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit ((@?=))
+
+foldableFunctionTests :: Test
+foldableFunctionTests =
+  testGroup
+    "Foldable"
+    [ testCase "mrgFoldlM" $ do
+        ( mrgFoldlM
+            (\acc (c, v) -> unionIf c (single $ acc + v) (single $ acc * v))
+            10
+            [("a", 2), ("b", 3)] ::
+            UnionM Integer
+          )
+          @?= mrgIf
+            "a"
+            (mrgIf "b" (mrgReturn 15) (mrgReturn 36))
+            ( mrgIf
+                "b"
+                (mrgReturn 23)
+                (mrgReturn 60)
+            ),
+      testCase "mrgFoldrM" $ do
+        ( mrgFoldrM
+            (\(c, v) acc -> unionIf c (single $ acc + v) (single $ acc * v))
+            10
+            [("a", 2), ("b", 3)] ::
+            UnionM Integer
+          )
+          @?= mrgIf
+            "b"
+            (mrgIf "a" (mrgReturn 15) (mrgReturn 26))
+            (mrgIf "a" (mrgReturn 32) (mrgReturn 60)),
+      testCase "mrgTraverse_" $ do
+        runExceptT
+          ( mrgTraverse_
+              (\(c, x) -> ExceptT $ unionIf c (return $ Left x) (return $ Right c))
+              [("a", 3), ("b", 2)] ::
+              ExceptT Integer (UnionM) ()
+          )
+          @?= runExceptT
+            ( do
+                _ <- mrgIf "a" (throwError 3) (return ())
+                _ <- mrgIf "b" (throwError 2) (return ())
+                mrgReturn ()
+            ),
+      testCase "mrgFor_" $ do
+        runExceptT
+          ( mrgFor_
+              [("a", 3), ("b", 2)]
+              (\(c, x) -> ExceptT $ unionIf c (return $ Left x) (return $ Right c)) ::
+              ExceptT Integer UnionM ()
+          )
+          @?= runExceptT
+            ( do
+                _ <- mrgIf "a" (throwError 3) (return ())
+                _ <- mrgIf "b" (throwError 2) (return ())
+                mrgReturn ()
+            ),
+      testCase "mrgMapM_" $ do
+        runExceptT
+          ( mrgMapM_
+              (\(c, x) -> ExceptT $ unionIf c (return $ Left x) (return $ Right c))
+              [("a", 3), ("b", 2)] ::
+              ExceptT Integer UnionM ()
+          )
+          @?= runExceptT
+            ( do
+                _ <- mrgIf "a" (throwError 3) (return ())
+                _ <- mrgIf "b" (throwError 2) (return ())
+                mrgReturn ()
+            ),
+      testCase "mrgForM_" $ do
+        runExceptT
+          ( mrgForM_
+              [("a", 3), ("b", 2)]
+              (\(c, x) -> ExceptT $ unionIf c (return $ Left x) (return $ Right c)) ::
+              ExceptT Integer UnionM ()
+          )
+          @?= runExceptT
+            ( do
+                _ <- mrgIf "a" (throwError 3) (return ())
+                _ <- mrgIf "b" (throwError 2) (return ())
+                mrgReturn ()
+            ),
+      testCase "mrgSequence_" $ do
+        runExceptT
+          ( mrgSequence_
+              [mrgIf "a" (throwError 3) (return ()), mrgIf "b" (throwError 2) (return ())] ::
+              ExceptT Integer UnionM ()
+          )
+          @?= runExceptT
+            ( do
+                _ <- mrgIf "a" (throwError 3) (return ())
+                _ <- mrgIf "b" (throwError 2) (return ())
+                mrgReturn ()
+            ),
+      testCase "mrgMsum" $ do
+        (mrgMsum [mrgMzero, mrgMzero] :: MaybeT UnionM Integer) @?= mrgMzero
+        (mrgMsum [mrgReturn 1, mrgMzero] :: MaybeT UnionM Integer) @?= mrgReturn 1
+        (mrgMsum [mrgMzero, mrgReturn 1] :: MaybeT UnionM Integer) @?= mrgReturn 1
+        (mrgMsum [mrgReturn 2, mrgReturn 1] :: MaybeT UnionM Integer) @?= mrgReturn 2
+    ]
diff --git a/test/Grisette/Lib/Data/TraversableTests.hs b/test/Grisette/Lib/Data/TraversableTests.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/Lib/Data/TraversableTests.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Grisette.Lib.Data.TraversableTests (traversableFunctionTests) where
+
+import Control.Monad.Except
+  ( ExceptT (ExceptT),
+    MonadError (throwError),
+    runExceptT,
+  )
+import Grisette.Core.Control.Monad.UnionM (UnionM)
+import Grisette.Core.Data.Class.SimpleMergeable
+  ( UnionLike (unionIf),
+    mrgIf,
+    mrgSingle,
+  )
+import Grisette.Lib.Data.Traversable
+  ( mrgFor,
+    mrgForM,
+    mrgMapM,
+    mrgSequence,
+    mrgSequenceA,
+    mrgTraverse,
+  )
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit ((@?=))
+
+traversableFunctionTests :: Test
+traversableFunctionTests =
+  testGroup
+    "Traversable"
+    [ testCase "mrgTraverse" $ do
+        runExceptT
+          ( mrgTraverse
+              (\(c, d, x, y, z) -> ExceptT $ unionIf c (return $ Left x) (unionIf d (return $ Right y) (return $ Right z)))
+              [("a", "c", 3, 4, 5), ("b", "d", 2, 3, 6)] ::
+              ExceptT Integer UnionM [Integer]
+          )
+          @?= runExceptT
+            ( do
+                a <- mrgIf "a" (throwError 3) (mrgIf "c" (return 4) (return 5))
+                b <- mrgIf "b" (throwError 2) (mrgIf "d" (return 3) (return 6))
+                mrgSingle [a, b]
+            ),
+      testCase "mrgSequenceA" $ do
+        runExceptT
+          ( mrgSequenceA
+              [ ExceptT $ unionIf "a" (return $ Left 3) (unionIf "c" (return $ Right 4) (return $ Right 5)),
+                ExceptT $ unionIf "b" (return $ Left 2) (unionIf "d" (return $ Right 3) (return $ Right 6))
+              ] ::
+              ExceptT Integer UnionM [Integer]
+          )
+          @?= runExceptT
+            ( do
+                a <- mrgIf "a" (throwError 3) (mrgIf "c" (return 4) (return 5))
+                b <- mrgIf "b" (throwError 2) (mrgIf "d" (return 3) (return 6))
+                mrgSingle [a, b]
+            ),
+      testCase "mrgMapM" $ do
+        runExceptT
+          ( mrgMapM
+              (\(c, d, x, y, z) -> ExceptT $ unionIf c (return $ Left x) (unionIf d (return $ Right y) (return $ Right z)))
+              [("a", "c", 3, 4, 5), ("b", "d", 2, 3, 6)] ::
+              ExceptT Integer UnionM [Integer]
+          )
+          @?= runExceptT
+            ( do
+                a <- mrgIf "a" (throwError 3) (mrgIf "c" (return 4) (return 5))
+                b <- mrgIf "b" (throwError 2) (mrgIf "d" (return 3) (return 6))
+                mrgSingle [a, b]
+            ),
+      testCase "mrgSequence" $ do
+        runExceptT
+          ( mrgSequence
+              [ ExceptT $ unionIf "a" (return $ Left 3) (unionIf "c" (return $ Right 4) (return $ Right 5)),
+                ExceptT $ unionIf "b" (return $ Left 2) (unionIf "d" (return $ Right 3) (return $ Right 6))
+              ] ::
+              ExceptT Integer UnionM [Integer]
+          )
+          @?= runExceptT
+            ( do
+                a <- mrgIf "a" (throwError 3) (mrgIf "c" (return 4) (return 5))
+                b <- mrgIf "b" (throwError 2) (mrgIf "d" (return 3) (return 6))
+                mrgSingle [a, b]
+            ),
+      testCase "mrgFor" $ do
+        runExceptT
+          ( mrgFor
+              [("a", "c", 3, 4, 5), ("b", "d", 2, 3, 6)]
+              (\(c, d, x, y, z) -> ExceptT $ unionIf c (return $ Left x) (unionIf d (return $ Right y) (return $ Right z))) ::
+              ExceptT Integer UnionM [Integer]
+          )
+          @?= runExceptT
+            ( do
+                a <- mrgIf "a" (throwError 3) (mrgIf "c" (return 4) (return 5))
+                b <- mrgIf "b" (throwError 2) (mrgIf "d" (return 3) (return 6))
+                mrgSingle [a, b]
+            ),
+      testCase "mrgForM" $ do
+        runExceptT
+          ( mrgForM
+              [("a", "c", 3, 4, 5), ("b", "d", 2, 3, 6)]
+              (\(c, d, x, y, z) -> ExceptT $ unionIf c (return $ Left x) (unionIf d (return $ Right y) (return $ Right z))) ::
+              ExceptT Integer UnionM [Integer]
+          )
+          @?= runExceptT
+            ( do
+                a <- mrgIf "a" (throwError 3) (mrgIf "c" (return 4) (return 5))
+                b <- mrgIf "b" (throwError 2) (mrgIf "d" (return 3) (return 6))
+                mrgSingle [a, b]
+            )
+    ]
diff --git a/test/Grisette/TestUtil/SymbolicAssertion.hs b/test/Grisette/TestUtil/SymbolicAssertion.hs
new file mode 100644
--- /dev/null
+++ b/test/Grisette/TestUtil/SymbolicAssertion.hs
@@ -0,0 +1,29 @@
+module Grisette.TestUtil.SymbolicAssertion ((@?=~)) where
+
+import GHC.Stack (HasCallStack)
+import Grisette.Backend.SBV (z3)
+import Grisette.Backend.SBV.Data.SMT.Solving (precise)
+import Grisette.Core.Data.Class.EvaluateSym (EvaluateSym (evaluateSym))
+import Grisette.Core.Data.Class.LogicalOp (LogicalOp (symNot))
+import Grisette.Core.Data.Class.SEq (SEq ((.==)))
+import Grisette.Core.Data.Class.Solver (SolvingFailure (Unsat), solve)
+import Test.HUnit (Assertion)
+
+(@?=~) :: (HasCallStack, SEq a, Show a, EvaluateSym a) => a -> a -> Assertion
+actual @?=~ expected = do
+  cex <- solve (precise z3) (symNot $ actual .== expected)
+  case cex of
+    Left Unsat -> return ()
+    Left err -> error $ "Solver isn't working: " ++ show err
+    Right model ->
+      error $
+        unlines
+          [ "Symbolic assertion failed:",
+            "  Counterexample model: " ++ show model,
+            "  Expected value under the model: "
+              ++ show (evaluateSym True model expected),
+            "  Actual value under the model: "
+              ++ show (evaluateSym True model actual),
+            "  Expected value: " ++ show expected,
+            "  Actual value: " ++ show actual
+          ]
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,27 +1,5 @@
 module Main (main) where
 
-{-
-import Grisette.Core.Control.ExceptionTests
-import Grisette.Core.Control.Monad.UnionMBaseTests
-import Grisette.Core.Data.Class.BoolTests
-import Grisette.Core.Data.Class.EvaluateSymTests
-import Grisette.Core.Data.Class.ExtractSymbolicsTests
-import Grisette.Core.Data.Class.GenSymTests
-import Grisette.Core.Data.Class.MergeableTests
-import Grisette.Core.Data.Class.SEqTests
-import Grisette.Core.Data.Class.SOrdTests
-import Grisette.Core.Data.Class.SimpleMergeableTests
-import Grisette.Core.Data.Class.ToConTests
-import Grisette.Core.Data.Class.ToSymTests
-import Grisette.Core.Data.Class.UnionLikeTests
-import Grisette.Core.Data.UnionBaseTests
-import Grisette.Lib.Control.Monad.ExceptTests
-import Grisette.Lib.Control.Monad.TransTests
-import Grisette.Lib.Control.MonadTests
-import Grisette.Lib.Data.FoldableTests
-import Grisette.Lib.Data.TraversableTests
--}
-
 import Grisette.Backend.SBV.Data.SMT.CEGISTests (cegisTests)
 import Grisette.Backend.SBV.Data.SMT.LoweringTests
   ( loweringTests,
@@ -29,12 +7,30 @@
 import Grisette.Backend.SBV.Data.SMT.TermRewritingTests
   ( termRewritingTests,
   )
+import Grisette.Core.Control.ExceptionTests (exceptionTests)
 import Grisette.Core.Control.Monad.UnionMTests (unionMTests)
+import Grisette.Core.Control.Monad.UnionTests (unionTests)
 import qualified Grisette.Core.Data.BVTests
+import qualified Grisette.Core.Data.Class.BoolTests
+import Grisette.Core.Data.Class.EvaluateSymTests (evaluateSymTests)
+import Grisette.Core.Data.Class.ExtractSymbolicsTests (extractSymbolicsTests)
 import Grisette.Core.Data.Class.GPrettyTests (gprettyTests)
+import Grisette.Core.Data.Class.GenSymTests (genSymTests)
+import Grisette.Core.Data.Class.MergeableTests (mergeableTests)
+import Grisette.Core.Data.Class.SEqTests (seqTests)
+import Grisette.Core.Data.Class.SOrdTests (sordTests)
+import Grisette.Core.Data.Class.SafeSymRotateTests (safeSymRotateTests)
+import Grisette.Core.Data.Class.SafeSymShiftTests (safeSymShiftTests)
+import Grisette.Core.Data.Class.SimpleMergeableTests (simpleMergeableTests)
+import Grisette.Core.Data.Class.SubstituteSymTests (substituteSymTests)
+import Grisette.Core.Data.Class.SymRotateTests (symRotateTests)
+import Grisette.Core.Data.Class.SymShiftTests (symShiftTests)
+import Grisette.Core.Data.Class.ToConTests (toConTests)
+import Grisette.Core.Data.Class.ToSymTests (toSymTests)
+import Grisette.Core.Data.Class.UnionLikeTests (unionLikeTests)
 import qualified Grisette.IR.SymPrim.Data.Prim.BVTests
 import Grisette.IR.SymPrim.Data.Prim.BitsTests (bitsTests)
-import Grisette.IR.SymPrim.Data.Prim.BoolTests (boolTests)
+import qualified Grisette.IR.SymPrim.Data.Prim.BoolTests
 import Grisette.IR.SymPrim.Data.Prim.IntegralTests
   ( integralTests,
   )
@@ -43,6 +39,24 @@
 import qualified Grisette.IR.SymPrim.Data.Prim.TabularFunTests
 import Grisette.IR.SymPrim.Data.SymPrimTests (symPrimTests)
 import qualified Grisette.IR.SymPrim.Data.TabularFunTests
+import Grisette.Lib.Control.Monad.ExceptTests
+  ( monadExceptFunctionTests,
+  )
+import Grisette.Lib.Control.Monad.State.ClassTests
+  ( monadStateClassTests,
+  )
+import Grisette.Lib.Control.Monad.Trans.ClassTests
+  ( monadTransClassTests,
+  )
+import Grisette.Lib.Control.Monad.Trans.State.LazyTests
+  ( monadTransStateLazyTests,
+  )
+import Grisette.Lib.Control.Monad.Trans.State.StrictTests
+  ( monadTransStateStrictTests,
+  )
+import Grisette.Lib.Control.MonadTests (monadFunctionTests)
+import Grisette.Lib.Data.FoldableTests (foldableFunctionTests)
+import Grisette.Lib.Data.TraversableTests (traversableFunctionTests)
 import Test.Framework (Test, defaultMain, testGroup)
 
 main :: IO ()
@@ -50,101 +64,97 @@
   defaultMain
     [ coreTests,
       irTests,
-      sbvTests
+      sbvTests,
+      libTests
     ]
 
 coreTests :: Test
 coreTests =
   testGroup
-    "core"
+    "Grisette.Core"
     [ testGroup
-        "Grisette.Core.Control.Monad.UnionM"
-        [unionMTests],
+        "Control"
+        [ testGroup
+            "Monad"
+            [ unionMTests,
+              unionTests
+            ],
+          exceptionTests
+        ],
       testGroup
-        "Grisette.Core.Data"
+        "Data"
         [ testGroup
             "Class"
-            [gprettyTests],
+            [ Grisette.Core.Data.Class.BoolTests.boolTests,
+              evaluateSymTests,
+              extractSymbolicsTests,
+              genSymTests,
+              gprettyTests,
+              mergeableTests,
+              safeSymShiftTests,
+              safeSymRotateTests,
+              seqTests,
+              sordTests,
+              simpleMergeableTests,
+              substituteSymTests,
+              symRotateTests,
+              symShiftTests,
+              toConTests,
+              toSymTests,
+              unionLikeTests
+            ],
           Grisette.Core.Data.BVTests.bvTests
         ]
     ]
 
-{-
-coreTests :: Test
-coreTests =
+libTests :: Test
+libTests =
   testGroup
-    "grisette-core"
+    "Grisette.Lib"
     [ testGroup
-        "Grisette"
+        "Control"
         [ testGroup
-            "Core"
-            [ testGroup
-                "Control"
-                [ testGroup
-                    "Monad"
-                    [ unionMBaseTests
-                    ],
-                  exceptionTests
-                ],
+            "Monad"
+            [ monadExceptFunctionTests,
               testGroup
-                "Data"
-                [ testGroup
-                    "Class"
-                    [ boolTests,
-                      gevaluateSymTests,
-                      gextractSymbolicsTests,
-                      genSymTests,
-                      mergeableTests,
-                      seqTests,
-                      simpleMergeableTests,
-                      sordTests,
-                      toConTests,
-                      toSymTests,
-                      unionLikeTests
-                    ],
-                  unionBaseTests
-                ]
-            ],
-          testGroup
-            "Lib"
-            [ testGroup
-                "Control"
-                [ testGroup
-                    "Monad"
-                    [ monadExceptFunctionTests,
-                      monadTransFunctionTests
-                    ],
-                  monadFunctionTests
+                "State"
+                [ monadStateClassTests
                 ],
               testGroup
-                "Data"
-                [ foldableFunctionTests,
-                  traversableFunctionTests
+                "Trans"
+                [ monadTransClassTests,
+                  testGroup
+                    "State"
+                    [ monadTransStateLazyTests,
+                      monadTransStateStrictTests
+                    ]
                 ]
-            ]
+            ],
+          monadFunctionTests
+        ],
+      testGroup
+        "Data"
+        [ foldableFunctionTests,
+          traversableFunctionTests
         ]
     ]
--}
 
 irTests :: Test
 irTests =
   testGroup
-    "grisette-symir"
+    "Grisette.IR.SymPrim.Data"
     [ testGroup
-        "Grisette.IR.SymPrim.Data"
-        [ testGroup
-            "Prim"
-            [ bitsTests,
-              boolTests,
-              Grisette.IR.SymPrim.Data.Prim.BVTests.bvTests,
-              integralTests,
-              modelTests,
-              numTests,
-              Grisette.IR.SymPrim.Data.Prim.TabularFunTests.tabularFunTests
-            ],
-          symPrimTests,
-          Grisette.IR.SymPrim.Data.TabularFunTests.tabularFunTests
-        ]
+        "Prim"
+        [ bitsTests,
+          Grisette.IR.SymPrim.Data.Prim.BoolTests.boolTests,
+          Grisette.IR.SymPrim.Data.Prim.BVTests.bvTests,
+          integralTests,
+          modelTests,
+          numTests,
+          Grisette.IR.SymPrim.Data.Prim.TabularFunTests.tabularFunTests
+        ],
+      symPrimTests,
+      Grisette.IR.SymPrim.Data.TabularFunTests.tabularFunTests
     ]
 
 sbvTests :: Test